[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/project-uniquify-files 1443be9 2/4: merge from mas
|
From: |
Stephen Leake |
|
Subject: |
[Emacs-diffs] scratch/project-uniquify-files 1443be9 2/4: merge from master to scratch/project-uniquify-files |
|
Date: |
Fri, 19 Apr 2019 13:26:47 -0400 (EDT) |
branch: scratch/project-uniquify-files
commit 1443be9356806b88b9b92331d50e499e26032872
Merge: b701fb1 5ee5895
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
merge from master to scratch/project-uniquify-files
---
.dir-locals.el | 6 +-
.gitignore | 1 -
CONTRIBUTE | 11 +-
ChangeLog.3 | 147 +-
INSTALL | 6 +
build-aux/config.sub | 4 +-
configure.ac | 76 +-
doc/emacs/emacs.texi | 2 +-
doc/lispref/internals.texi | 2 +-
doc/lispref/minibuf.texi | 3 +-
doc/lispref/modes.texi | 10 +-
doc/lispref/searching.texi | 110 +-
doc/lispref/text.texi | 152 +-
doc/lispref/windows.texi | 115 +-
doc/misc/cl.texi | 6 +-
doc/misc/eieio.texi | 52 +-
doc/misc/nxml-mode.texi | 2 +-
doc/misc/texinfo.tex | 174 +-
doc/misc/tramp.texi | 71 +-
etc/AUTHORS | 24 +-
etc/HISTORY | 2 +
etc/NEWS | 168 +-
etc/NEWS.1-17 | 4 +-
lib-src/make-fingerprint.c | 12 +-
lib/_Noreturn.h | 25 +-
lib/gettimeofday.c | 6 +-
lib/gnulib.mk.in | 1 +
lib/mktime.c | 2 +-
lib/regcomp.c | 20 +-
lib/regexec.c | 14 +-
lib/stat-time.h | 2 +-
lib/utimens.c | 8 +-
lisp/abbrev.el | 3 +-
lisp/align.el | 4 +-
lisp/autorevert.el | 54 +-
lisp/button.el | 10 +-
lisp/calc/calc-forms.el | 2 +-
lisp/cedet/srecode/srt-mode.el | 2 +-
lisp/desktop.el | 13 +
lisp/dired.el | 13 +-
lisp/disp-table.el | 14 +-
lisp/electric.el | 6 +-
lisp/elide-head.el | 2 +-
lisp/emacs-lisp/byte-opt.el | 8 +-
lisp/emacs-lisp/bytecomp.el | 44 +-
lisp/emacs-lisp/cconv.el | 2 +-
lisp/emacs-lisp/cl-macs.el | 15 +-
lisp/emacs-lisp/copyright.el | 2 +-
lisp/emacs-lisp/easy-mmode.el | 6 -
lisp/emacs-lisp/edebug.el | 1 -
lisp/emacs-lisp/generator.el | 7 -
lisp/emacs-lisp/lisp-mode.el | 1 -
lisp/emacs-lisp/map.el | 2 +-
lisp/emacs-lisp/nadvice.el | 7 +
lisp/emacs-lisp/pcase.el | 8 +-
lisp/emacs-lisp/regexp-opt.el | 6 +-
lisp/emulation/cua-base.el | 19 +-
lisp/erc/erc-backend.el | 2 +-
lisp/erc/erc-desktop-notifications.el | 22 +-
lisp/erc/erc-goodies.el | 2 +-
lisp/erc/erc.el | 5 +-
lisp/eshell/em-alias.el | 8 +-
lisp/eshell/em-banner.el | 2 +-
lisp/eshell/em-cmpl.el | 2 +-
lisp/eshell/em-dirs.el | 5 +-
lisp/eshell/em-glob.el | 2 +-
lisp/eshell/em-hist.el | 22 +-
lisp/eshell/em-ls.el | 3 +-
lisp/eshell/em-pred.el | 8 +-
lisp/eshell/em-prompt.el | 2 +-
lisp/eshell/em-rebind.el | 2 +-
lisp/eshell/em-script.el | 10 +-
lisp/eshell/em-smart.el | 2 +-
lisp/eshell/em-term.el | 4 +-
lisp/eshell/em-tramp.el | 2 +-
lisp/eshell/em-unix.el | 5 +-
lisp/eshell/esh-arg.el | 96 +-
lisp/eshell/esh-cmd.el | 6 +-
lisp/eshell/esh-ext.el | 20 +-
lisp/eshell/esh-io.el | 5 +-
lisp/eshell/esh-mode.el | 35 +-
lisp/eshell/esh-module.el | 4 +-
lisp/eshell/esh-opt.el | 12 +-
lisp/eshell/esh-proc.el | 61 +-
lisp/eshell/esh-util.el | 18 +-
lisp/eshell/esh-var.el | 21 +-
lisp/eshell/eshell.el | 21 +-
lisp/faces.el | 20 +-
lisp/files-x.el | 7 +-
lisp/files.el | 5 +-
lisp/frame.el | 58 +-
lisp/gnus/gnus-agent.el | 91 +-
lisp/gnus/gnus-dup.el | 34 +-
lisp/gnus/gnus-group.el | 163 +-
lisp/gnus/gnus-icalendar.el | 58 +-
lisp/gnus/gnus-start.el | 14 +-
lisp/gnus/gnus-sum.el | 248 ++-
lisp/gnus/message.el | 2 +-
lisp/gnus/mm-decode.el | 38 +-
lisp/gnus/mm-view.el | 31 +-
lisp/gnus/nndoc.el | 4 +-
lisp/gnus/nnmail.el | 2 +-
lisp/gnus/nnml.el | 16 +-
lisp/gnus/nnrss.el | 18 +-
lisp/help-fns.el | 414 +++--
lisp/indent.el | 15 +-
lisp/info.el | 2 +-
lisp/international/mule-cmds.el | 2 +-
lisp/international/quail.el | 17 +-
lisp/ldefs-boot.el | 91 +-
lisp/leim/quail/sami.el | 2 +-
lisp/mail/footnote.el | 20 +-
lisp/mail/mail-extr.el | 2 +-
lisp/net/tramp-adb.el | 67 +-
lisp/net/tramp-archive.el | 4 +-
lisp/net/tramp-gvfs.el | 18 +-
lisp/net/tramp-integration.el | 11 -
lisp/net/tramp-sh.el | 177 +-
lisp/net/tramp.el | 69 +-
lisp/net/webjump.el | 2 +-
lisp/newcomment.el | 8 +-
lisp/obsolete/vi.el | 2 +-
lisp/org/org-eshell.el | 2 +-
lisp/org/org-table.el | 4 +-
lisp/org/org.el | 4 +-
lisp/play/gamegrid.el | 38 +-
lisp/printing.el | 1758 ++++++++------------
lisp/progmodes/bat-mode.el | 2 +-
lisp/progmodes/bug-reference.el | 8 +-
lisp/progmodes/cc-defs.el | 76 +-
lisp/progmodes/cc-engine.el | 629 +++++--
lisp/progmodes/cc-fonts.el | 40 +-
lisp/progmodes/cc-langs.el | 35 +-
lisp/progmodes/cc-mode.el | 134 +-
lisp/progmodes/compile.el | 249 ++-
lisp/progmodes/flymake-cc.el | 10 +-
lisp/progmodes/grep.el | 19 +-
lisp/progmodes/gud.el | 2 +-
lisp/progmodes/idlwave.el | 4 +-
lisp/progmodes/js.el | 1200 ++++++++++---
lisp/progmodes/python.el | 40 +-
lisp/progmodes/sh-script.el | 3 +-
lisp/progmodes/sql.el | 2 +-
lisp/progmodes/verilog-mode.el | 56 +-
lisp/progmodes/xref.el | 20 +-
lisp/replace.el | 85 +-
lisp/shell.el | 46 +-
lisp/simple.el | 116 +-
lisp/speedbar.el | 4 +-
lisp/subr.el | 62 +-
lisp/textmodes/css-mode.el | 6 +-
lisp/textmodes/dns-mode.el | 2 +-
lisp/textmodes/less-css-mode.el | 4 +-
lisp/textmodes/picture.el | 14 +-
lisp/textmodes/text-mode.el | 37 +-
lisp/url/url-http.el | 14 +-
lisp/url/url-misc.el | 2 +-
lisp/url/url-util.el | 2 -
lisp/vc/diff-mode.el | 213 ++-
lisp/vc/log-edit.el | 6 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/vc/vc-git.el | 20 +-
lisp/vc/vc-hooks.el | 2 +
lisp/vc/vc-svn.el | 2 +-
lisp/vc/vc.el | 70 +-
lisp/wid-edit.el | 5 +-
lisp/window.el | 4 +-
lisp/woman.el | 2 +-
lisp/xml.el | 8 +-
m4/fdopendir.m4 | 12 +-
m4/getgroups.m4 | 6 +-
m4/gettimeofday.m4 | 4 +-
m4/gnulib-common.m4 | 38 +-
m4/putenv.m4 | 4 +-
m4/utimes.m4 | 10 +-
make-dist | 2 +-
nextstep/Makefile.in | 6 +-
src/.gdbinit | 24 +-
src/Makefile.in | 56 +-
src/alloc.c | 40 +-
src/bignum.c | 8 +-
src/buffer.c | 38 +-
src/buffer.h | 21 +-
src/coding.c | 71 +-
src/coding.h | 2 +
src/composite.c | 25 +-
src/data.c | 113 +-
src/decompress.c | 22 +-
src/dispextern.h | 3 +-
src/dmpstruct.awk | 0
src/editfns.c | 26 +-
src/emacs-module.c | 2 +-
src/emacs.c | 9 +-
src/eval.c | 18 -
src/filelock.c | 1 +
src/fingerprint-dummy.c | 23 -
src/fingerprint.h | 4 +-
src/fns.c | 2 +-
src/fontset.c | 2 +-
src/frame.c | 7 +-
src/frame.h | 7 +-
src/gtkutil.c | 45 +-
src/image.c | 106 +-
src/json.c | 116 +-
src/lisp.h | 108 +-
src/lread.c | 50 +-
src/minibuf.c | 3 +-
src/pdumper.c | 168 +-
src/process.c | 3 +-
src/process.h | 4 +-
src/regex-emacs.c | 330 ++--
src/regex-emacs.h | 38 +-
src/search.c | 71 +-
src/termhooks.h | 2 +-
src/terminal.c | 4 +-
src/thread.c | 20 +-
src/thread.h | 11 +-
src/w32fns.c | 2 +
src/w32proc.c | 19 +-
src/w32term.c | 42 +-
src/widget.c | 5 +-
src/window.c | 30 +-
src/window.h | 5 +-
src/xfns.c | 7 +-
src/xsettings.c | 4 +-
src/xterm.c | 123 +-
src/xterm.h | 2 +-
src/xwidget.c | 5 +-
src/xwidget.h | 6 +-
test/lisp/button-tests.el | 40 +
test/lisp/emacs-lisp/pcase-tests.el | 4 +-
test/lisp/filenotify-tests.el | 3 +-
test/lisp/gnus/gnus-test-headers.el | 10 +-
test/lisp/mail/rmail-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 145 +-
test/lisp/progmodes/flymake-tests.el | 2 +
test/lisp/progmodes/python-tests.el | 10 +
test/lisp/simple-tests.el | 176 +-
test/lisp/subr-tests.el | 18 -
.../{mail/rmail-tests.el => wid-edit-tests.el} | 36 +-
test/manual/indent/js-jsx.js | 85 -
test/manual/indent/js.js | 5 +
test/manual/indent/jsx-align-gt-with-lt.jsx | 12 +
test/manual/indent/jsx-indent-level.jsx | 13 +
test/manual/indent/jsx-quote.jsx | 16 +
test/manual/indent/jsx-self-closing.jsx | 13 +
test/manual/indent/jsx-unclosed-1.jsx | 13 +
test/manual/indent/jsx-unclosed-2.jsx | 65 +
test/manual/indent/jsx.jsx | 314 ++++
test/src/editfns-tests.el | 3 +
test/src/fns-tests.el | 18 +
test/src/json-tests.el | 8 +
252 files changed, 6963 insertions(+), 4676 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 9cd3992..ffd65c8 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,6 +1,7 @@
((nil . ((tab-width . 8)
(sentence-end-double-space . t)
- (fill-column . 70)))
+ (fill-column . 70)
+ (bug-reference-url-format . "https://debbugs.gnu.org/%s";)))
(c-mode . ((c-file-style . "GNU")
(c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
@@ -12,8 +13,7 @@
(log-edit-setup-add-author . t)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
- (bug-reference-url-format . "https://debbugs.gnu.org/%s";)
- (mode . bug-reference)))
+ (eval . (bug-reference-mode))))
(diff-mode . ((mode . whitespace)))
(emacs-lisp-mode . ((indent-tabs-mode . nil)
(electric-quote-comment . nil)
diff --git a/.gitignore b/.gitignore
index 355824f..88b2976 100644
--- a/.gitignore
+++ b/.gitignore
@@ -185,7 +185,6 @@ src/bootstrap-emacs
src/emacs
src/emacs-[0-9]*
src/temacs
-src/temacs.in
src/fingerprint.c
src/dmpstruct.h
src/*.pdmp
diff --git a/CONTRIBUTE b/CONTRIBUTE
index efd4bf1..a5433e3 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -54,12 +54,21 @@ packages the patch's commit message and changes. To send
just one
such patch without additional remarks, you can use a command like
'git send-email address@hidden 0001-DESCRIPTION.patch'.
+Once the cumulative amount of your submissions exceeds about 15 lines
+of non-trivial changes, we will need you to assign to the FSF the
+copyright for your contributions. Ask on address@hidden, and we
+will send you the necessary form together with the instructions to
+fill and email it, in order to start this legal paperwork.
+
** Issue tracker (a.k.a. "bug tracker")
The Emacs issue tracker at https://debbugs.gnu.org lets you view bug
reports and search the database for bugs matching several criteria.
Messages posted to the address@hidden mailing list, mentioned
-above, are recorded by the tracker with the corresponding bugs/issues.
+above, are recorded by the tracker with the corresponding
+bugs/issues. If a message to the bug tracker contains a patch, please
+include the string "[PATCH]" in the subject of the message in order to
+let the bug tracker tag the bug properly.
GNU ELPA has a 'debbugs' package that allows accessing the tracker
database from Emacs.
diff --git a/ChangeLog.3 b/ChangeLog.3
index 235c8bb..e7f4d86 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,148 @@
+2019-04-11 Eli Zaretskii <address@hidden>
+
+ Improve documentation of 'read-command'
+
+ * src/minibuf.c (Fread_command): Document the return value
+ when DEFAULT-VALUE is nil and the user enters nothing.
+ * doc/lispref/minibuf.texi (High-Level Completion): Document
+ the printed representation of a symbol whose name is empty.
+ (Bug#3522)
+
+2019-04-11 Eli Zaretskii <address@hidden>
+
+ Fix an outdated URL in a comment
+
+ * src/emacs.c: Fix reference to Cocoa CoreFoundation Release
+ Notes. (Bug#35225)
+
+2019-04-11 Basil L. Contovounesios <address@hidden>
+
+ Backport: Fix comment-empty-lines docstring (bug#35152)
+
+ * lisp/newcomment.el (comment-empty-lines): Consistently use US
+ commas in docstring. Fix indentation of and typo in custom :type.
+
+ (cherry picked from commit 690c678fb6c1fb5b2f828f9bb90782bd0b01c399)
+
+2019-04-11 Alex Branham <address@hidden>
+
+ Backport: Update documentation for indent-relative functions
+
+ * lisp/indent.el (indent-relative): Document what happens when there
+ is no previous nonblank line.
+ * doc/lispref/text.texi (Relative Indent): Document
+ indent-relative-first-indent-point instead of obsolete
+ indent-relative-maybe. Fix documentation of which argument from
+ 'indent-relative' is used.
+
+ Bug#34858
+
+ (cherry picked from commit 10cd65878c741d2a22a1f2c36c54fcad4e516f72)
+
+2019-04-11 Noam Postavsky <address@hidden>
+
+ Update nxml-mode.texi: completion now gives xmlns="-!-"
+
+ * doc/misc/nxml-mode.texi (Completion): As of 2016-01-16 "* lisp/nxml:
+ Use standard completion; it also works for company-mode", completing
+ an attribute when there is only one candidate inserts both quotes.
+ Update the example accordingly.
+
+2019-04-10 Eric Abrahamsen <address@hidden>
+
+ Note that choose-completion-string-functions funcs take four args
+
+ * lisp/simple.el (choose-completion-string-functions): Functions in
+ this list actually need to accept four arguments, though the fourth
+ should be ignored.
+
+2019-04-10 Gemini Lasswell <address@hidden>
+
+ Address name conflicts in EIEIO documentation (bug#31660)
+
+ * doc/misc/eieio.texi (Quick Start): Rename the class used in the
+ example from 'record' to 'person'.
+ (Building Classes): Advise user to check for name conflicts before
+ naming a class. Add a missing apostrophe.
+ (Making New Objects): Correct grammar. Rename the class used in the
+ example from 'record' to 'my-class'.
+
+2019-04-09 Mattias Engdegård <address@hidden>
+
+ Clarify the TESTFN argument to `alist-get'
+
+ * lisp/subr.el (alist-get):
+ Rephrase the initial text to clarify the meaning of the TESTFN argument.
+ It's an equality predicate, not a look-up function (Bug#35206).
+
+ (cherry picked from commit c81465580fe262f28ce47502c00f4afcbe3b8f8d)
+
+2019-04-08 Eli Zaretskii <address@hidden>
+
+ * src/editfns.c (Fnarrow_to_region): Doc fix. (Bug#35163)
+
+2019-04-06 Eli Zaretskii <address@hidden>
+
+ Fix doc strings of 'vc-version-diff' and 'vc-version-ediff'
+
+ * lisp/vc/vc.el (vc-version-diff, vc-version-ediff): Describe
+ arguments in the doc strings. (Bug#35019)
+
+2019-04-06 Eli Zaretskii <address@hidden>
+
+ Improve documentation of set-window-start
+
+ * doc/lispref/windows.texi (Window Start and End):
+ * src/window.c (Fset_window_start): Document that reliable
+ setting of a window start position requires to adjust point to
+ be visible. (Bug#34038)
+
+2019-04-06 Eli Zaretskii <address@hidden>
+
+ Improve documentation of window parameters
+
+ * doc/lispref/windows.texi (Cyclic Window Ordering): Describe
+ the effect of the 'other-window' window parameter.
+ (Window Parameters): Improve the descriptions of window
+ parameters. Move the detailed description of the
+ 'quit-restore' window parameter from here...
+ (Quitting Windows): ...to here. (Bug#35063)
+
+2019-04-06 Eli Zaretskii <address@hidden>
+
+ Improve commentary in frame.el
+
+ * lisp/frame.el: Improve commentary for display-* functions.
+ (Bug#35058)
+
+2019-04-06 Mauro Aranda <address@hidden>
+
+ Fix typo in a doc string
+
+ * lisp/autorevert.el (global-auto-revert-mode): Fix a typo.
+ (Bug#35165)
+
+2019-03-20 Paul Eggert <address@hidden>
+
+ Say which regexp ranges should be avoided
+
+ * doc/lispref/searching.texi (Regexp Special): Say that
+ regular expressions like "[a-m-z]" and "[[:alpha:]-~]" should
+ be avoided, for the same reason that regular expressions like
+ "+" and "*" should be avoided: POSIX says their behavior is
+ undefined, and they are confusing anyway. Also, explain
+ better what happens when the bound of a range is a raw 8-bit
+ byte; the old explanation appears to have been obsolete
+ anyway. Finally, say that ranges like "[\u00FF-\xFF]" that
+ mix non-ASCII characters and raw 8-bit bytes should be
+ avoided, since it’s not clear what they should mean.
+
+2019-03-20 Nicolas Petton <address@hidden>
+
+ * etc/AUTHORS: Update.
+
+ * ; ChangeLog.3 update
+
2019-03-20 Eli Zaretskii <address@hidden>
Improve indexing of the user manual
@@ -64946,7 +65091,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit 0f523deec1c1e9e2a5a3474f912aa2183d3fe33d (inclusive).
+commit 85829363f728c410e33ffdc3839202977b2115cc (inclusive).
See ChangeLog.1 for earlier changes.
;; Local Variables:
diff --git a/INSTALL b/INSTALL
index 72bba25..8022385 100644
--- a/INSTALL
+++ b/INSTALL
@@ -318,6 +318,12 @@ features enabled, you can combine --without-all with
--with-FEATURE.
For example, you can use --without-all --without-x --with-dbus to
build with D-Bus support and nothing more.
+Use --with-gnutls=ifavailable to use GnuTLS if available but go ahead
+and build without it if not available. This overrides Emacs's default
+behavior of refusing to build if GnuTLS is absent. When X11 support
+is enabled, the libraries for gif, jpeg, png, tiff, and xpm are in the
+same strongly-recommended category as GnuTLS, and have similar options.
+
Use --with-wide-int to implement Emacs values with the type 'long long',
even on hosts where a narrower type would do. With this option, on a
typical 32-bit host, Emacs integers have 62 bits instead of 30.
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 3b4c762..a44fd8a 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -822,7 +822,9 @@ case $basic_machine in
cpu=m68k
vendor=next
case $os in
- nextstep* )
+ openstep*)
+ ;;
+ nextstep*)
;;
ns2*)
os=nextstep2
diff --git a/configure.ac b/configure.ac
index 110ea29..1814a30 100644
--- a/configure.ac
+++ b/configure.ac
@@ -537,19 +537,21 @@ fi)
AC_ARG_ENABLE(checking,
[AS_HELP_STRING([--enable-checking@<:@=LIST@:>@],
- [enable expensive run-time checks. With LIST,
+ [enable expensive checks. With LIST,
enable only specific categories of checks.
Categories are: all,yes,no.
Flags are: stringbytes, stringoverrun, stringfreelist,
- xmallocoverrun, conslist, glyphs])],
+ structs, xmallocoverrun, conslist, glyphs])],
[ac_checking_flags="${enableval}"],[])
IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="$IFS,"
+CHECK_STRUCTS=false
for check in $ac_checking_flags
do
case $check in
# these set all the flags to specific states
yes) ac_enable_checking=1 ;;
no) ac_enable_checking= ;
+ CHECK_STRUCTS=false
ac_gc_check_stringbytes= ;
ac_gc_check_string_overrun= ;
ac_gc_check_string_free_list= ;
@@ -557,6 +559,7 @@ do
ac_gc_check_cons_list= ;
ac_glyphs_debug= ;;
all) ac_enable_checking=1 ;
+ CHECK_STRUCTS=true
ac_gc_check_stringbytes=1 ;
ac_gc_check_string_overrun=1 ;
ac_gc_check_string_free_list=1 ;
@@ -567,6 +570,7 @@ do
stringbytes) ac_gc_check_stringbytes=1 ;;
stringoverrun) ac_gc_check_string_overrun=1 ;;
stringfreelist) ac_gc_check_string_free_list=1 ;;
+ structs) CHECK_STRUCTS=true ;;
xmallocoverrun) ac_xmalloc_overrun=1 ;;
conslist) ac_gc_check_cons_list=1 ;;
glyphs) ac_glyphs_debug=1 ;;
@@ -579,6 +583,15 @@ if test x$ac_enable_checking != x ; then
AC_DEFINE(ENABLE_CHECKING, 1,
[Define to 1 if expensive run-time data type and consistency checks are
enabled.])
fi
+if $CHECK_STRUCTS; then
+ AC_DEFINE([CHECK_STRUCTS], 1,
+ [Define this to check whether someone updated the portable dumper
+ code after changing the layout of a structure that it uses.
+ If you change one of these structures, check that the pdumper.c
+ code is still valid, and update the pertinent hash in pdumper.c
+ by manually copying the hash from the newly-generated dmpstruct.h.])
+fi
+AC_SUBST([CHECK_STRUCTS])
if test x$ac_gc_check_stringbytes != x ; then
AC_DEFINE(GC_CHECK_STRING_BYTES, 1,
[Define this temporarily to hunt a bug. If defined, the size of
@@ -2941,7 +2954,7 @@ fi
AC_SUBST(LIBSELINUX_LIBS)
HAVE_GNUTLS=no
-if test "${with_gnutls}" = "yes" ; then
+if test "${with_gnutls}" != "no" ; then
EMACS_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.12.2],
[HAVE_GNUTLS=yes], [HAVE_GNUTLS=no])
if test "${HAVE_GNUTLS}" = "yes"; then
@@ -3512,7 +3525,10 @@ fi
if test "${HAVE_X11}" = "yes"; then
dnl Avoid Xpm on AIX unless requested, as it crashes; see Bug#17598.
- test "$opsys$with_xpm_set" = aix4-2 && with_xpm=no
+ case $opsys,$with_xpm_set,$with_xpm in
+ aix4-2,set,yes) ;;
+ aix4-2,*) with_xpm=no;;
+ esac
if test "${with_xpm}" != "no"; then
AC_CHECK_HEADER(X11/xpm.h,
@@ -3830,28 +3846,46 @@ AC_SUBST(LIBGIF)
dnl Check for required libraries.
MISSING=
-WITH_NO=
+WITH_IFAVAILABLE=
if test "${HAVE_X11}" = "yes"; then
- test "${with_xpm}" != "no" && test "${HAVE_XPM}" != "yes" &&
- MISSING="libXpm" && WITH_NO="--with-xpm=no"
- test "${with_jpeg}" != "no" && test "${HAVE_JPEG}" != "yes" &&
- MISSING="$MISSING libjpeg" && WITH_NO="$WITH_NO --with-jpeg=no"
- test "${with_png}" != "no" && test "${HAVE_PNG}" != "yes" &&
- MISSING="$MISSING libpng" && WITH_NO="$WITH_NO --with-png=no"
- test "${with_gif}" != "no" && test "${HAVE_GIF}" != "yes" &&
- MISSING="$MISSING libgif/libungif" && WITH_NO="$WITH_NO --with-gif=no"
- test "${with_tiff}" != "no" && test "${HAVE_TIFF}" != "yes" &&
- MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no"
-fi
-test "${with_gnutls}" != "no" && test "${HAVE_GNUTLS}" != "yes" &&
- MISSING="$MISSING gnutls" && WITH_NO="$WITH_NO --with-gnutls=no"
+ case $with_xpm,$HAVE_XPM in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="libXpm"
+ WITH_IFAVAILABLE="--with-xpm=ifavailable";;
+ esac
+ case $with_jpeg,$HAVE_JPEG in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING libjpeg"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-jpeg=ifavailable";;
+ esac
+ case $with_png,$HAVE_PNG in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING libpng"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-png=ifavailable";;
+ esac
+ case $with_gif,$HAVE_GIF in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING libgif/libungif"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-gif=ifavailable";;
+ esac
+ case $with_tiff,$HAVE_TIFF in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING libtiff"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-tiff=ifavailable";;
+ esac
+fi
+case $with_gnutls,$HAVE_GNUTLS in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING gnutls"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-gnutls=ifavailable";;
+esac
if test "X${MISSING}" != X; then
AC_MSG_ERROR([The following required libraries were not found:
$MISSING
Maybe some development libraries/packages are missing?
-If you don't want to link with them give
- $WITH_NO
-as options to configure])
+To build anyway, give:
+ $WITH_IFAVAILABLE
+as options to configure.])
fi
### Use -lgpm if available, unless '--with-gpm=no'.
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 7edc1a5..58ec373 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -1484,7 +1484,7 @@ Stevens, Andy Stewart, Jonathan Stigelman, Martin
Stjernholm, Kim F.
Storm, Steve Strassmann, Christopher Suckling, Olaf Sylvester, Naoto
Takahashi, Steven Tamm, Jan Tatarik, Luc Teirlinck, Jean-Philippe Theberge,
Jens
T. Berger Thielemann, Spencer Thomas, Jim Thompson, Toru Tomabechi,
-David O'Toole, Markus Triska, Tom Tromey, Enami Tsugutomo, Eli
+David O'Toole, Markus Triska, Tom Tromey, Eli
Tziperman, Daiki Ueno, Masanobu Umeda, Rajesh Vaidheeswarran, Neil
W. Van Dyke, Didier Verna, Joakim Verona, Ulrik Vieth, Geoffrey
Voelker, Johan Vromans, Inge Wallin, John Paul Wallington, Colin
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 5646512..8ebe47d 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1708,7 +1708,7 @@ The last @acronym{API} function exited via @code{throw}.
@end vtable
@end deftypefn
address@hidden Function emacs_funcall_exit non_local_exit_get (emacs_env
address@hidden, emacs_value address@hidden, emacs_value address@hidden)
address@hidden Function enum emacs_funcall_exit non_local_exit_get (emacs_env
address@hidden, emacs_value address@hidden, emacs_value address@hidden)
This function returns the kind of nonlocal exit condition stored in
@var{env}, like @code{non_local_exit_check} does, but it also returns
the full information about the nonlocal exit, if any. If the return
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 6c37fa9..cfea336 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1333,7 +1333,8 @@ is a string, @code{read-command} interns it before
returning it.
If it is a list, @code{read-command} interns the first element of this list.
If @var{default} is @code{nil}, that means no default has been
specified; then if the user enters null input, the return value is
address@hidden(intern "")}, that is, a symbol whose name is an empty string.
address@hidden(intern "")}, that is, a symbol whose name is an empty string,
+and whose printed representation is @code{##} (@pxref{Symbol Type}).
@example
(read-command "Command name? ")
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 1afbc5a..4315b70 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1291,17 +1291,11 @@ You can thus get the full benefit of adaptive filling
Turning on Text mode runs the normal hook `text-mode-hook'."
@end group
@group
- (set (make-local-variable 'text-mode-variant) t)
- (set (make-local-variable 'require-final-newline)
- mode-require-final-newline)
- (set (make-local-variable 'indent-line-function) 'indent-relative))
+ (setq-local text-mode-variant t)
+ (setq-local require-final-newline mode-require-final-newline))
@end group
@end smallexample
address@hidden
-(The last line is redundant nowadays, since @code{indent-relative} is
-the default value, and we'll delete it in a future version.)
-
@cindex @file{lisp-mode.el}
The three Lisp modes (Lisp mode, Emacs Lisp mode, and Lisp Interaction
mode) have more features than Text mode and the code is correspondingly
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 0f31291..8775254 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -391,39 +391,9 @@ writing the starting and ending characters with a @samp{-}
between them.
Thus, @samp{[a-z]} matches any lower-case @acronym{ASCII} letter.
Ranges may be intermixed freely with individual characters, as in
@samp{[a-z$%.]}, which matches any lower case @acronym{ASCII} letter
-or @samp{$}, @samp{%} or period.
-
-If @code{case-fold-search} is address@hidden, @samp{[a-z]} also
-matches upper-case letters. Note that a range like @samp{[a-z]} is
-not affected by the locale's collation sequence, it always represents
-a sequence in @acronym{ASCII} order.
address@hidden This wasn't obvious to me, since, e.g., the grep manual
"Character
address@hidden Classes and Bracket Expressions" specifically notes the opposite
address@hidden behavior. But by experiment Emacs seems unaffected by LC_COLLATE
address@hidden in this regard.
-
-Note also that the usual regexp special characters are not special inside a
-character alternative. A completely different set of characters is
-special inside character alternatives: @samp{]}, @samp{-} and @samp{^}.
-
-To include a @samp{]} in a character alternative, you must make it the first
-character. For example, @samp{[]a]} matches @samp{]} or @samp{a}. To include
-a @samp{-}, write @samp{-} as the last character of the character alternative,
-tho you can also put it first or after a range. Thus, @samp{[]-]} matches both
address@hidden and @samp{-}. (As explained below, you cannot use @samp{\]} to
-include a @samp{]} inside a character alternative, since @samp{\} is not
-special there.)
-
-To include @samp{^} in a character alternative, put it anywhere but at
-the beginning.
-
address@hidden What if it starts with a multibyte and ends with a unibyte?
address@hidden That doesn't seem to match anything...?
-If a range starts with a unibyte character @var{c} and ends with a
-multibyte character @var{c2}, the range is divided into two parts: one
-spans the unibyte characters @address@hidden, the other the
-multibyte characters @address@hidden@var{c2}}, where @var{c1} is the
-first character of the charset to which @var{c2} belongs.
+or @samp{$}, @samp{%} or period. However, the ending character of one
+range should not be the starting point of another one; for example,
address@hidden should be avoided.
A character alternative can also specify named character classes
(@pxref{Char Classes}). This is a POSIX feature. For example,
@@ -431,12 +401,80 @@ A character alternative can also specify named character
classes
Using a character class is equivalent to mentioning each of the
characters in that class; but the latter is not feasible in practice,
since some classes include thousands of different characters.
+A character class should not appear as the lower or upper bound
+of a range.
+
+The usual regexp special characters are not special inside a
+character alternative. A completely different set of characters is
+special: @samp{]}, @samp{-} and @samp{^}.
+To include @samp{]} in a character alternative, put it at the
+beginning. To include @samp{^}, put it anywhere but at the beginning.
+To include @samp{-}, put it at the end. Thus, @samp{[]^-]} matches
+all three of these special characters. You cannot use @samp{\} to
+escape these three characters, since @samp{\} is not special here.
+
+The following aspects of ranges are specific to Emacs, in that POSIX
+allows but does not require this behavior and programs other than
+Emacs may behave differently:
+
address@hidden
address@hidden
+If @code{case-fold-search} is address@hidden, @samp{[a-z]} also
+matches upper-case letters.
+
address@hidden
+A range is not affected by the locale's collation sequence: it always
+represents the set of characters with codepoints ranging between those
+of its bounds, so that @samp{[a-z]} matches only ASCII letters, even
+outside the C or POSIX locale.
+
address@hidden
+If the lower bound of a range is greater than its upper bound, the
+range is empty and represents no characters. Thus, @samp{[z-a]}
+always fails to match, and @samp{[^z-a]} matches any character,
+including newline. However, a reversed range should always be from
+the letter @samp{z} to the letter @samp{a} to make it clear that it is
+not a typo; for example, @samp{[+-*/]} should be avoided, because it
+matches only @samp{/} rather than the likely-intended four characters.
address@hidden enumerate
+
+Some kinds of character alternatives are not the best style even
+though they have a well-defined meaning in Emacs. They include:
+
address@hidden
address@hidden
+Although a range's bound can be almost any character, it is better
+style to stay within natural sequences of ASCII letters and digits
+because most people have not memorized character code tables.
+For example, @samp{[.-9]} is less clear than @samp{[./0-9]},
+and @samp{[`-~]} is less clear than @address@hidden|@}~]}.
+Unicode character escapes can help here; for example, for most programmers
address@hidden is less clear than @samp{[\u0E01-\u0E3A\u0E3F-\u0E5B]}.
+
address@hidden
+Although a character alternative can include duplicates, it is better
+style to avoid them. For example, @samp{[XYa-yYb-zX]} is less clear
+than @samp{[XYa-z]}.
+
address@hidden
+Although a range can denote just one, two, or three characters, it
+is simpler to list the characters. For example,
address@hidden is less clear than @samp{[a0]}, @samp{[i-j]} is less clear
+than @samp{[ij]}, and @samp{[i-k]} is less clear than @samp{[ijk]}.
+
address@hidden
+Although a @samp{-} can appear at the beginning of a character
+alternative or as the upper bound of a range, it is better style to
+put @samp{-} by itself at the end of a character alternative. For
+example, although @samp{[-a-z]} is valid, @samp{[a-z-]} is better
+style; and although @samp{[*--]} is valid, @samp{[*+,-]} is clearer.
address@hidden enumerate
@item @samp{[^ @dots{} ]}
@cindex @samp{^} in regexp
@samp{[^} begins a @dfn{complemented character alternative}. This
matches any character except the ones specified. Thus,
address@hidden matches all characters @emph{except} letters and
address@hidden matches all characters @emph{except} ASCII letters and
digits.
@samp{^} is not special in a character alternative unless it is the first
@@ -1007,9 +1045,9 @@ version:
((eq paren 'symbols) '("\\_<\\(" . "\\)\\_>"))
((null paren) '("\\(?:" . "\\)"))
(t '("\\(" . "\\)")))))
- (concat (car paren)
+ (concat (car parens)
(mapconcat 'regexp-quote strings "\\|")
- (cdr paren))))
+ (cdr parens))))
@end example
@end defun
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 21c5a73..500df1f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -723,12 +723,18 @@ You thought
@end example
@end deffn
address@hidden Command delete-indentation &optional join-following-p
address@hidden Command delete-indentation &optional join-following-p beg end
This function joins the line point is on to the previous line, deleting
any whitespace at the join and in some cases replacing it with one
space. If @var{join-following-p} is address@hidden,
@code{delete-indentation} joins this line to the following line
-instead. The function returns @code{nil}.
+instead. Otherwise, if @var{beg} and @var{end} are address@hidden,
+this function joins all lines in the region they define.
+
+In an interactive call, @var{join-following-p} is the prefix argument,
+and @var{beg} and @var{end} are, respectively, the start and end of
+the region if it is active, else @code{nil}. The function returns
address@hidden
If there is a fill prefix, and the second of the lines being joined
starts with the prefix, then @code{delete-indentation} deletes the
@@ -2571,11 +2577,11 @@ The quick brown fox jum @point{}ped.
@end example
@end deffn
address@hidden Command indent-relative-maybe
address@hidden Command indent-relative-first-indent-point
@comment !!SourceFile indent.el
This command indents the current line like the previous nonblank line,
by calling @code{indent-relative} with @code{t} as the
address@hidden argument. The return value is unpredictable.
address@hidden argument. The return value is unpredictable.
If the previous nonblank line has no indent points beyond the current
column, this command does nothing.
@@ -4507,14 +4513,17 @@ This function returns address@hidden if built-in zlib
decompression is
available.
@end defun
address@hidden zlib-decompress-region start end
address@hidden zlib-decompress-region start end &optional allow-partial
This function decompresses the region between @var{start} and
@var{end}, using built-in zlib decompression. The region should
contain data that were compressed with gzip or zlib. On success, the
function replaces the contents of the region with the decompressed
-data. On failure, the function leaves the region unchanged and
-returns @code{nil}. This function can be called only in unibyte
-buffers.
+data. If @var{allow-partial} is @code{nil} or omitted, then on
+failure, the function leaves the region unchanged and returns
address@hidden Otherwise, it returns the number of bytes that were not
+decompressed and replaces the region text by whatever data was
+successfully decompressed. This function can be called only in
+unibyte buffers.
@end defun
@@ -5147,8 +5156,11 @@ as in @code{json-parse-string}.
@defun json-parse-string string &rest args
This function parses the JSON value in @var{string}, which must be a
-Lisp string. The argument @var{args} is a list of keyword/argument
-pairs. The following keywords are accepted:
+Lisp string. If @var{string} doesn't contain a valid JSON object,
+this function signals the @code{json-parse-error} error.
+
+The argument @var{args} is a list of keyword/argument pairs. The
+following keywords are accepted:
@table @code
@item :object-type
@@ -5158,6 +5170,11 @@ key-value mappings of a JSON object. It can be either
keys; @code{alist} to use alists with symbols as keys; or @code{plist}
to use plists with keyword symbols as keys.
address@hidden :array-type
+The value decides which Lisp object to use for representing a JSON
+array. It can be either @code{array}, the default, to use Lisp
+arrays; or @code{list} to use lists.
+
@item :null-object
The value decides which Lisp object to use to represent the JSON
keyword @code{null}. It defaults to the symbol @code{:null}.
@@ -5172,19 +5189,20 @@ keyword @code{false}. It defaults to the symbol
@code{:false}.
@defun json-parse-buffer &rest args
This function reads the next JSON value from the current buffer,
starting at point. It moves point to the position immediately after
-the value if a value could be read and converted to Lisp; otherwise it
-doesn't move point. The arguments @var{args} are interpreted as in
address@hidden
+the value if contains a valid JSON object; otherwise it signals the
address@hidden error and doesn't move point. The arguments
address@hidden are interpreted as in @code{json-parse-string}.
@end defun
@node JSONRPC
@section JSONRPC communication
@cindex JSON remote procedure call protocol
address@hidden JSONRPC
The @code{jsonrpc} library implements the @acronym{JSONRPC}
specification, version 2.0, as it is described in
@uref{http://www.jsonrpc.org/}. As the name suggests, JSONRPC is a
-generic @code{Remote Procedure Call} protocol designed around
+generic @dfn{Remote Procedure Call} protocol designed around
@acronym{JSON} objects, which you can convert to and from Lisp objects
(@pxref{Parsing JSON}).
@@ -5203,81 +5221,96 @@ transport agnostic in that the concepts can be used
within the same
process, over sockets, over http, or in many various message passing
environments."
address@hidden jsonrpc-connection
To model this agnosticism, the @code{jsonrpc} library uses objects of
-a @code{jsonrpc-connection} class, which represent a connection the
+a @code{jsonrpc-connection} class, which represent a connection to a
remote JSON endpoint (for details on Emacs's object system,
@pxref{Top,EIEIO,,eieio,EIEIO}). In modern object-oriented parlance,
-this class is ``abstract'', i.e. the actual class of a useful
-connection object used is always a subclass of it. Nevertheless, we
-can define two distinct API's around the @code{jsonrpc-connection}
-class:
+this class is ``abstract'', i.e.@: the actual class of a useful
+connection object is always a subclass of @code{jsonrpc-connection}.
+Nevertheless, we can define two distinct APIs around the
address@hidden class:
address@hidden JSONRPC application interfaces
@enumerate
@item A user interface for building JSONRPC applications
address@hidden :request-dispatcher
address@hidden :notification-dispatcher
address@hidden jsonrpc-notify
address@hidden jsonrpc-request
address@hidden jsonrpc-async-request
In this scenario, the JSONRPC application selects a concrete subclass
of @code{jsonrpc-connection}, and proceeds to create objects of that
subclass using @code{make-instance}. To initiate a contact to the
remote endpoint, the JSONRPC application passes this object to the
-functions @code{jsonrpc-notify'}, @code{jsonrpc-request} and
+functions @code{jsonrpc-notify}, @code{jsonrpc-request}, and/or
@code{jsonrpc-async-request}. For handling remotely initiated
contacts, which generally come in asynchronously, the instantiation
should include @code{:request-dispatcher} and
@code{:notification-dispatcher} initargs, which are both functions of
3 arguments: the connection object; a symbol naming the JSONRPC method
-invoked remotely; and a JSONRPC "params" object.
+invoked remotely; and a JSONRPC @code{params} object.
address@hidden jsonrpc-error
The function passed as @code{:request-dispatcher} is responsible for
handling the remote endpoint's requests, which expect a reply from the
local endpoint (in this case, the program you're building). Inside
-that function, you may either return locally (normally) or non-locally
-(error). A local return value must be a Lisp object serializable as
-JSON (@pxref{Parsing JSON}). This determines a success response, and
-the object is forwarded to the server as the JSONRPC "result" object.
-A non-local return, achieved by calling the function
address@hidden, causes an error response to be sent to the
-server. The details of the accompanying JSONRPC "error" are filled
-out with whatever was passed to @code{jsonrpc-error}. A non-local
-return triggered by an unexpected error of any other type also causes
-an error response to be sent (unless you have set
address@hidden, in which case this should land you in the
-debugger, @pxref{Error Debugging}).
+that function, you may either return locally (a normal return) or
+non-locally (an error return). A local return value must be a Lisp
+object that can be serialized as JSON (@pxref{Parsing JSON}). This
+determines a success response, and the object is forwarded to the
+server as the JSONRPC @code{result} object. A non-local return,
+achieved by calling the function @code{jsonrpc-error}, causes an error
+response to be sent to the server. The details of the accompanying
+JSONRPC @code{error} are filled out with whatever was passed to
address@hidden A non-local return triggered by an unexpected
+error of any other type also causes an error response to be sent
+(unless you have set @code{debug-on-error}, in which case this calls
+the Lisp debugger, @pxref{Error Debugging}).
@item A inheritance interface for building JSONRPC transport implementations
In this scenario, @code{jsonrpc-connection} is subclassed to implement
a different underlying transport strategy (for details on how to
-subclass, @pxref{Inheritance,Inheritance,,eieio}). Users of the
+subclass, see @ref{Inheritance,Inheritance,,eieio}.). Users of the
application-building interface can then instantiate objects of this
concrete class (using the @code{make-instance} function) and connect
to JSONRPC endpoints using that strategy.
This API has mandatory and optional parts.
address@hidden jsonrpc-connection-send
To allow its users to initiate JSONRPC contacts (notifications or
-requests) or reply to endpoint requests, the method
address@hidden must be implemented for the subclass.
+requests) or reply to endpoint requests, the subclass must have an
+implementation of the @code{jsonrpc-connection-send} method.
address@hidden jsonrpc-connection-receive
Likewise, for handling the three types of remote contacts (requests,
-notifications and responses to local requests) the transport
+notifications, and responses to local requests), the transport
implementation must arrange for the function
@code{jsonrpc-connection-receive} to be called after noticing a new
JSONRPC message on the wire (whatever that "wire" may be).
address@hidden jsonrpc-shutdown
address@hidden jsonrpc-running-p
Finally, and optionally, the @code{jsonrpc-connection} subclass should
-implement @code{jsonrpc-shutdown} and @code{jsonrpc-running-p} if
-these concepts apply to the transport. If they do, then any system
-resources (e.g. processes, timers, etc..) used listen for messages on
-the wire should be released in @code{jsonrpc-shutdown}, i.e. they
-should only be needed while @code{jsonrpc-running-p} is non-nil.
+implement the @code{jsonrpc-shutdown} and @code{jsonrpc-running-p}
+methods if these concepts apply to the transport. If they do, then
+any system resources (e.g.@: processes, timers, etc.) used to listen for
+messages on the wire should be released in @code{jsonrpc-shutdown},
+i.e.@: they should only be needed while @code{jsonrpc-running-p} is
+non-nil.
@end enumerate
@node Process-based JSONRPC connections
@subsection Process-based JSONRPC connections
address@hidden JSONRPC process-based connections
-For convenience, the @code{jsonrpc} library comes built-in with a
address@hidden jsonrpc-process-connection
+For convenience, the @code{jsonrpc} library comes with a built-in
@code{jsonrpc-process-connection} transport implementation that can
talk to local subprocesses (using the standard input and standard
output); or TCP hosts (using sockets); or any other remote endpoint
@@ -5292,6 +5325,7 @@ JSONRPC, see the
@uref{https://microsoft.github.io/language-server-protocol/specification,
Language Server Protocol}.
address@hidden JSONRPC connection initargs
Along with the mandatory @code{:request-dispatcher} and
@code{:notification-dispatcher} initargs, users of the
@code{jsonrpc-process-connection} class should pass the following
@@ -5300,29 +5334,32 @@ initargs as keyword-value pairs to @code{make-instance}:
@table @code
@item :process
Value must be a live process object or a function of no arguments
-producing one such object. If passed a process object, that is
-expected to contain an pre-established connection; otherwise, the
+producing one such object. If passed a process object, the object is
+expected to contain a pre-established connection; otherwise, the
function is called immediately after the object is made.
@item :on-shutdown
Value must be a function of a single argument, the
@code{jsonrpc-process-connection} object. The function is called
after the underlying process object has been deleted (either
-deliberately by @code{jsonrpc-shutdown} or unexpectedly, because of
+deliberately by @code{jsonrpc-shutdown}, or unexpectedly, because of
some external cause).
@end table
@node JSONRPC JSON object format
address@hidden JSON object format
address@hidden JSONRPC JSON object format
address@hidden JSONRPC object format
-JSON objects are exchanged as Lisp plists (@pxref{Parsing JSON}):
-JSON-compatible plists are handed to the dispatcher functions and,
-likewise, JSON-compatible plists should be given to
address@hidden, @code{jsonrpc-request} and
+JSONRPC JSON objects are exchanged as Lisp plists (@pxref{Property
+Lists}): JSON-compatible plists are handed to the dispatcher functions
+and, likewise, JSON-compatible plists should be given to
address@hidden, @code{jsonrpc-request}, and
@code{jsonrpc-async-request}.
-To facilitate handling plists, this library make liberal use of
address@hidden library and suggests (but doesn't force) its clients to
address@hidden jsonrpc-lambda
+To facilitate handling plists, this library makes liberal use of
address@hidden library (@pxref{Top,cl-lib,,cl,Common Lisp Extensions
+for GNU Emacs Lisp}) and suggests (but doesn't force) its clients to
do the same. A macro @code{jsonrpc-lambda} can be used to create a
lambda for destructuring a JSON-object like in this example:
@@ -5338,7 +5375,8 @@ lambda for destructuring a JSON-object like in this
example:
@end example
@node JSONRPC deferred requests
address@hidden Deferred requests
address@hidden Deferred JSONRPC requests
address@hidden JSONRPC deferred requests
In many @acronym{RPC} situations, synchronization between the two
communicating endpoints is a matter of correctly designing the RPC
@@ -5350,6 +5388,7 @@ is still uncertainty about the state of the remote
endpoint.
Furthermore, acting on these events may only sometimes demand
synchronization, depending on the event's specific nature.
address@hidden :address@hidden, JSONRPC keyword}
The @code{:deferred} keyword argument to @code{jsonrpc-request} and
@code{jsonrpc-async-request} is designed to let the caller indicate
that the specific request needs synchronization and its actual
@@ -5360,9 +5399,10 @@ isn't sent immediately, @code{jsonrpc} will make renewed
efforts to
send it at certain key times during communication, such as when
receiving or sending other messages to the endpoint.
address@hidden jsonrpc-connection-ready-p
Before any attempt to send the request, the application-specific
-conditions are checked. Since the @code{jsonrpc} library can't known
-what these conditions are, the programmer may use the
+conditions are checked. Since the @code{jsonrpc} library can't know
+what these conditions are, the program can use the
@code{jsonrpc-connection-ready-p} generic function (@pxref{Generic
Functions}) to specify them. The default method for this function
returns @code{t}, but you can add overriding methods that return
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index 6b71632..32e8c2a 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -1951,7 +1951,13 @@ The optional argument @var{all-frames} has the same
meaning as in
@code{next-window}.
This function does not select a window that has a address@hidden
address@hidden window parameter (@pxref{Window Parameters}).
address@hidden window parameter (@pxref{Window Parameters}),
+provided that @code{ignore-window-parameters} is @code{nil}.
+
+If the @code{other-window} parameter of the selected window is a
+function, and @code{ignore-window-parameters} is @code{nil}, that
+function will be called with the arguments @var{count} and
address@hidden instead of the normal operation of this function.
@end deffn
@defun walk-windows fun &optional minibuf all-frames
@@ -3936,8 +3942,33 @@ described next to deal with the window and its buffer.
This function handles @var{window} and its buffer after quitting. The
optional argument @var{window} must be a live window and defaults to
the selected one. The function's behavior is determined by the four
-elements of the @code{quit-restore} window parameter (@pxref{Window
-Parameters}), which is set to @code{nil} afterwards.
+elements of the list specified by the @code{quit-restore} window
+parameter (@pxref{Window Parameters}), which is set to @code{nil}
+afterwards.
+
+The first element of the @code{quit-restore} parameter is one of the
+symbols @code{window}, meaning that the window has been specially
+created by @code{display-buffer}; @code{frame}, a separate frame has
+been created; @code{same}, the window has only ever displayed this
+buffer; or @code{other}, the window showed another buffer before.
address@hidden and @code{window} affect how the window is quit, while
address@hidden and @code{other} affect the redisplay of buffers
+previously shown in this window.
+
+The second element is either one of the symbols @code{window} or
address@hidden, or a list whose elements are the buffer shown in the
+window before, that buffer's window start and window point positions,
+and the window's height at that time. If that buffer is still live
+when the window is quit, then the function @code{quit-restore-window}
+reuses the window to display the buffer.
+
+The third element is the window selected at the time the parameter was
+created. If @code{quit-restore-window} deletes the window passed to
+it as argument, it then tries to reselect this window.
+
+The fourth element is the buffer whose display caused the creation of
+this parameter. @code{quit-restore-window} deletes the specified window
+only if it still shows that buffer.
The window is deleted entirely if: 1) the first element of the
@code{quit-restore} parameter is one of 'window or 'frame, 2) the
@@ -4627,13 +4658,14 @@ This function sets the display-start position of
@var{window} to
@var{position} in @var{window}'s buffer. It returns @var{position}.
The display routines insist that the position of point be visible when a
-buffer is displayed. Normally, they change the display-start position
-(that is, scroll the window) whenever necessary to make point visible.
-However, if you specify the start position with this function using
address@hidden for @var{noforce}, it means you want display to start at
address@hidden even if that would put the location of point off the
-screen. If this does place point off screen, the display routines move
-point to the left margin on the middle line in the window.
+buffer is displayed. Normally, they select the display-start position
+according to their internal logic (and scroll the window if necessary)
+to make point visible. However, if you specify the start position
+with this function using @code{nil} for @var{noforce}, it means you
+want display to start at @var{position} even if that would put the
+location of point off the screen. If this does place point off
+screen, the display routines attempt to move point to the left margin
+on the middle line in the window.
For example, if point @w{is 1} and you set the start of the window
@w{to 37}, the start of the next line, point will be above the top
@@ -4680,6 +4712,13 @@ it is still 1 when redisplay occurs. Here is an example:
@end group
@end example
+If the attempt to make point visible (i.e., in a fully-visible screen
+line) fails, the display routines will disregard the requested
+window-start position and compute a new one anyway. Thus, for
+reliable results Lisp programs that call this function should always
+move point to be inside the window whose display starts at
address@hidden
+
If @var{noforce} is address@hidden, and @var{position} would place point
off screen at the next redisplay, then redisplay computes a new window-start
position that works well with point, and thus @var{position} is not used.
@@ -5796,8 +5835,8 @@ and heights, if possible. Frames are not resized by this
function.
@section Window Parameters
@cindex window parameters
-This section describes how window parameters can be used to associate
-additional information with windows.
+This section describes the window parameters that can be used to
+associate additional information with windows.
@defun window-parameter window parameter
This function returns @var{window}'s value for @var{parameter}. The
@@ -5930,44 +5969,21 @@ parameter is installed and updated by the function
@vindex address@hidden, a window parameter}
This parameter is installed by the buffer display functions
(@pxref{Choosing Window}) and consulted by @code{quit-restore-window}
-(@pxref{Quitting Windows}). It contains four elements:
-
-The first element is one of the symbols @code{window}, meaning that
-the window has been specially created by @code{display-buffer};
address@hidden, a separate frame has been created; @code{same}, the
-window has only ever displayed this buffer; or @code{other}, the
-window showed another buffer before. @code{frame} and @code{window}
-affect how the window is quit, while @code{same} and @code{other}
-affect the redisplay of buffers previously shown in this window.
+(@pxref{Quitting Windows}). It is a list of four elements, see the
+description of @code{quit-restore-window} in @ref{Quitting Windows}
+for details.
-The second element is either one of the symbols @code{window} or
address@hidden, or a list whose elements are the buffer shown in the
-window before, that buffer's window start and window point positions,
-and the window's height at that time. If that buffer is still live
-when the window is quit, then the function @code{quit-restore-window}
-reuses the window to display the buffer.
-
-The third element is the window selected at the time the parameter was
-created. If @code{quit-restore-window} deletes the window passed to
-it as argument, it then tries to reselect this window.
-
-The fourth element is the buffer whose display caused the creation of
-this parameter. @code{quit-restore-window} deletes the specified window
-only if it still shows that buffer.
-
-See the description of @code{quit-restore-window} in @ref{Quitting
-Windows} for details.
-
address@hidden window-side window-slot
address@hidden window-side
address@hidden window-slot
@vindex address@hidden, a window parameter}
@vindex address@hidden, a window parameter}
-These parameters are used for implementing side windows (@pxref{Side
-Windows}).
+These parameters are used internally for implementing side windows
+(@pxref{Side Windows}).
@item window-atom
@vindex address@hidden, a window parameter}
-This parameter is used for implementing atomic windows, see @ref{Atomic
-Windows}.
+This parameter is used internally for implementing atomic windows, see
address@hidden Windows}.
@item mode-line-format
@vindex address@hidden, a window parameter}
@@ -5989,11 +6005,12 @@ affected.
@item min-margins
@vindex address@hidden, a window parameter}
-The value of this parameter is a cons cell whose @sc{car} and @sc{cdr},
-if address@hidden, specify the minimum values (in columns) for the left
-and right margin of this window. When present, Emacs will use these
-values instead of the actual margin widths for determining whether a
-window can be split or shrunk horizontally.
+The value of this parameter is a cons cell whose @sc{car} and
address@hidden, if address@hidden, specify the minimum values (in columns)
+for the left and right margin of this window (@pxref{Display Margins}.
+When present, Emacs will use these values instead of the actual margin
+widths for determining whether a window can be split or shrunk
+horizontally.
Emacs never auto-adjusts the margins of any window after splitting or
resizing it. It is the sole responsibility of any application setting
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 32b5076..eb06791 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -4149,7 +4149,7 @@ package, @code{cl-typep} simply looks for a function
called
only if they used the default predicate name.
@item :include
-This option implements a very limited form of C++-style inheritance.
+This option implements a very limited form of address@hidden inheritance.
The argument is the name of another structure type previously
created with @code{cl-defstruct}. The effect is to cause the new
structure type to inherit all of the included structure's slots
@@ -4194,6 +4194,10 @@ of a @code{person}, plus extra slots that are specific to
astronauts. Operations that work on people (like @code{person-name})
work on astronauts just like other people.
address@hidden :noinline
+If this option is present, this structure's functions will not be
+inlined, even functions that normally would.
+
@item :print-function
In full Common Lisp, this option allows you to specify a function
that is called to print an instance of the structure type. The
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index d03ee79..f56b2b6 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -88,11 +88,11 @@ framework for writing object-oriented applications in Emacs.
use @eieio{} to create classes, methods for those classes, and
instances of classes.
-Here is a simple example of a class named @code{record}, containing
+Here is a simple example of a class named @code{person}, containing
three slots named @code{name}, @code{birthday}, and @code{phone}:
@example
-(defclass record () ; No superclasses
+(defclass person () ; No superclasses
((name :initarg :name
:initform ""
:type string
@@ -106,23 +106,23 @@ three slots named @code{name}, @code{birthday}, and
@code{phone}:
(phone :initarg :phone
:initform ""
:documentation "Phone number."))
- "A single record for tracking people I know.")
+ "A class for tracking people I know.")
@end example
Each class can have methods, which are defined like this:
@example
-(cl-defmethod call-record ((rec record) &optional scriptname)
- "Dial the phone for the record REC.
+(cl-defmethod call-person ((pers person) &optional scriptname)
+ "Dial the phone for the person PERS.
Execute the program SCRIPTNAME to dial the phone."
- (message "Dialing the phone for %s" (oref rec name))
+ (message "Dialing the phone for %s" (oref pers name))
(shell-command (concat (or scriptname "dialphone.sh")
" "
- (oref rec phone))))
+ (oref pers phone))))
@end example
@noindent
-In this example, the first argument to @code{call-record} is a list,
+In this example, the first argument to @code{call-person} is a list,
of the form (@var{varname} @var{classname}). @var{varname} is the
name of the variable used for the first argument; @var{classname} is
the name of the class that is expected as the first argument for this
@@ -130,17 +130,17 @@ method.
@eieio{} dispatches methods based on the type of the first argument.
You can have multiple methods with the same name for different classes
-of object. When the @code{call-record} method is called, the first
+of object. When the @code{call-person} method is called, the first
argument is examined to determine the class of that argument, and the
method matching the input type is then executed.
Once the behavior of a class is defined, you can create a new
-object of type @code{record}. Objects are created by calling the
+object of type @code{person}. Objects are created by calling the
constructor. The constructor is a function with the same name as your
class which returns a new instance of that class. Here is an example:
@example
-(setq rec (record :name "Eric" :birthday "June" :phone "555-5555"))
+(setq pers (person :name "Eric" :birthday "June" :phone "555-5555"))
@end example
@noindent
@@ -157,19 +157,19 @@ first argument should be an object of a class which has
had this
method defined for it. In this example it would look like this:
@example
-(call-record rec)
+(call-person pers)
@end example
@noindent
or
@example
-(call-record rec "my-call-script")
+(call-person pers "my-call-script")
@end example
In these examples, @eieio{} automatically examines the class of
address@hidden, and ensures that the method defined above is called. If
address@hidden is some other class lacking a @code{call-record} method, or
address@hidden, and ensures that the method defined above is called. If
address@hidden is some other class lacking a @code{call-person} method, or
some other data type, Emacs signals a @code{cl-no-applicable-method}
error. @ref{Signals}.
@@ -270,10 +270,18 @@ by a symbol with the name @var{class-name}. @eieio{}
stores the structure of
the class as a symbol property of @var{class-name} (@pxref{Symbol
Components,,,elisp,GNU Emacs Lisp Reference Manual}).
+When defining a class, @eieio{} overwrites any preexisting variable or
+function bindings for the symbol @var{class-name}, which may lead to
+undesired consequences. Before naming a new class, you should check
+for name conflicts. To help avoid cross-package conflicts you should
+choose a name with the same prefix you chose for the rest of your
+package's functions and variables (@pxref{Coding
+Conventions,,,elisp,GNU Emacs Lisp Reference Manual}).
+
The @var{class-name} symbol's variable documentation string is a
modified version of the doc string found in @var{options-and-doc}.
Each time a method is defined, the symbol's documentation string is
-updated to include the methods documentation as well.
+updated to include the method's documentation as well.
The parent classes for @var{class-name} is @var{superclass-list}.
Each element of @var{superclass-list} must be a class. These classes
@@ -625,10 +633,10 @@ function of @code{:initform}.
@node Making New Objects
@chapter Making New Objects
-Suppose we have a simple class is defined, such as:
+Suppose we have defined a simple class, such as:
@example
-(defclass record ()
+(defclass my-class ()
( ) "Doc String")
@end example
@@ -636,10 +644,10 @@ Suppose we have a simple class is defined, such as:
It is now possible to create objects of that class type.
Calling @code{defclass} has defined two new functions. One is the
-constructor @var{record}, and the other is the predicate,
address@hidden
+constructor @var{my-class}, and the other is the predicate,
address@hidden
address@hidden record object-name &rest slots
address@hidden my-class object-name &rest slots
This creates and returns a new object. This object is not assigned to
anything, and will be garbage collected if not saved. This object
@@ -657,7 +665,7 @@ can do any valid Lispy thing you want with it, such as
Example of creating an object from a class:
@example
-(record :value 3 :reference nil)
+(my-class :value 3 :reference nil)
@end example
@end defun
diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi
index edab900..2b2c241 100644
--- a/doc/misc/nxml-mode.texi
+++ b/doc/misc/nxml-mode.texi
@@ -250,7 +250,7 @@ xml:lang xmlns
If you input @kbd{xmlns}, the result will be:
@example
-<html xmlns="@point{}
+<html xmlns="@point{}"
@end example
@noindent
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index 5ae97d7..192284c 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2019-03-09.13}
+\def\texinfoversion{2019-03-03.15}
%
% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc.
@@ -387,8 +387,14 @@
% take effect in \write's, yet the group defined by the \vbox ends
% before the \shipout runs.
%
- \atdummies % don't expand commands in the output.
- \turnoffactive
+ \indexdummies % don't expand commands in the output.
+ \normalturnoffactive % \ in index entries must not stay \, e.g., if
+ % the page break happens to be in the middle of an example.
+ % We don't want .vr (or whatever) entries like this:
+ % \entry{{\indexbackslash }acronym}{32}{\code {\acronym}}
+ % "\acronym" won't work when it's read back in;
+ % it needs to be
+ % {\code {{\backslashcurfont }acronym}
\shipout\vbox{%
% Do this early so pdf references go to the beginning of the page.
\ifpdfmakepagedest \pdfdest name{\the\pageno} xyz\fi
@@ -4852,8 +4858,23 @@ end
\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
-% Used for the aux, toc and index files to prevent expansion of Texinfo
-% commands.
+% Used when writing an index entry out to an index file to prevent
+% expansion of Texinfo commands that can appear in an index entry.
+%
+\def\indexdummies{%
+ \escapechar = `\\ % use backslash in output files.
+ address@hidden
+ \definedummyletter\ %
+ %
+ % For texindex which always views { and } as separators.
+ \def\{{\lbracechar{}}%
+ \def\}{\rbracechar{}}%
+ %
+ % Do the redefinitions.
+ \definedummies
+}
+
+% Used for the aux and toc files, where @ is the escape character.
%
\def\atdummies{%
address@hidden
@@ -4883,7 +4904,8 @@ end
\def\definedummyletter#1{\def#1{\string#1}}%
\let\definedummyaccent\definedummyletter
-% Called from \atdummies to prevent the expansion of commands.
+% Called from \indexdummies and \atdummies, to effectively prevent
+% the expansion of commands.
%
\def\definedummies{%
%
@@ -5048,9 +5070,11 @@ end
\commondummyword\xref
}
+% This does nothing, but for a time it was recommended to use
+% \usebracesinindexestrue to be able to use braces in index entries.
+
\let\indexlbrace\relax
\let\indexrbrace\relax
-\let\indexatchar\relax
address@hidden
\catcode`\\=13
@@ -5084,8 +5108,10 @@ end
}
\gdef\indexnonalnumreappear{%
+ \useindexbackslash
\let-\normaldash
\let<\normalless
+ address@hidden@}%
}
}
@@ -5196,6 +5222,8 @@ end
+\let\SETmarginindex=\relax % put index entries in margin (undocumented)?
+
% #1 is the index name, #2 is the entry text.
\def\doind#1#2{%
\iflinks
@@ -5227,6 +5255,13 @@ end
\fi}
\def\indexisfl{fl}
+% Output \ as {\indexbackslash}, because \ is an escape character in
+% the index files.
+\let\indexbackslash=\relax
address@hidden \catcode`\\=\active
+ @address@hidden@address@hidden
+}
+
% Definition for writing index entry sort key.
{
\catcode`\-=13
@@ -5238,9 +5273,6 @@ end
\xdef\indexsortkey{#1}\endgroup}
}
-% The default definition
-\def\sortas#1{}%
-
% Given index entry text like "aaa @subentry bbb @sortas{ZZZ}":
% * Set \bracedtext to "{aaa}{bbb}"
% * Set \fullindexsortkey to "aaa @subentry ZZZ"
@@ -5260,6 +5292,7 @@ end
%
% Fully expand the segment, throwing away any @sortas directives, and
% trim spaces.
+ \def\sortas##1{}%
\edef\trimmed{\segment}%
\edef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}%
%
@@ -5275,8 +5308,6 @@ end
\def\rbracechar{{\indexrbrace}}%
\let\{=\lbracechar
\let\}=\rbracechar
- address@hidden
- address@hidden
%
\let\indexsortkey\empty
% Execute the segment and throw away the typeset output. This executes
@@ -5301,20 +5332,21 @@ end
\fi
}
\def\isfinish{\finish}%
-\newbox\dummybox % used above
\let\subentry\relax
% Write the entry in \toks0 to the index file.
%
\def\doindwrite{%
- \maybemarginindex
- %
- \atdummies
+ % Put the index entry in the margin if desired.
+ \ifx\SETmarginindex\relax\else
+ \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \the\toks0}}%
+ \fi
%
- % For texindex which always views { and } as separators.
- \def\{{\lbracechar{}}%
- \def\}{\rbracechar{}}%
+ % Remember, we are within a group.
+ \indexdummies % Must do this here, since \bf, etc expand at this stage
+ \useindexbackslash % \indexbackslash isn't defined now so it will be output
+ % as is; and it will print as backslash.
%
% Split the entry into primary entry and any subentries, and get the index
% sort key.
@@ -5332,15 +5364,7 @@ end
}%
\temp
}
-
-% Put the index entry in the margin if desired (undocumented).
-\def\maybemarginindex{%
- \ifx\SETmarginindex\relax\else
- \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \relax\indextext}}%
- \fi
-}
-\let\SETmarginindex=\relax
-
+\newbox\dummybox % used above
% Take care of unwanted page breaks/skips around a whatsit:
%
@@ -5455,10 +5479,14 @@ end
\plainfrenchspacing
\everypar = {}% don't want the \kern\-parindent from indentation suppression.
%
+ % See if the index file exists and is nonempty.
+ % Change catcode of @ here so that if the index file contains
+ % \initial address@hidden
+ % as its first line, TeX doesn't complain about mismatched braces
+ % (because it thinks @} is a control sequence).
+ \catcode`\@ = 12
% See comment in \requireopenindexfile.
\def\indexname{#1}\ifx\indexname\indexisfl\def\indexname{f1}\fi
- %
- % See if the index file exists and is nonempty.
\openin 1 \jobname.\indexname s
\ifeof 1
% \enddoublecolumns gets confused if there is no text in the index,
@@ -5468,6 +5496,8 @@ end
\putwordIndexNonexistent
\typeout{No file \jobname.\indexname s.}%
\else
+ \catcode`\\ = 0
+ %
% If the index file exists but is empty, then \openin leaves \ifeof
% false. We have to make TeX try to read something from the file, so
% it can discover if there is anything in it.
@@ -5475,7 +5505,29 @@ end
\ifeof 1
\putwordIndexIsEmpty
\else
- \expandafter\printindexzz\thisline\relax\relax\finish%
+ % Index files are almost Texinfo source, but we use \ as the escape
+ % character. It would be better to use @, but that's too big a change
+ % to make right now.
+ \def\indexbackslash{\ttbackslash}%
+ \let\indexlbrace\{ % Likewise, set these sequences for braces
+ \let\indexrbrace\} % used in the sort key.
+ \begindoublecolumns
+ \let\dotheinsertentrybox\dotheinsertentryboxwithpenalty
+ %
+ % Read input from the index file line by line.
+ \loopdo
+ \ifeof1 \else
+ \read 1 to \nextline
+ \fi
+ %
+ \indexinputprocessing
+ \thisline
+ %
+ \ifeof1\else
+ \let\thisline\nextline
+ \repeat
+ %%
+ \enddoublecolumns
\fi
\fi
\closein 1
@@ -5483,40 +5535,6 @@ end
\def\loopdo#1\repeat{\def\body{#1}\loopdoxxx}
\def\loopdoxxx{\let\next=\relax\body\let\next=\loopdoxxx\fi\next}
-% If the index file starts with a backslash, forgo reading the index
-% file altogether. If somebody upgrades texinfo.tex they may still have
-% old index files using \ as the escape character. Reading this would
-% at best lead to typesetting garbage, at worst a TeX syntax error.
-\def\printindexzz#1#2\finish{%
- % NB this won't work if the index file starts with a group...
- \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1
- \message{skipping sorted index file}%
- (Skipped sorted index file in obsolete format)
- \else
- \printindexzzz
- \fi
-}
-
-\def\printindexzzz{%
- \begindoublecolumns
- \let\dotheinsertentrybox\dotheinsertentryboxwithpenalty
- %
- % Read input from the index file line by line.
- \loopdo
- \ifeof1 \else
- \read 1 to \nextline
- \fi
- %
- \indexinputprocessing
- \thisline
- %
- \ifeof1\else
- \let\thisline\nextline
- \repeat
- %%
- \enddoublecolumns
-}
-
\def\indexinputprocessing{%
\ifeof1
\let\firsttoken\relax
@@ -5536,18 +5554,12 @@ end
\catcode`\|=13 \catcode`\<=13 \catcode`\>=13 \catcode`\+=13 \catcode`\"=13
\catcode`\$=3
\gdef\initialglyphs{%
- % special control sequences used in the index sort key
- \let\indexlbrace\{%
- \let\indexrbrace\}%
- address@hidden
- %
% Some changes for non-alphabetic characters. Using the glyphs from the
% math fonts looks more consistent than the typewriter font used elsewhere
% for these characters.
- \uccode`\~=`\\ \uppercase{\def~{\math{\backslash}}}
+ \def\indexbackslash{\math{\backslash}}%
+ \let\\=\indexbackslash
%
- % In case @\ is used for backslash
- \uppercase{\let\\=~}
% Can't get bold backslash so don't use bold forward slash
\catcode`\/=13
\def/{{\secrmnotbold \normalslash}}%
@@ -8041,17 +8053,33 @@ end
% alias because \c means cedilla in @tex or @math
\let\texinfoc=\c
+\newcount\savedcatcodeone
+\newcount\savedcatcodetwo
+
% Used at the time of macro expansion.
% Argument is macro body with arguments substituted
\def\scanmacro#1{%
\newlinechar`\^^M
\def\xeatspaces{\eatspaces}%
%
+ % Temporarily undo catcode changes of \printindex. Set catcode of @ to
+ % 0 so that @-commands in macro expansions aren't printed literally when
+ % formatting an index file, where \ is used as the escape character.
+ \savedcatcodeone=\catcode`\@
+ \savedcatcodetwo=\catcode`\\
+ address@hidden
+ \catcode`\\=\active
+ %
% Process the macro body under the current catcode regime.
address@hidden
%
+ address@hidden
+ \catcode`\\=\savedcatcodetwo
+ %
% The \texinfoc is to remove the \newlinechar added by \scantokens, and
% can be noticed by \parsearg.
+ % We avoid surrounding the call to \scantokens with \bgroup and \egroup
+ % to allow macros to open or close groups themselves.
}
% Used for copying and captions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index ea6ad15..3dfd522 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2,9 +2,8 @@
@setfilename ../../info/tramp.info
@c %**start of header
@include docstyle.texi
address@hidden In the Tramp repository, the version number is auto-frobbed from
address@hidden configure.ac, so you should edit that file and run
address@hidden "autoconf && ./configure" to change the version number.
address@hidden In the Tramp GIT, the version number is auto-frobbed from
tramp.el,
address@hidden and the bug report address is auto-frobbed from configure.ac.
@include trampver.texi
@settitle @value{tramp} @value{trampver} User Manual
@c %**end of header
@@ -52,7 +51,7 @@ editing package for Emacs.
@value{tramp} stands for ``Transparent Remote (file) Access, Multiple
Protocol''. This package provides remote file editing, similar to
-Ange FTP.
+Ange address@hidden
The difference is that Ange FTP uses FTP to transfer files between the
local and the remote host, whereas @value{tramp} uses a combination of
@@ -584,6 +583,13 @@ installed and loaded:
(customize-set-variable 'tramp-verbose 6 "Enable remote command traces")
@end lisp
+For functions used to configure @value{tramp}, the following clause
+might be used in your init file:
+
address@hidden
+(with-eval-after-load 'tramp (tramp-change-syntax 'simplified))
address@hidden lisp
+
@menu
* Connection types:: Types of connections to remote hosts.
@@ -961,7 +967,7 @@ after a predefined timeout.
@cindex @option{ftp} method
When @value{tramp} uses @option{ftp}, it forwards requests to whatever
-ftp program is specified by Ange FTP. This external program must be
+ftp program is specified by Ange address@hidden This external program must be
capable of servicing requests from @value{tramp}.
@item @option{smb}
@@ -1085,8 +1091,8 @@ numbers are not applicable to Android devices connected
through address@hidden
The program @command{rclone} allows to access different system
storages in the cloud, see @url{https://rclone.org/} for a list of
supported systems. If the @command{rclone} program isn't found in
-your @env{PATH} environment variable, you can tell Tramp its absolute
-path via the user option @code{tramp-rclone-program}.
+your @env{PATH} environment variable, you can tell @value{tramp} its
+absolute path via the user option @code{tramp-rclone-program}.
A system storage must be configured via the @command{rclone config}
command, outside Emacs. If you have configured a storage in
@@ -1101,7 +1107,7 @@ User names are part of the @command{rclone}
configuration, and not
needed in the remote file name. If a user name is contained in the
remote file name, it is ignored.
-Internally, Tramp mounts the remote system storage at location
+Internally, @value{tramp} mounts the remote system storage at location
@file{/tmp/tramp.rclone.storage}, with @file{storage} being the name
of the configured system storage.
@@ -1531,8 +1537,8 @@ Host host.other.domain
@end group
@end example
address@hidden is BSD's netcat program, which establishes HTTP tunnels. Any
-other program with such a feature could be used as well.
address@hidden is BSD's netcat program, which establishes HTTP tunnels.
+Any other program with such a feature could be used as well.
In the example, opening @address@hidden,host.your.domain,}} passes
the HTTP proxy server @samp{proxy.your.domain} on port 3128.
@@ -1608,7 +1614,7 @@ Integration for LXD containers. A container is accessed
via
@cindex method @option{git}
@cindex @option{git} method
Browing git repositories with @code{magit}. A versioned file is accessed via
address@hidden@trampfn{git,rev@@root-dir,/path/to/file}}. @samp{rev} is a git
address@hidden@trampfn{git,rev@@root-dir,/path/to/file}}. @samp{rev} is a git
revision, and @samp{root-dir} is a virtual host name for the root
directory, specified in @code{magit-tramp-hosts-alist}.
@@ -1979,6 +1985,39 @@ preserves the path value, which can be used to update
shell supports the login argument @samp{-l}.
@end defopt
+Starting with Emacs 26, @code{tramp-remote-path} can be set per host
+via connection-local
address@hidden
+variables, @xref{Connection Variables, , , emacs}.
address@hidden ifinfo
address@hidden
+variables.
address@hidden ifnotinfo
+You could define your own search directories like this:
+
address@hidden
address@hidden
+(connection-local-set-profile-variables 'remote-path-with-bin
+ '((tramp-remote-path . ("~/bin" tramp-default-remote-path))))
address@hidden group
+
address@hidden
+(connection-local-set-profile-variables 'remote-path-with-apply-pub-bin
+ '((tramp-remote-path . ("/appli/pub/bin" tramp-default-remote-path))))
address@hidden group
+
address@hidden
+(connection-local-set-profiles
+ '(:application tramp :machine "randomhost") 'remote-path-with-bin)
address@hidden group
+
address@hidden
+(connection-local-set-profiles
+ '(:application tramp :user "anotheruser" :machine "anotherhost")
+ 'remote-path-with-apply-pub-bin)
address@hidden group
address@hidden lisp
+
When remote search paths are changed, local @value{tramp} caches must
be recomputed. To force @value{tramp} to recompute afresh, call
@kbd{M-x tramp-cleanup-this-connection @key{RET}} or friends
@@ -2602,7 +2641,7 @@ names. Beside the @code{default} value, @var{syntax} can
be
@item @code{simplified}
@cindex simplified syntax
-The remote file name syntax is similar to the syntax used by Ange FTP.
+The remote file name syntax is similar to the syntax used by Ange
address@hidden
A remote file name has the form
@address@hidden@@address@hidden/to/file}. The
@code{user@@} part is optional, and the method is determined by
@@ -2631,7 +2670,7 @@ name syntax. Its value changes after every call of
this variable in external packages, a call of @code{file-remote-p} is
much more appropriate.
@ifinfo
address@hidden File Names, , , elisp}
address@hidden File Names, , , elisp}.
@end ifinfo
@end defvar
@end ifset
@@ -2970,7 +3009,7 @@ Starting with Emacs 26, you could use connection-local
variables for
setting different values of @code{explicit-shell-file-name} for
different remote hosts.
@ifinfo
address@hidden Variables, , , emacs}
address@hidden Variables, , , emacs}.
@end ifinfo
@lisp
@@ -3680,7 +3719,7 @@ Set @code{file-precious-flag} to @code{t} for files
accessed by
@value{tramp} so the file contents are checked using checksum by
first saving to a temporary file.
@ifinfo
address@hidden Buffers, , , elisp}
address@hidden Buffers, , , elisp}.
@end ifinfo
@lisp
@@ -4332,7 +4371,7 @@ handlers.
@vindex non-essential
Sometimes, it is not convenient to open a new connection to a remote
host, including entering the password and alike. For example, this is
-nasty for packages providing file name completion. Such a package
+nasty for packages providing file name completion. Such a package
could signal to @value{tramp}, that they don't want it to establish a
new connection. Use the variable @code{non-essential} temporarily and
bind it to address@hidden value.
diff --git a/etc/AUTHORS b/etc/AUTHORS
index 73c5245..2f7e015 100644
--- a/etc/AUTHORS
+++ b/etc/AUTHORS
@@ -163,7 +163,7 @@ Alexandru Harsanyi: wrote soap-client.el soap-inspect.el
and changed emacs3.py vc-hooks.el vc.el xml.el
Alex Branham: changed bibtex.el dired-x.el dired.el em-rebind.el eww.el
- imenu.el modes.texi programs.texi
+ imenu.el indent.el modes.texi programs.texi text.texi
Alex Coventry: changed files.el
@@ -442,8 +442,8 @@ Bartosz Duszel: changed allout.el bib-mode.el cc-cmds.el
hexl.el icon.el
Basil L. Contovounesios: changed simple.el message.el sequences.texi
bibtex.el css-mode-tests.el css-mode.el customize.texi display.texi
- gnus-art.el json-tests.el json.el lists.texi man.el modes.texi rcirc.el
- shr-color.el text.texi url-handlers.el
+ gnus-art.el json-tests.el json.el lists.texi man.el modes.texi
+ newcomment.el rcirc.el shr-color.el text.texi url-handlers.el
Bastian Beischer: changed include.el mru-bookmark.el refs.el
semantic/complete.el senator.el
@@ -1354,8 +1354,8 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c]
tty-colors.el
and changed xdisp.c msdos.c w32.c display.texi w32fns.c simple.el
files.el fileio.c keyboard.c w32proc.c files.texi w32term.c text.texi
- dispnew.c frames.texi emacs.c dispextern.h lisp.h process.c term.c
- window.c and 1125 other files
+ dispnew.c emacs.c frames.texi dispextern.h lisp.h window.c process.c
+ term.c and 1125 other files
Emanuele Giaquinta: changed configure.ac rxvt.el charset.c etags.c
fontset.c frame.el gnus-faq.texi loadup.el lread.c sh-script.el
@@ -1380,7 +1380,7 @@ Eric Abrahamsen: changed eieio-base.el registry.el
nnimap.el
gnus-registry.el files.el files.texi windows.texi eieio-test-persist.el
eieio.el gnus-start.el gnus-sum.el gnus.texi nnir.el buffers.texi
checkdoc.el files-tests.el gnus-bcklg.el gnus-group.el nnmairix.el
- org.el org.texi and 3 other files
+ org.el org.texi and 4 other files
Eric Bélanger: changed image.c
@@ -1682,9 +1682,9 @@ Geert Kloosterman: changed which-func.el
Gemini Lasswell: wrote edebug-tests.el kmacro-tests.el testcover-tests.el
and changed edebug.el cl-macs.el cl-generic.el ert-x.el cl-print.el
edebug-test-code.el edebug.texi eieio-compat.el generator.el subr.el
- autorevert-tests.el cl-print-tests.el emacs-lisp/debug.el eval-tests.el
- eval.c filenotify-tests.el generator-tests.el kmacro.el lread.c
- map-tests.el map.el and 9 other files
+ autorevert-tests.el cl-print-tests.el eieio.texi emacs-lisp/debug.el
+ eval-tests.el eval.c filenotify-tests.el generator-tests.el kmacro.el
+ lread.c map-tests.el and 10 other files
Geoff Gole: changed align.el ibuffer.el whitespace.el
@@ -3258,6 +3258,8 @@ Matt Hodges: changed textmodes/table.el faces.el
iswitchb.el simple.el
edebug.texi eldoc.el em-hist.el em-pred.el fixit.texi icon.el ido.el
locate.el paragraphs.el pcomplete.el repeat.el and 3 other files
+Mattias Engdegård: changed subr.el
+
Matt Lundin: changed org-agenda.el org.el org-bibtex.el org-footnote.el
ox-publish.el org-bbdb.el org-datetree.el org-gnus.el
@@ -3270,7 +3272,7 @@ Matt Simmons: changed message.el
Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el
outline.el progmodes/compile.el rx.el simple.el startup.el
-Mauro Aranda: changed files.texi os.texi
+Mauro Aranda: changed autorevert.el files.texi os.texi
Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el
@@ -3649,7 +3651,7 @@ Noam Postavsky: changed lisp-mode.el progmodes/python.el
xdisp.c
cl-macs.el lisp-mode-tests.el emacs-lisp/debug.el data.c simple.el
term.el ert.el subr.el help-fns.el bytecomp.el cl-print.el
elisp-mode.el eval.c ffap.el modes.texi search.c sh-script.el
- cl-preloaded.el and 248 other files
+ cl-preloaded.el and 249 other files
Nobuyoshi Nakada: co-wrote ruby-mode.el
diff --git a/etc/HISTORY b/etc/HISTORY
index b239904..bf03692 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -216,6 +216,8 @@ GNU Emacs 25.3 (2017-09-11) emacs-25.3
GNU Emacs 26.1 (2018-05-28) emacs-26.1
+GNU Emacs 26.2 (2019-04-12) emacs-26.2
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index 9f569a7..82d27d7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -37,6 +37,12 @@ functions 'json-serialize', 'json-insert',
'json-parse-string', and
'json-parse-buffer' are typically much faster than their Lisp
counterparts from json.el.
+** Several configure options now accept an option-argument 'ifavailable'.
+For example, './configure --with-xpm=ifavailable' now configures Emacs
+to attempt to use libxpm but to continue building even if libxpm is absent.
+The other affected options are --with-gif, --with-gnutls, --with-jpeg,
+--with-png, and --with-tiff.
+
** The etags program now uses the C library's regular expression matcher
when possible, and a compatible regex substitute otherwise. This will
let developers maintain Emacs's own regex code without having to also
@@ -78,6 +84,11 @@ The new command-line argument '--dump-file=FILE' allows to
specify a
non-default '.pdmp' file to load the state from; see the node "Initial
Options" in the Emacs manual for more information.
++++
+** The new configure option '--enable-checking=structs' attempts to
+check that the portable dumper code has been updated to match the last
+change to one of the data structures that it relies on.
+
* Startup Changes in Emacs 27.1
@@ -297,6 +308,10 @@ and directory-local variables.
'with-connection-local-profiles'. No argument 'profiles' needed any
longer.
+---
+** next-error-verbose controls when `next-error' outputs a message
+ about the error locus.
+
* Editing Changes in Emacs 27.1
@@ -379,6 +394,14 @@ current and the previous or the next line, as before.
* Changes in Specialized Modes and Packages in Emacs 27.1
+** compile.el
+---
+*** In compilation-error-regexp-alist, 'line' (and 'end-line') can be functions
+
+** cl-lib
++++
+*** cl-defstruct has a new :noinline argument to prevent inlining its functions
+
** doc-view-mode
*** New commands doc-view-presentation and doc-view-fit-window-to-page
*** Added support for password-protected PDF files
@@ -505,6 +528,10 @@ and compares their entire trees.
*** New user option 'vc-hg-revert-switches' specifies switches to pass
to hg revert.
+*** 'C-x v M D' ('vc-diff-mergebase') and 'C-x v M L' ('vc-log-mergebase')
+print diffs and logs between the merge base (common ancestor) of two
+given revisions.
+
** Diff mode
+++
*** Hunks are now automatically refined by font-lock.
@@ -671,6 +698,10 @@ mouse click event, and is intended to be bound to a mouse
event.
Previously, setting 'xref-marker-ring-length' would only take effect
if set before 'xref.el' was loaded.
+---
+*** xref-find-definitions now sets the mark at the buffer position
+where it was invoked
+
** Ecomplete
*** The ecomplete sorting has changed to a decay-based algorithm.
@@ -816,6 +847,9 @@ directories in the destination.
** Help
---
+*** Description of variables and functions give an estimated first release
+
+---
*** Output format of 'C-h l' ('view-lossage') has changed.
For convenience, 'view-lossage' now displays the last keystrokes
and commands in the same format as the edit buffer of
@@ -1030,6 +1064,12 @@ followed when Emacs writes the relevant history
variables to the disk.
*** The variable 'shell-file-name' can be set now as connection-local
variable for remote shells. It still defaults to "/bin/sh".
+** Single shell commands
+
+---
+*** 'shell-command-width' defines the number of display columns
+available for output of asynchronous shell commands.
+
** Pcomplete
*** The function 'pcomplete-uniquify-list' has been renamed from
@@ -1208,10 +1248,16 @@ the 128...255 range, as expected.
This allows to create and parent immediately a minibuffer-only child
frame when making a frame.
+---
+*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'.
+These predicates are to be preferred over 'display-graphic-p' when
+testing for blinking cursor capability and the capability to have
+symbols (e.g., [return], [tab], [backspace]) as keys respectively.
+
** Tabulated List mode
+++
-** New user options for tabulated list sort indicators.
+*** New user options for tabulated list sort indicators.
You can now customize which sorting indicator character to display
near the current column in Tabulated Lists (see variables
'tabulated-list-gui-sort-indicator-asc',
@@ -1219,6 +1265,94 @@ near the current column in Tabulated Lists (see variables
'tabulated-list-tty-sort-indicator-asc', and
'tabulated-list-tty-sort-indicator-desc').
+** Text mode
+
++++
+*** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead.
+
+** CUA mode
+
+---
+*** New defcustom 'cua-rectangle-terminal-modifier-key'.
+This defcustom allows for the customization of the modifier key used
+in a terminal frame.
+
+** JS mode
+
+---
+*** JSX syntax is now automatically detected and enabled.
+If a file imports Facebook's 'React' library, or if the file uses the
+extension '.jsx', then various features supporting XML-like syntax
+will be supported in 'js-mode' and derivative modes. ('js-jsx-mode'
+no longer needs to be enabled.)
+
+---
+*** New defcustom 'js-jsx-detect-syntax' disables automatic detection.
+This is turned on by default.
+
+---
+*** New defcustom 'js-jsx-syntax' enables JSX syntax unconditionally.
+This is off by default.
+
+---
+*** New variable 'js-jsx-regexps' controls JSX detection.
+
+---
+*** JSX syntax is now highlighted like SGML.
+
+---
+*** JSX code is properly indented in many more scenarios.
+Previously, JSX indentation usually only worked when an element was
+wrapped in parenthesis (e.g. in a 'return' statement or a function
+call). It would also fail in many intricate cases. Now, indentation
+should work anywhere without parenthesis; many more intricacies are
+supported; and, indentation conventions align more closely with those
+of the React developer community (see 'js-jsx-align->-with-<'),
+otherwise still adhering to SGML conventions.
+
+---
+*** New defcustom 'js-jsx-align->-with-<' controls '>' indents.
+Commonly in JSX code, a '>' on its own line is indented at the same
+level as its opening '<'. This is the new default for JSX. This
+behavior is slightly different than that used by SGML in Emacs, where
+'>' is indented at the same level as attributes, which was also the
+old default for JSX.
+
+This is turned on by default. To get back the old default indentation
+behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<'
+to nil.
+
+---
+*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'.
+Since JSX is a syntax extension of JavaScript, it makes the most sense
+for JSX expressions to be indented the same number of spaces as other
+JS expressions. This is a breaking change, but it probably aligns
+with how you'd expect this indentation to behave. If you want JSX to
+be indented like JS, you won't need to change your config.
+
+The old behavior can be emulated by controlling JSX indentation
+independently of JS, by setting 'js-jsx-indent-level'.
+
+---
+*** New defcustom 'js-jsx-indent-level' for different JSX indentation.
+If you wish to indent JSX by a different number of spaces than JS, set
+this variable to the desired number.
+
+---
+*** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents.
+
+---
+*** New variable 'js-syntactic-mode-name' controls mode name display.
+Previously, the mode name was simply 'JavaScript'. Now, when a syntax
+extension like JSX is enabled, the mode name is 'JavaScript[JSX]'.
+Set this variable to nil to disable the new behavior.
+
+---
+*** New function 'js-use-syntactic-mode-name' for deriving modes.
+Packages deriving from 'js-mode' with 'define-derived-mode' should
+call this function to add enabled syntax extensions to their mode
+name, too.
+
* New Modes and Packages in Emacs 27.1
@@ -1249,6 +1383,9 @@ documentation of the new mode and its commands.
* Incompatible Lisp Changes in Emacs 27.1
+** In compilation-error-regexp-alist the old undocumented feature where 'line'
+could be a function of 2 arguments has been dropped.
+
** 'define-fringe-bitmap' is always defined, even when Emacs is built
without any GUI support.
@@ -1357,9 +1494,26 @@ ending character were silently omitted.
For example, '(rx (any "@z-a" (?9 . ?0)))' would match '@' only.
Now, such rx expressions generate an error.
++++
+** 'text-mode' no longer sets the value of 'indent-line-function'.
+The global value of 'indent-line-function', which defaults to
+'indent-relative', will no longer be reset locally when turning on
+'text-mode'.
+
+To get back the old behavior, add a function to 'text-mode-hook' which
+performs (setq-local indent-line-function #'indent-relative).
+
* Lisp Changes in Emacs 27.1
+** New 'help-fns-describe-variable-functions' hook.
+Makes it possible to add metadata information to describe-variable.
+
+** i18n (internationalization)
+
+*** ngettext can be used now to return the right plural form
+according to the given numeric value.
+
+++
** inhibit-null-byte-detection is renamed to inhibit-nul-byte-detection
@@ -1635,6 +1789,12 @@ are implemented in C using the Jansson library.
and 'flatten' it such that the result is a list of all the terminal
nodes.
++++
+** 'zlib-decompress-region' can partially decompress corrupted data.
+If the new optional ALLOW-PARTIAL argument is passed, then the data
+that was decompressed successfully before failing will be inserted
+into the buffer.
+
** Mailcap
---
@@ -1699,9 +1859,9 @@ the process. That way 'make-process' can start remote
processes.
+++
** Emacs now supports resizing (scaling) of images without ImageMagick.
All modern systems are supported by this feature. (On GNU and Unix
-systems, the XRender extension to X11 is required for this to be
-available; the configure script will test for it and, if found, enable
-scaling.)
+systems, Cairo drawing or the XRender extension to X11 is required for
+this to be available; the configure script will test for it and, if
+found, enable scaling.)
The new function 'image-scaling-p' can be used to test whether any
given frame supports resizing.
diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17
index 758ef65..1ce36fe 100644
--- a/etc/NEWS.1-17
+++ b/etc/NEWS.1-17
@@ -2339,9 +2339,9 @@ It's Beat CCA Week.
** Lisp macros now exist.
For example, you can write
- (defmacro cadr (arg) (list 'car (list 'cdr arg)))
+ (defmacro mycadr (arg) (list 'car (list 'cdr arg)))
and then the expression
- (cadr foo)
+ (mycadr foo)
will expand into
(car (cdr foo))
diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c
index d310366..35bb8b9 100644
--- a/lib-src/make-fingerprint.c
+++ b/lib-src/make-fingerprint.c
@@ -89,7 +89,7 @@ main (int argc, char **argv)
fclose (f);
}
- uint8_t digest[32];
+ unsigned char digest[32];
sha256_finish_ctx (&ctx, digest);
if (raw)
@@ -99,12 +99,12 @@ main (int argc, char **argv)
}
else
{
- printf ("#include \"fingerprint.h\"\n");
- printf ("\n");
- printf ("const uint8_t fingerprint[32] = { ");
+ puts ("#include \"fingerprint.h\"\n"
+ "unsigned char const fingerprint[] =\n"
+ "{");
for (int i = 0; i < 32; ++i)
- printf ("%s0x%02X", i ? ", " : "", digest[i]);
- printf (" };\n");
+ printf ("\t0x%02X,\n", digest[i]);
+ puts ("};");
}
return EXIT_SUCCESS;
diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h
index 94fdfaf..db9b455 100644
--- a/lib/_Noreturn.h
+++ b/lib/_Noreturn.h
@@ -1,8 +1,27 @@
+/* A C macro for declaring that a function does not return.
+ Copyright (C) 2011-2019 Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
+
#ifndef _Noreturn
-# if 201103 <= (defined __cplusplus ? __cplusplus : 0)
+# if (defined __cplusplus \
+ && ((201103 <= __cplusplus && !(__GNUC__ == 4 && __GNUC_MINOR__ == 7)) \
+ || (defined _MSC_VER && 1900 <= _MSC_VER)))
# define _Noreturn [[noreturn]]
-# elif (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__))
+# elif ((!defined __cplusplus || defined __clang__) \
+ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
+ || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)))
/* _Noreturn works as-is. */
# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index 360cdc4..e728bf4 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -72,10 +72,10 @@ gettimeofday (struct timeval *restrict tv, void *restrict
tz)
/* On native Windows, there are two ways to get the current time:
GetSystemTimeAsFileTime
- <https://msdn.microsoft.com/en-us/library/ms724397.aspx>
+
<https://docs.microsoft.com/en-us/windows/desktop/api/sysinfoapi/nf-sysinfoapi-getsystemtimeasfiletime>
or
GetSystemTimePreciseAsFileTime
- <https://msdn.microsoft.com/en-us/library/hh706895.aspx>.
+
<https://docs.microsoft.com/en-us/windows/desktop/api/sysinfoapi/nf-sysinfoapi-getsystemtimepreciseasfiletime>.
GetSystemTimeAsFileTime produces values that jump by increments of
15.627 milliseconds (!) on average.
Whereas GetSystemTimePreciseAsFileTime values usually jump by 1 or 2
@@ -92,7 +92,7 @@ gettimeofday (struct timeval *restrict tv, void *restrict tz)
GetSystemTimeAsFileTime (¤t_time);
/* Convert from FILETIME to 'struct timeval'. */
- /* FILETIME: <https://msdn.microsoft.com/en-us/library/ms724284.aspx> */
+ /* FILETIME:
<https://docs.microsoft.com/en-us/windows/desktop/api/minwinbase/ns-minwinbase-filetime>
*/
ULONGLONG since_1601 =
((ULONGLONG) current_time.dwHighDateTime << 32)
| (ULONGLONG) current_time.dwLowDateTime;
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 0d9a885..1450df9 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -179,6 +179,7 @@ CAIRO_LIBS = @CAIRO_LIBS@
CC = @CC@
CFLAGS = @CFLAGS@
CFLAGS_SOUND = @CFLAGS_SOUND@
+CHECK_STRUCTS = @CHECK_STRUCTS@
CLIENTRES = @CLIENTRES@
CLIENTW = @CLIENTW@
CM_OBJ = @CM_OBJ@
diff --git a/lib/mktime.c b/lib/mktime.c
index d411aa7..e3783d7 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -72,7 +72,7 @@ my_tzset (void)
/* Rectify the value of the environment variable TZ.
There are four possible kinds of such values:
- Traditional US time zone names, e.g. "PST8PDT". Syntax: see
- <https://msdn.microsoft.com/en-us/library/90s5c885.aspx>
+
<https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/tzset>
- Time zone names based on geography, that contain one or more
slashes, e.g. "Europe/Moscow".
- Time zone names based on geography, without slashes, e.g.
diff --git a/lib/regcomp.c b/lib/regcomp.c
index 10a0a49..892139a 100644
--- a/lib/regcomp.c
+++ b/lib/regcomp.c
@@ -1800,8 +1800,8 @@ peek_token (re_token_t *token, re_string_t *input,
reg_syntax_t syntax)
token->word_char = 0;
#ifdef RE_ENABLE_I18N
token->mb_partial = 0;
- if (input->mb_cur_max > 1 &&
- !re_string_first_byte (input, re_string_cur_idx (input)))
+ if (input->mb_cur_max > 1
+ && !re_string_first_byte (input, re_string_cur_idx (input)))
{
token->type = CHARACTER;
token->mb_partial = 1;
@@ -1988,8 +1988,8 @@ peek_token (re_token_t *token, re_string_t *input,
reg_syntax_t syntax)
token->type = OP_PERIOD;
break;
case '^':
- if (!(syntax & (RE_CONTEXT_INDEP_ANCHORS | RE_CARET_ANCHORS_HERE)) &&
- re_string_cur_idx (input) != 0)
+ if (!(syntax & (RE_CONTEXT_INDEP_ANCHORS | RE_CARET_ANCHORS_HERE))
+ && re_string_cur_idx (input) != 0)
{
char prev = re_string_peek_byte (input, -1);
if (!(syntax & RE_NEWLINE_ALT) || prev != '\n')
@@ -1999,8 +1999,8 @@ peek_token (re_token_t *token, re_string_t *input,
reg_syntax_t syntax)
token->opr.ctx_type = LINE_FIRST;
break;
case '$':
- if (!(syntax & RE_CONTEXT_INDEP_ANCHORS) &&
- re_string_cur_idx (input) + 1 != re_string_length (input))
+ if (!(syntax & RE_CONTEXT_INDEP_ANCHORS)
+ && re_string_cur_idx (input) + 1 != re_string_length (input))
{
re_token_t next;
re_string_skip_bytes (input, 1);
@@ -2034,8 +2034,8 @@ peek_token_bracket (re_token_t *token, re_string_t
*input, reg_syntax_t syntax)
token->opr.c = c;
#ifdef RE_ENABLE_I18N
- if (input->mb_cur_max > 1 &&
- !re_string_first_byte (input, re_string_cur_idx (input)))
+ if (input->mb_cur_max > 1
+ && !re_string_first_byte (input, re_string_cur_idx (input)))
{
token->type = CHARACTER;
return 1;
@@ -2333,8 +2333,8 @@ parse_expression (re_string_t *regexp, regex_t *preg,
re_token_t *token,
}
FALLTHROUGH;
case OP_CLOSE_SUBEXP:
- if ((token->type == OP_CLOSE_SUBEXP) &&
- !(syntax & RE_UNMATCHED_RIGHT_PAREN_ORD))
+ if ((token->type == OP_CLOSE_SUBEXP)
+ && !(syntax & RE_UNMATCHED_RIGHT_PAREN_ORD))
{
*err = REG_ERPAREN;
return NULL;
diff --git a/lib/regexec.c b/lib/regexec.c
index 7fcd1a5..f464869 100644
--- a/lib/regexec.c
+++ b/lib/regexec.c
@@ -2204,9 +2204,9 @@ sift_states_iter_mb (const re_match_context_t *mctx,
re_sift_context_t *sctx,
int naccepted;
/* Check the node can accept "multi byte". */
naccepted = check_node_accept_bytes (dfa, node_idx, &mctx->input, str_idx);
- if (naccepted > 0 && str_idx + naccepted <= max_str_idx &&
- !STATE_NODE_CONTAINS (sctx->sifted_states[str_idx + naccepted],
- dfa->nexts[node_idx]))
+ if (naccepted > 0 && str_idx + naccepted <= max_str_idx
+ && !STATE_NODE_CONTAINS (sctx->sifted_states[str_idx + naccepted],
+ dfa->nexts[node_idx]))
/* The node can't accept the "multi byte", or the
destination was already thrown away, then the node
couldn't accept the current input "multi byte". */
@@ -3782,10 +3782,10 @@ check_node_accept_bytes (const re_dfa_t *dfa, Idx
node_idx,
/* FIXME: I don't think this if is needed, as both '\n'
and '\0' are char_len == 1. */
/* '.' accepts any one character except the following two cases. */
- if ((!(dfa->syntax & RE_DOT_NEWLINE) &&
- re_string_byte_at (input, str_idx) == '\n') ||
- ((dfa->syntax & RE_DOT_NOT_NULL) &&
- re_string_byte_at (input, str_idx) == '\0'))
+ if ((!(dfa->syntax & RE_DOT_NEWLINE)
+ && re_string_byte_at (input, str_idx) == '\n')
+ || ((dfa->syntax & RE_DOT_NOT_NULL)
+ && re_string_byte_at (input, str_idx) == '\0'))
return 0;
return char_len;
}
diff --git a/lib/stat-time.h b/lib/stat-time.h
index d4f1f96..38a1f55 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -171,7 +171,7 @@ get_stat_birthtime (struct stat const *st _GL_UNUSED)
#elif defined _WIN32 && ! defined __CYGWIN__
/* Native Windows platforms (but not Cygwin) put the "file creation
time" in st_ctime (!). See
- <https://msdn.microsoft.com/en-us/library/14h5k7ff(VS.80).aspx>. */
+
<https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/stat-functions>.
*/
# if _GL_WINDOWS_STAT_TIMESPEC
t = st->st_ctim;
# else
diff --git a/lib/utimens.c b/lib/utimens.c
index 34689bc..c9b65ef 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -288,8 +288,8 @@ fdutimens (int fd, char const *file, struct timespec const
timespec[2])
#ifdef USE_SETFILETIME
/* On native Windows, use SetFileTime(). See
- <https://msdn.microsoft.com/en-us/library/ms724933.aspx>
- <https://msdn.microsoft.com/en-us/library/ms724284.aspx> */
+
<https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-setfiletime>
+
<https://docs.microsoft.com/en-us/windows/desktop/api/minwinbase/ns-minwinbase-filetime>
*/
if (0 <= fd)
{
HANDLE handle;
@@ -307,10 +307,10 @@ fdutimens (int fd, char const *file, struct timespec
const timespec[2])
if (ts == NULL || ts[0].tv_nsec == UTIME_NOW || ts[1].tv_nsec ==
UTIME_NOW)
{
/* GetSystemTimeAsFileTime
- <https://msdn.microsoft.com/en-us/library/ms724397.aspx>.
+
<https://docs.microsoft.com/en-us/windows/desktop/api/sysinfoapi/nf-sysinfoapi-getsystemtimeasfiletime>.
It would be overkill to use
GetSystemTimePreciseAsFileTime
- <https://msdn.microsoft.com/en-us/library/hh706895.aspx>. */
+
<https://docs.microsoft.com/en-us/windows/desktop/api/sysinfoapi/nf-sysinfoapi-getsystemtimepreciseasfiletime>.
*/
GetSystemTimeAsFileTime (¤t_time);
}
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 855d80c..3c88ec6 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -940,8 +940,7 @@ If READABLE is nil, an expression is inserted. The
expression is
a call to `define-abbrev-table' that when evaluated will define
the abbrev table NAME exactly as it is currently defined.
Abbrevs marked as \"system abbrevs\" are ignored."
- (let ((table (symbol-value name))
- (symbols (abbrev--table-symbols name readable)))
+ (let ((symbols (abbrev--table-symbols name readable)))
(setq symbols (sort symbols 'string-lessp))
(let ((standard-output (current-buffer)))
(if readable
diff --git a/lisp/align.el b/lisp/align.el
index a81498b..443237b 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -411,7 +411,7 @@ The possible settings for `align-region-separate' are:
(c-variable-declaration
(regexp . ,(concat "[*&0-9A-Za-z_]>?[&*]*\\(\\s-+[*&]*\\)"
"[A-Za-z_][0-9A-Za-z:_]*\\s-*\\(\\()\\|"
- "=[^=\n].*\\|(.*)\\|\\(\\[.*\\]\\)*\\)?"
+ "=[^=\n].*\\|(.*)\\|\\(\\[.*\\]\\)*\\)"
"\\s-*[;,]\\|)\\s-*$\\)"))
(group . 1)
(modes . align-c++-modes)
@@ -438,7 +438,7 @@ The possible settings for `align-region-separate' are:
(tab-stop . nil))
(perl-assignment
- (regexp . ,(concat "[^=!^&*-+<>/| \t\n]\\(\\s-*\\)=[~>]?"
+ (regexp . ,(concat "[^=!^&*+<>/| \t\n-]\\(\\s-*\\)=[~>]?"
"\\(\\s-*\\)\\([^>= \t\n]\\|$\\)"))
(group . (1 2))
(modes . align-perl-modes)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index bc7c616..4fb865e 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -343,10 +343,11 @@ This has been reported by a file notification event.")
;; Functions:
-(defun auto-revert-remove-current-buffer ()
- "Remove dead buffer from `auto-revert-buffer-list'."
+(defun auto-revert-remove-current-buffer (&optional buffer)
+ "Remove BUFFER from `auto-revert-buffer-list'.
+BUFFER defaults to `current-buffer'."
(setq auto-revert-buffer-list
- (delq (current-buffer) auto-revert-buffer-list)))
+ (delq (or buffer (current-buffer)) auto-revert-buffer-list)))
;;;###autoload
(define-minor-mode auto-revert-mode
@@ -464,7 +465,7 @@ If `global-auto-revert-non-file-buffers' is non-nil, this
mode
may also revert some non-file buffers, as described in the
documentation of that variable. It ignores buffers with modes
matching `global-auto-revert-ignore-modes', and buffers with a
-non-nil vale of `global-auto-revert-ignore-buffer'.
+non-nil value of `global-auto-revert-ignore-buffer'.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
@@ -509,7 +510,7 @@ will use an up-to-date value of `auto-revert-interval'"
(ignore-errors
(file-notify-rm-watch auto-revert-notify-watch-descriptor)))))
auto-revert-notify-watch-descriptor-hash-list)
- (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch))
+ (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))
(setq auto-revert-notify-watch-descriptor nil
auto-revert-notify-modified-p nil))
@@ -772,10 +773,12 @@ the timer when no buffers need to be checked."
(setq bufs (delq nil
(mapcar
(lambda (buf)
- (with-current-buffer buf
- (and (or (not (file-remote-p default-directory))
- (file-remote-p default-directory nil t))
- buf)))
+ (and (buffer-live-p buf)
+ (with-current-buffer buf
+ (and
+ (or (not (file-remote-p default-directory))
+ (file-remote-p default-directory nil t))
+ buf))))
bufs)))
;; Partition `bufs' into two halves depending on whether or not
;; the buffers are in `auto-revert-remaining-buffers'. The two
@@ -792,24 +795,23 @@ the timer when no buffers need to be checked."
(not (and auto-revert-stop-on-user-input
(input-pending-p))))
(let ((buf (car bufs)))
- (with-current-buffer buf
- (if (buffer-live-p buf)
- (progn
- ;; Test if someone has turned off Auto-Revert Mode
- ;; in a non-standard way, for example by changing
- ;; major mode.
- (if (and (not auto-revert-mode)
- (not auto-revert-tail-mode)
- (memq buf auto-revert-buffer-list))
- (auto-revert-remove-current-buffer))
- (when (auto-revert-active-p)
- ;; Enable file notification.
- (when (and auto-revert-use-notify
- (not auto-revert-notify-watch-descriptor))
- (auto-revert-notify-add-watch))
- (auto-revert-handler)))
+ (if (not (buffer-live-p buf))
;; Remove dead buffer from `auto-revert-buffer-list'.
- (auto-revert-remove-current-buffer))))
+ (auto-revert-remove-current-buffer buf)
+ (with-current-buffer buf
+ ;; Test if someone has turned off Auto-Revert Mode
+ ;; in a non-standard way, for example by changing
+ ;; major mode.
+ (if (and (not auto-revert-mode)
+ (not auto-revert-tail-mode)
+ (memq buf auto-revert-buffer-list))
+ (auto-revert-remove-current-buffer))
+ (when (auto-revert-active-p)
+ ;; Enable file notification.
+ (when (and auto-revert-use-notify
+ (not auto-revert-notify-watch-descriptor))
+ (auto-revert-notify-add-watch))
+ (auto-revert-handler)))))
(setq bufs (cdr bufs)))
(setq auto-revert-remaining-buffers bufs)
;; Check if we should cancel the timer.
diff --git a/lisp/button.el b/lisp/button.el
index c46f3d9..921e84d 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -382,10 +382,12 @@ Also see `make-text-button'."
If the button at POS is a text property button, the return value
is a marker pointing to POS."
(let ((button (get-char-property pos 'button)))
- (if (or (overlayp button) (null button))
- button
- ;; Must be a text-property button; return a marker pointing to it.
- (copy-marker pos t))))
+ (and button (get-char-property pos 'category)
+ (if (overlayp button)
+ button
+ ;; Must be a text-property button;
+ ;; return a marker pointing to it.
+ (copy-marker pos t)))))
(defun next-button (pos &optional count-current)
"Return the next button after position POS in the current buffer.
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index cab48a7..fce82d2 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -60,7 +60,7 @@
(defun calc-hms-notation (fmt)
- (interactive "sHours-minutes-seconds format (hms, @ \\=' \", etc.): ")
+ (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ")
(calc-wrapper
(if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,;
]*\\)\\([^,; ]\\)\\'" fmt)
(progn
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 2ad7ffc..6bf2d51 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -64,7 +64,7 @@
(defvar srecode-font-lock-keywords
'(
;; Template
- ("^\\(template\\)\\s-+\\(\\w*\\)\\(\\( \\(:\\w+\\)\\|\\)+\\)$"
+ ("^\\(template\\)\\s-+\\(\\w*\\)\\(\\( \\(:\\w+\\)\\)*\\)$"
(1 font-lock-keyword-face)
(2 font-lock-function-name-face)
(3 font-lock-builtin-face ))
diff --git a/lisp/desktop.el b/lisp/desktop.el
index acabde5..97c057e 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -856,6 +856,19 @@ QUOTE may be `may' (value may be quoted),
`',(cdr el) (cdr el)))
pass1)))
(cons 'may `[,@(mapcar #'cdr pass1)]))))
+ ((and (recordp value) (symbolp (aref value 0)))
+ (let* ((pass1 (let ((res ()))
+ (dotimes (i (length value))
+ (push (desktop--v2s (aref value i)) res))
+ (nreverse res)))
+ (special (assq nil pass1)))
+ (if special
+ (cons nil `(record
+ ,@(mapcar (lambda (el)
+ (if (eq (car el) 'must)
+ `',(cdr el) (cdr el)))
+ pass1)))
+ (cons 'may (apply #'record (mapcar #'cdr pass1))))))
((consp value)
(let ((p value)
newlist
diff --git a/lisp/dired.el b/lisp/dired.el
index fc0b712..63082fe 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -774,6 +774,15 @@ as an argument to `dired-goto-file'."
(file-name-as-directory (abbreviate-file-name filename))
(abbreviate-file-name filename)))))
+(defun dired-grep-read-files ()
+ "Use file at point as the file for grep's default file-name pattern
suggestion.
+If a directory or nothing is found at point, return nil."
+ (let ((file-name (dired-file-name-at-point)))
+ (if (and file-name
+ (not (file-directory-p file-name)))
+ file-name)))
+(put 'dired-mode 'grep-read-files 'dired-grep-read-files)
+
;;;###autoload (define-key ctl-x-map "d" 'dired)
;;;###autoload
(defun dired (dirname &optional switches)
@@ -1269,8 +1278,8 @@ If HDR is non-nil, insert a header line with the
directory name."
;; as indicated by `ls-lisp-use-insert-directory-program'.
(not (and (featurep 'ls-lisp)
(null ls-lisp-use-insert-directory-program)))
- (not (and (featurep 'eshell)
- (bound-and-true-p eshell-ls-use-in-dired)))
+ ;; FIXME: Big ugly hack for Eshell's eshell-ls-use-in-dired.
+ (not (bound-and-true-p eshell-ls-use-in-dired))
(or (file-remote-p dir)
(if (eq dired-use-ls-dired 'unspecified)
;; Check whether "ls --dired" gives exit code 0, and
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 476c0cb..4a59750 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -175,8 +175,8 @@ in the default way after this call."
(defun standard-display-g1 (c sc)
"Display character C as character SC in the g1 character set.
This function assumes that your terminal uses the SO/SI characters;
-it is meaningless for an X frame."
- (if (memq window-system '(x w32 ns))
+it is meaningless for a graphical frame."
+ (if (display-graphic-p)
(error "Cannot use string glyphs in a windowing system"))
(or standard-display-table
(setq standard-display-table (make-display-table)))
@@ -186,9 +186,9 @@ it is meaningless for an X frame."
;;;###autoload
(defun standard-display-graphic (c gc)
"Display character C as character GC in graphics character set.
-This function assumes VT100-compatible escapes; it is meaningless for an
-X frame."
- (if (memq window-system '(x w32 ns))
+This function assumes VT100-compatible escapes; it is meaningless
+for a graphical frame."
+ (if (display-graphic-p)
(error "Cannot use string glyphs in a windowing system"))
(or standard-display-table
(setq standard-display-table (make-display-table)))
@@ -276,7 +276,7 @@ in `.emacs'."
(progn
(standard-display-default
(unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255))
- (unless (or (memq window-system '(x w32 ns)))
+ (unless (display-graphic-p)
(and (terminal-coding-system)
(set-terminal-coding-system nil))))
@@ -289,7 +289,7 @@ in `.emacs'."
;; unless some other has been specified.
(if (equal current-language-environment "English")
(set-language-environment "latin-1"))
- (unless (or noninteractive (memq window-system '(x w32 ns)))
+ (unless (or noninteractive (display-graphic-p))
;; Send those codes literally to a character-based terminal.
;; If we are using single-byte characters,
;; it doesn't matter which coding system we use.
diff --git a/lisp/electric.el b/lisp/electric.el
index 657913a..07da2f1 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -223,9 +223,9 @@ Python does not lend itself to fully automatic
indentation.")
(defvar electric-indent-functions-without-reindent
'(indent-relative indent-to-left-margin indent-relative-maybe
- py-indent-line coffee-indent-line org-indent-line yaml-indent-line
- haskell-indentation-indent-line haskell-indent-cycle haskell-simple-indent
- yaml-indent-line)
+ indent-relative-first-indent-point py-indent-line coffee-indent-line
+ org-indent-line yaml-indent-line haskell-indentation-indent-line
+ haskell-indent-cycle haskell-simple-indent yaml-indent-line)
"List of indent functions that can't reindent.
If `indent-line-function' is one of those, then `electric-indent-mode' will
not try to reindent lines. It is normally better to make the major
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 82d0819..c1678c0 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -52,7 +52,7 @@
(defcustom elide-head-headers-to-hide
'(("is free software[:;] you can redistribute it" . ; GNU boilerplate
"\\(Boston, MA 0211\\(1-1307\\|0-1301\\), USA\\|\
-If not, see <http://www\\.gnu\\.org/licenses/>\\)\\.")
+If not, see <https?://www\\.gnu\\.org/licenses/>\\)\\.")
("The Regents of the University of California\\. All rights reserved\\." .
"SUCH DAMAGE\\.") ; BSD
("Permission is hereby granted, free of charge" . ; X11
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 4418c9a..44cca61 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -436,11 +436,6 @@
(cons (byte-optimize-form (nth 1 form) for-effect)
(byte-optimize-body (cdr (cdr form)) t)))
(byte-optimize-form (nth 1 form) for-effect)))
- ((eq fn 'prog2)
- (cons 'prog2
- (cons (byte-optimize-form (nth 1 form) t)
- (cons (byte-optimize-form (nth 2 form) for-effect)
- (byte-optimize-body (cdr (cdr (cdr form))) t)))))
((memq fn '(save-excursion save-restriction save-current-buffer))
;; those subrs which have an implicit progn; it's not quite good
@@ -884,7 +879,8 @@
(put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
(put 'stringp 'byte-optimizer 'byte-optimize-predicate)
(put 'string< 'byte-optimizer 'byte-optimize-predicate)
-(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
+(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
+(put 'proper-list-p 'byte-optimizer 'byte-optimize-predicate)
(put 'logand 'byte-optimizer 'byte-optimize-predicate)
(put 'logior 'byte-optimizer 'byte-optimize-predicate)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 66b40a8..8bbe629 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2501,9 +2501,8 @@ list that represents a doc string reference.
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
(defun byte-compile-file-form-progn (form)
- (mapc 'byte-compile-file-form (cdr form))
+ (mapc #'byte-compile-file-form (cdr form))
;; Return nil so the forms are not output twice.
nil)
@@ -3910,7 +3909,6 @@ discarding."
(byte-defop-compiler-1 setq)
-(byte-defop-compiler-1 setq-default)
(byte-defop-compiler-1 quote)
(defun byte-compile-setq (form)
@@ -3935,34 +3933,20 @@ discarding."
(byte-compile-form nil byte-compile--for-effect)))
(setq byte-compile--for-effect nil)))
-(defun byte-compile-setq-default (form)
- (setq form (cdr form))
- (if (null form) ; (setq-default), with no arguments
- (byte-compile-form nil byte-compile--for-effect)
- (if (> (length form) 2)
- (let ((setters ()))
- (while (consp form)
- (push `(setq-default ,(pop form) ,(pop form)) setters))
- (byte-compile-form (cons 'progn (nreverse setters))))
- (let ((var (car form)))
- (and (or (not (symbolp var))
- (macroexp--const-symbol-p var t))
- (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn
- "variable assignment to %s `%s'"
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var)))
- (byte-compile-normal-call `(set-default ',var ,@(cdr form)))))))
-
(byte-defop-compiler-1 set-default)
(defun byte-compile-set-default (form)
(let ((varexp (car-safe (cdr-safe form))))
(if (eq (car-safe varexp) 'quote)
- ;; If the varexp is constant, compile it as a setq-default
- ;; so we get more warnings.
- (byte-compile-setq-default `(setq-default ,(car-safe (cdr varexp))
- ,@(cddr form)))
- (byte-compile-normal-call form))))
+ ;; If the varexp is constant, check the var's name.
+ (let ((var (car-safe (cdr varexp))))
+ (and (or (not (symbolp var))
+ (macroexp--const-symbol-p var t))
+ (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn
+ "variable assignment to %s `%s'"
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var)))))
+ (byte-compile-normal-call form)))
(defun byte-compile-quote (form)
(byte-compile-constant (car (cdr form))))
@@ -3986,7 +3970,6 @@ discarding."
(byte-defop-compiler-1 inline byte-compile-progn)
(byte-defop-compiler-1 progn)
(byte-defop-compiler-1 prog1)
-(byte-defop-compiler-1 prog2)
(byte-defop-compiler-1 if)
(byte-defop-compiler-1 cond)
(byte-defop-compiler-1 and)
@@ -4003,11 +3986,6 @@ discarding."
(byte-compile-form-do-effect (car (cdr form)))
(byte-compile-body (cdr (cdr form)) t))
-(defun byte-compile-prog2 (form)
- (byte-compile-form (nth 1 form) t)
- (byte-compile-form-do-effect (nth 2 form))
- (byte-compile-body (cdr (cdr (cdr form))) t))
-
(defmacro byte-compile-goto-if (cond discard tag)
`(byte-compile-goto
(if ,cond
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e658270..58ca9d5 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -556,7 +556,7 @@ places where they originally did not directly appear."
(`(,func . ,forms)
;; First element is function or whatever function-like forms are: or, and,
- ;; if, catch, progn, prog1, prog2, while, until
+ ;; if, catch, progn, prog1, while, until
`(,func . ,(mapcar (lambda (form)
(cconv-convert form env extend))
forms)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 5faa055..16e9bd6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2687,6 +2687,9 @@ The function's arguments should be treated as immutable.
;; for bootstrapping reasons.
(defvar cl--struct-default-parent nil)
+(defvar cl--struct-inline t
+ "If non-nil, `cl-defstruct' will define inlinable functions.")
+
;;;###autoload
(defmacro cl-defstruct (struct &rest descs)
"Define a struct type.
@@ -2698,7 +2701,7 @@ You can use the accessors to set the corresponding slots,
via `setf'.
NAME may instead take the form (NAME OPTIONS...), where each
OPTION is either a single keyword or (KEYWORD VALUE) where
KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
-:type, :named, :initial-offset, :print-function, or :include.
+:type, :named, :initial-offset, :print-function, :noinline, or :include.
Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
@@ -2757,6 +2760,8 @@ non-nil value, that slot cannot be set via `setf'.
(include-name nil)
(type nil) ;nil here means not specified explicitly.
(named nil)
+ (cldefsym (if cl--struct-inline 'cl-defsubst 'cl-defun))
+ (defsym (if cl--struct-inline 'cl-defsubst 'defun))
(forms nil)
(docstring (if (stringp (car descs)) (pop descs)))
pred-form pred-check)
@@ -2803,6 +2808,8 @@ non-nil value, that slot cannot be set via `setf'.
(error "Invalid :type specifier: %s" type)))
((eq opt :named)
(setq named t))
+ ((eq opt :noinline)
+ (setq defsym 'defun) (setq cldefsym 'cl-defun))
((eq opt :initial-offset)
(setq descs (nconc (make-list (car args) '(cl-skip-slot))
descs)))
@@ -2861,7 +2868,7 @@ non-nil value, that slot cannot be set via `setf'.
(cons 'and (cl-cdddr pred-form))
`(,predicate cl-x))))
(when pred-form
- (push `(cl-defsubst ,predicate (cl-x)
+ (push `(,defsym ,predicate (cl-x)
(declare (side-effect-free error-free))
,(if (eq (car pred-form) 'and)
(append pred-form '(t))
@@ -2884,7 +2891,7 @@ non-nil value, that slot cannot be set via `setf'.
(push (pop desc) defaults)
;; The arg "cl-x" is referenced by name in eg pred-form
;; and pred-check, so changing it is not straightforward.
- (push `(cl-defsubst ,accessor (cl-x)
+ (push `(,defsym ,accessor (cl-x)
,(format "Access slot \"%s\" of `%s' struct CL-X."
slot struct)
(declare (side-effect-free t))
@@ -2955,7 +2962,7 @@ non-nil value, that slot cannot be set via `setf'.
(let* ((anames (cl--arglist-args args))
(make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
slots defaults)))
- (push `(cl-defsubst ,cname
+ (push `(,cldefsym ,cname
(&cl-defs (nil ,@descs) ,@args)
,(if (stringp doc) doc
(format "Constructor for objects of type `%s'." name))
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 2726bbc..be33583 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -52,7 +52,7 @@ This is useful for ChangeLogs."
(defcustom copyright-regexp
"\\(©\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
\\|[Cc]opyright\\s *:?\\s *©\\)\
-\\s *\\(?:[^0-9\n]*\\s *\\)?\
+\\s *[^0-9\n]*\\s *\
\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"What your copyright notice looks like.
The second \\( \\) construct must match the years."
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 8ac0a1d..be531aa 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -411,12 +411,6 @@ on if the hook has explicitly disabled it."
(:global (setq keys (cdr keys)))
(_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
- (unless group
- ;; We might as well provide a best-guess default group.
- (setq group
- `(:group ',(intern (replace-regexp-in-string
- "-mode\\'" "" (symbol-name mode))))))
-
`(progn
(progn
:autoload-end
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 8b4cb1a..6dfcc24 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -2165,7 +2165,6 @@ into `edebug--cl-macrolet-defs' which is checked in
`edebug-list-form-args'."
(def-edebug-spec let* let)
(def-edebug-spec setq (&rest symbolp form))
-(def-edebug-spec setq-default setq)
(def-edebug-spec cond (&rest (&rest form)))
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 3fd66bf..caf5fed 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -374,13 +374,6 @@ don't yield.")
`(setf ,cps--value-symbol ,temp-var-symbol
,cps--state-symbol ,next-state))))))))
- ;; Process `prog2'.
-
- (`(prog2 ,form1 ,form2 . ,body)
- (cps--transform-1
- `(progn ,form1 (prog1 ,form2 ,@body))
- next-state))
-
;; Process `unwind-protect': If we're inside an unwind-protect, we
;; have a block of code UNWINDFORMS which we would like to run
;; whenever control flows away from the main piece of code,
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 30a43d8..4c7a8be 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1183,7 +1183,6 @@ Lisp function does not specify a special indentation."
(put 'autoload 'lisp-indent-function 'defun) ;Elisp
(put 'progn 'lisp-indent-function 0)
(put 'prog1 'lisp-indent-function 1)
-(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0) ;Elisp
(put 'save-restriction 'lisp-indent-function 0) ;Elisp
(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 9a86736..54e802e 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -399,7 +399,7 @@ If you want to insert an element without modifying MAP, use
`map-insert'."
;; and let `map-insert' grow the array?
:array (aset map key value)))
-(define-error 'map-inplace "Can only modify map in place: %S")
+(define-error 'map-inplace "Can only modify map in place")
(cl-defgeneric map-insert (map key value)
"Return a new map like MAP except that it associates KEY with VALUE.
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index bb647b0..2278e38 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -36,6 +36,11 @@
;;; Code:
+;; The autoloads.el mechanism which adds package--builtin-versions
+;; maintenance to loaddefs.el doesn't work for preloaded packages (such
+;; as this one), so we have to do it by hand!
+(push (purecopy '(nadvice 1 0)) package--builtin-versions)
+
;;;; Lightweight advice/hook
(defvar advice--where-alist
'((:around "\300\301\302\003#\207" 5)
@@ -241,6 +246,8 @@ different, but `function-equal' will hopefully ignore those
differences.")
(if (local-variable-p var) (symbol-value var)
(setq advice--buffer-local-function-sample
;; This function acts like the t special value in buffer-local hooks.
+ ;; FIXME: Provide an `advice-bottom' function that's like
+ ;; `advice-cd*r' but also follows through this proxy.
(lambda (&rest args) (apply (default-value var) args)))))
(eval-and-compile
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 9de2401..a644453 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -785,7 +785,7 @@ Otherwise, it defers to REST which is a list of branches of
the form
((eq 'or (caar matches))
(let* ((alts (cdar matches))
(var (if (eq (caar alts) 'match) (cadr (car alts))))
- (simples '()) (others '()) (memq-ok t))
+ (simples '()) (others '()) (memql-ok t))
(when var
(dolist (alt alts)
(if (and (eq (car alt) 'match) (eq var (cadr alt))
@@ -793,16 +793,16 @@ Otherwise, it defers to REST which is a list of branches
of the form
(eq (car-safe upat) 'quote)))
(let ((val (cadr (cddr alt))))
(unless (or (integerp val) (symbolp val))
- (setq memq-ok nil))
+ (setq memql-ok nil))
(push (cadr (cddr alt)) simples))
(push alt others))))
(cond
((null alts) (error "Please avoid it") (pcase--u rest))
- ;; Yes, we can use `memq' (or `member')!
+ ;; Yes, we can use `memql' (or `member')!
((> (length simples) 1)
(pcase--u1 (cons `(match ,var
. (pred (pcase--flip
- ,(if memq-ok #'memq #'member)
+ ,(if memql-ok #'memql #'member)
',simples)))
(cdr matches))
code vars
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index fce6a47..d883752 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -86,9 +86,9 @@
;;;###autoload
(defun regexp-opt (strings &optional paren keep-order)
"Return a regexp to match a string in the list STRINGS.
-Each string should be unique in STRINGS and should not contain
-any regexps, quoted or not. Optional PAREN specifies how the
-returned regexp is surrounded by grouping constructs.
+Each member of STRINGS is treated as a fixed string, not as a regexp.
+Optional PAREN specifies how the returned regexp is surrounded by
+grouping constructs.
If STRINGS is the empty list, the return value is a regexp that
never matches anything.
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 302ef12..105e1ab 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -427,7 +427,7 @@ and after the region marked by the rectangle to search."
(defcustom cua-rectangle-modifier-key 'meta
"Modifier key used for rectangle commands bindings.
-On non-window systems, always use the meta modifier.
+On non-window systems, use `cua-rectangle-terminal-modifier-key'.
Must be set prior to enabling CUA."
:type '(choice (const :tag "Meta key" meta)
(const :tag "Alt key" alt)
@@ -435,6 +435,16 @@ Must be set prior to enabling CUA."
(const :tag "Super key" super))
:group 'cua)
+(defcustom cua-rectangle-terminal-modifier-key 'meta
+ "Modifier key used for rectangle commands bindings in terminals.
+Must be set prior to enabling CUA."
+ :type '(choice (const :tag "Meta key" meta)
+ (const :tag "Alt key" alt)
+ (const :tag "Hyper key" hyper)
+ (const :tag "Super key" super))
+ :group 'cua
+ :version "27.1")
+
(defcustom cua-enable-rectangle-auto-help t
"If non-nil, automatically show help for region, rectangle and global mark."
:type 'boolean
@@ -1237,10 +1247,9 @@ If ARG is the atom `-', scroll upward by nearly full
screen."
(defun cua--init-keymaps ()
;; Cache actual rectangle modifier key.
(setq cua--rectangle-modifier-key
- (if (and cua-rectangle-modifier-key
- (memq window-system '(x)))
- cua-rectangle-modifier-key
- 'meta))
+ (if (eq (framep (selected-frame)) t)
+ cua-rectangle-terminal-modifier-key
+ cua-rectangle-modifier-key))
;; C-return always toggles rectangle mark
(define-key cua-global-keymap cua-rectangle-mark-key 'cua-set-rectangle-mark)
(unless (eq cua--rectangle-modifier-key 'meta)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 2854cde..210830a 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1285,7 +1285,7 @@ add things to `%s' instead."
(pcase-let ((`(,nick ,login ,host)
(erc-parse-user (erc-response.sender parsed))))
;; strip the stupid combined JOIN facility (IRC 2.9)
- (if (string-match "^\\(.*\\)?\^g.*$" chnl)
+ (if (string-match "^\\(.*\\)\^g.*$" chnl)
(setq chnl (match-string 1 chnl)))
(save-excursion
(let* ((str (cond
diff --git a/lisp/erc/erc-desktop-notifications.el
b/lisp/erc/erc-desktop-notifications.el
index 56b9392..41b7420 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -1,4 +1,4 @@
-;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions
+;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions
-*- lexical-binding:t -*-
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
@@ -59,13 +59,19 @@
This will replace the last notification sent with this function."
(dbus-ignore-errors
(setq erc-notifications-last-notification
- (notifications-notify :bus erc-notifications-bus
- :title (xml-escape-string nick)
- :body (xml-escape-string msg)
- :replaces-id
erc-notifications-last-notification
- :app-icon erc-notifications-icon))))
-
-(defun erc-notifications-PRIVMSG (proc parsed)
+ (let ((channel (current-buffer)))
+ (notifications-notify :bus erc-notifications-bus
+ :title (format "%s in %s"
+ (xml-escape-string nick)
+ channel)
+ :body (xml-escape-string msg)
+ :replaces-id
erc-notifications-last-notification
+ :app-icon erc-notifications-icon
+ :actions '("default" "Switch to buffer")
+ :on-action (lambda (&rest _)
+ (pop-to-buffer channel)))))))
+
+(defun erc-notifications-PRIVMSG (_proc parsed)
(let ((nick (car (erc-parse-user (erc-response.sender parsed))))
(target (car (erc-response.command-args parsed)))
(msg (erc-response.contents parsed)))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 117b678..884c594 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -548,7 +548,7 @@ channel that has weird people talking in morse to each
other.
See also `unmorse-region'."
(goto-char (point-min))
- (when (re-search-forward "[.-]+\\([.-]*/? *\\)+[.-]+/?" nil t)
+ (when (re-search-forward "[.-]+[./ -]*[.-]/?" nil t)
(save-restriction
(narrow-to-region (match-beginning 0) (match-end 0))
;; Turn " / " into " "
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index bcaa3e4..d1fa5c7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2522,10 +2522,7 @@ Returns NICK unmodified unless `erc-lurker-trim-nicks' is
non-nil."
(if erc-lurker-trim-nicks
(replace-regexp-in-string
- (format "[%s]"
- (mapconcat (lambda (char)
- (regexp-quote (char-to-string char)))
- erc-lurker-ignore-chars ""))
+ (regexp-opt-charset (string-to-list erc-lurker-ignore-chars))
"" nick)
nick))
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
index dbffd52..c465d46 100644
--- a/lisp/eshell/em-alias.el
+++ b/lisp/eshell/em-alias.el
@@ -90,7 +90,7 @@
;;; Code:
-(require 'eshell)
+(require 'esh-mode)
;;;###autoload
(progn
@@ -141,12 +141,12 @@ file named by `eshell-aliases-file'.")
(defvar eshell-failed-commands-alist nil
"An alist of command name failures.")
-(defun eshell-alias-initialize ()
+(defun eshell-alias-initialize () ;Called from `eshell-mode' via
intern-soft!
"Initialize the alias handling code."
(make-local-variable 'eshell-failed-commands-alist)
- (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t)
+ (add-hook 'eshell-alternate-command-hook #'eshell-fix-bad-commands t t)
(eshell-read-aliases-list)
- (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t)
+ (add-hook 'eshell-named-command-hook #'eshell-maybe-replace-by-alias t t)
(make-local-variable 'eshell-complex-commands)
(add-to-list 'eshell-complex-commands 'eshell-command-aliased-p))
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index 4a0b265..c284c1b 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -71,7 +71,7 @@ This can be any sexp, and should end with at least two
newlines."
:type 'hook
:group 'eshell-banner)
-(defun eshell-banner-initialize ()
+(defun eshell-banner-initialize () ;Called from `eshell-mode' via intern-soft!
"Output a welcome banner on initialization."
;; it's important to use `eshell-interactive-print' rather than
;; `insert', because `insert' doesn't know how to interact with the
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 25a6e88..e3bfd8d 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -244,7 +244,7 @@ to writing a completion function."
(let ((completion-at-point-functions '(lisp-completion-at-point)))
(completion-at-point)))
-(defun eshell-cmpl-initialize ()
+(defun eshell-cmpl-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the completions module."
(set (make-local-variable 'pcomplete-command-completion-function)
eshell-command-completion-function)
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index 937bc98..c28fd72 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -42,7 +42,8 @@
;;; Code:
-(require 'eshell)
+(require 'esh-mode) ;For eshell-directory-name
+(require 'esh-var) ;For eshell-variable-aliases-list
(require 'ring)
(require 'esh-opt)
@@ -169,7 +170,7 @@ Thus, this does not include the current directory.")
;;; Functions:
-(defun eshell-dirs-initialize ()
+(defun eshell-dirs-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the builtin functions for Eshell."
(make-local-variable 'eshell-variable-aliases-list)
(setq eshell-variable-aliases-list
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index f03243a..99c52ea 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -125,7 +125,7 @@ This option slows down recursive glob processing by quite a
bit."
;;; Functions:
-(defun eshell-glob-initialize ()
+(defun eshell-glob-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the extended globbing code."
;; it's important that `eshell-glob-chars-list' come first
(when (boundp 'eshell-special-chars-outside-quoting)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 05579ee..614faaa1 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -59,6 +59,7 @@
(require 'ring)
(require 'esh-opt)
+(require 'esh-mode)
(require 'em-pred)
(require 'eshell)
@@ -192,7 +193,6 @@ element, regardless of any text on the command line. In
that case,
(defvar eshell-isearch-map
(let ((map (copy-keymap isearch-mode-map)))
(define-key map [(control ?m)] 'eshell-isearch-return)
- (define-key map [return] 'eshell-isearch-return)
(define-key map [(control ?r)] 'eshell-isearch-repeat-backward)
(define-key map [(control ?s)] 'eshell-isearch-repeat-forward)
(define-key map [(control ?g)] 'eshell-isearch-abort)
@@ -216,11 +216,11 @@ Returns non-nil if INPUT is blank."
Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(not (string-match-p "\\`\\s-+" input)))
-(defun eshell-hist-initialize ()
+(defun eshell-hist-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the history management code for one Eshell buffer."
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
- 'eshell-complete-history-reference nil t))
+ #'eshell-complete-history-reference nil t))
(if (and (eshell-using-module 'eshell-rebind)
(not eshell-non-interactive-p))
@@ -235,11 +235,13 @@ Returns nil if INPUT is prepended by blank space,
otherwise non-nil."
(lambda ()
(if (>= (point) eshell-last-output-end)
(setq overriding-terminal-local-map
- eshell-isearch-map)))) nil t)
+ eshell-isearch-map))))
+ nil t)
(add-hook 'isearch-mode-end-hook
(function
(lambda ()
- (setq overriding-terminal-local-map nil))) nil t))
+ (setq overriding-terminal-local-map nil)))
+ nil t))
(define-key eshell-mode-map [up]
'eshell-previous-matching-input-from-input)
(define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input)
(define-key eshell-mode-map [(control up)] 'eshell-previous-input)
@@ -288,17 +290,17 @@ Returns nil if INPUT is prepended by blank space,
otherwise non-nil."
(if eshell-history-file-name
(eshell-read-history nil t))
- (add-hook 'eshell-exit-hook 'eshell-write-history nil t))
+ (add-hook 'eshell-exit-hook #'eshell-write-history nil t))
(unless eshell-history-ring
(setq eshell-history-ring (make-ring eshell-history-size)))
- (add-hook 'eshell-exit-hook 'eshell-write-history nil t)
+ (add-hook 'eshell-exit-hook #'eshell-write-history nil t)
- (add-hook 'kill-emacs-hook 'eshell-save-some-history)
+ (add-hook 'kill-emacs-hook #'eshell-save-some-history)
(make-local-variable 'eshell-input-filter-functions)
- (add-hook 'eshell-input-filter-functions 'eshell-add-to-history nil t)
+ (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t)
(define-key eshell-command-map [(control ?l)] 'eshell-list-history)
(define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history))
@@ -754,7 +756,7 @@ matched."
(setq nth (eshell-hist-word-reference nth)))
(unless (numberp mth)
(setq mth (eshell-hist-word-reference mth)))
- (cons (mapconcat 'identity (eshell-sublist textargs nth mth) " ")
+ (cons (mapconcat #'identity (eshell-sublist textargs nth mth) " ")
end))))
(defun eshell-hist-parse-modifier (hist reference)
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 5e4bbdc..89969d3 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -29,7 +29,8 @@
(require 'cl-lib)
(require 'esh-util)
(require 'esh-opt)
-(eval-when-compile (require 'eshell))
+(require 'esh-proc)
+(require 'esh-cmd)
;;;###autoload
(progn
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index dd3351b..9bc856a 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -46,9 +46,7 @@
;;; Code:
-(require 'esh-util)
-(require 'esh-arg)
-(eval-when-compile (require 'eshell))
+(require 'esh-mode)
;;;###autoload
(progn
@@ -247,10 +245,10 @@ EXAMPLES:
(lambda ()
(insert eshell-modifier-help-string)))))
-(defun eshell-pred-initialize ()
+(defun eshell-pred-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the predicate/modifier code."
(add-hook 'eshell-parse-argument-hook
- 'eshell-parse-arg-modifier t t)
+ #'eshell-parse-arg-modifier t t)
(define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
(define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index a303520..adc68b6 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -99,7 +99,7 @@ arriving, or after."
;;; Functions:
-(defun eshell-prompt-initialize ()
+(defun eshell-prompt-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the prompting code."
(unless eshell-non-interactive-p
(add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t)
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 9cb1617..a817edb 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -145,7 +145,7 @@ This is default behavior of shells like bash."
;;; Functions:
-(defun eshell-rebind-initialize ()
+(defun eshell-rebind-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the inputting code."
(unless eshell-non-interactive-p
(add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t)
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index bab2622..4a3b84e 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -23,8 +23,7 @@
;;; Code:
-(require 'eshell)
-(require 'esh-opt)
+(require 'esh-mode)
;;;###autoload
(progn
@@ -57,7 +56,7 @@ This includes when running `eshell-command'."
;;; Functions:
-(defun eshell-script-initialize ()
+(defun eshell-script-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the script parsing code."
(make-local-variable 'eshell-interpreter-alist)
(setq eshell-interpreter-alist
@@ -73,13 +72,14 @@ This includes when running `eshell-command'."
;; to ruin it for other modules
(let (eshell-inside-quote-regexp
eshell-outside-quote-regexp)
- (and (not eshell-non-interactive-p)
+ (and (not (bound-and-true-p eshell-non-interactive-p))
eshell-login-script
(file-readable-p eshell-login-script)
(eshell-do-eval
(list 'eshell-commands
(catch 'eshell-replace-command
- (eshell-source-file eshell-login-script))) t))
+ (eshell-source-file eshell-login-script)))
+ t))
(and eshell-rc-script
(file-readable-p eshell-rc-script)
(eshell-do-eval
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index 420f885..c7965b4 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -166,7 +166,7 @@ The options are `begin', `after' or `end'."
;;; Functions:
-(defun eshell-smart-initialize ()
+(defun eshell-smart-initialize () ;Called from `eshell-mode' via intern-soft!
"Setup Eshell smart display."
(unless eshell-non-interactive-p
;; override a few variables, since they would interfere with the
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index 8af783e..dea9040 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -147,7 +147,7 @@ behavior for short-lived processes, see bug#18108."
;;; Functions:
-(defun eshell-term-initialize ()
+(defun eshell-term-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the `term' interface code."
(make-local-variable 'eshell-interpreter-alist)
(setq eshell-interpreter-alist
@@ -191,7 +191,7 @@ allowed."
(term-exec term-buf program program nil args)
(let ((proc (get-buffer-process term-buf)))
(if (and proc (eq 'run (process-status proc)))
- (set-process-sentinel proc 'eshell-term-sentinel)
+ (set-process-sentinel proc #'eshell-term-sentinel)
(error "Failed to invoke visual command")))
(term-char-mode)
(if eshell-escape-control-x
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index 603b762..c791636 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -46,7 +46,7 @@
:tag "TRAMP Eshell features"
:group 'eshell-module))
-(defun eshell-tramp-initialize ()
+(defun eshell-tramp-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the TRAMP-using commands code."
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index e4c4265..2522181 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -35,8 +35,7 @@
;;; Code:
-(require 'eshell)
-(require 'esh-opt)
+(require 'esh-mode)
(require 'pcomplete)
;;;###autoload
@@ -140,7 +139,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on
the remote machine."
;;; Functions:
-(defun eshell-unix-initialize ()
+(defun eshell-unix-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the UNIX support/emulation code."
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 360202b..026edc5 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -25,9 +25,9 @@
;; hook `eshell-parse-argument-hook'. For a good example of this, see
;; `eshell-parse-drive-letter', defined in eshell-dirs.el.
-(provide 'esh-arg)
+;;; Code:
-(require 'esh-mode)
+(require 'esh-util)
(defgroup eshell-arg nil
"Argument parsing involves transforming the arguments passed on the
@@ -36,6 +36,48 @@ yield the values intended."
:tag "Argument parsing"
:group 'eshell)
+;;; Internal Variables:
+
+(defvar eshell-current-argument nil)
+(defvar eshell-current-modifiers nil)
+(defvar eshell-arg-listified nil)
+(defvar eshell-nested-argument nil)
+(defvar eshell-current-quoted nil)
+(defvar eshell-inside-quote-regexp nil)
+(defvar eshell-outside-quote-regexp nil)
+
+;;; User Variables:
+
+(defcustom eshell-arg-load-hook nil
+ "A hook that gets run when `eshell-arg' is loaded."
+ :version "24.1" ; removed eshell-arg-initialize
+ :type 'hook
+ :group 'eshell-arg)
+
+(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n)
+ "List of characters to recognize as argument separators."
+ :type '(repeat character)
+ :group 'eshell-arg)
+
+(defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
+ "Characters which are still special inside double quotes."
+ :type '(repeat character)
+ :group 'eshell-arg)
+
+(defcustom eshell-special-chars-outside-quoting
+ (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
+ "Characters that require escaping outside of double quotes.
+Without escaping them, they will introduce a change in the argument."
+ :type '(repeat character)
+ :group 'eshell-arg)
+
+(defsubst eshell-arg-delimiter (&optional pos)
+ "Return non-nil if POS is an argument delimiter.
+If POS is nil, the location of point is checked."
+ (let ((pos (or pos (point))))
+ (or (= pos (point-max))
+ (memq (char-after pos) eshell-delimiter-argument-list))))
+
(defcustom eshell-parse-argument-hook
(list
;; a term such as #<buffer NAME>, or #<process NAME> is a buffer
@@ -113,47 +155,13 @@ treated as a literal character."
:type 'hook
:group 'eshell-arg)
-;;; Code:
-
-;;; User Variables:
-
-(defcustom eshell-arg-load-hook nil
- "A hook that gets run when `eshell-arg' is loaded."
- :version "24.1" ; removed eshell-arg-initialize
- :type 'hook
- :group 'eshell-arg)
-
-(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n)
- "List of characters to recognize as argument separators."
- :type '(repeat character)
- :group 'eshell-arg)
-
-(defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
- "Characters which are still special inside double quotes."
- :type '(repeat character)
- :group 'eshell-arg)
-
-(defcustom eshell-special-chars-outside-quoting
- (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
- "Characters that require escaping outside of double quotes.
-Without escaping them, they will introduce a change in the argument."
- :type '(repeat character)
- :group 'eshell-arg)
-
-;;; Internal Variables:
-
-(defvar eshell-current-argument nil)
-(defvar eshell-current-modifiers nil)
-(defvar eshell-arg-listified nil)
-(defvar eshell-nested-argument nil)
-(defvar eshell-current-quoted nil)
-(defvar eshell-inside-quote-regexp nil)
-(defvar eshell-outside-quote-regexp nil)
-
;;; Functions:
-(defun eshell-arg-initialize ()
+(defun eshell-arg-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the argument parsing code."
+ ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
+ ;; already exists.
+ (defvar eshell-command-map)
(define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
(set (make-local-variable 'eshell-inside-quote-regexp) nil)
(set (make-local-variable 'eshell-outside-quote-regexp) nil))
@@ -195,13 +203,6 @@ Without escaping them, they will introduce a change in the
argument."
(setq eshell-current-argument argument))
(throw 'eshell-arg-done t))
-(defsubst eshell-arg-delimiter (&optional pos)
- "Return non-nil if POS is an argument delimiter.
-If POS is nil, the location of point is checked."
- (let ((pos (or pos (point))))
- (or (= pos (point-max))
- (memq (char-after pos) eshell-delimiter-argument-list))))
-
(defun eshell-quote-argument (string)
"Return STRING with magic characters quoted.
Magic characters are those in `eshell-special-chars-outside-quoting'."
@@ -405,4 +406,5 @@ If the form has no `type', the syntax is parsed as if
`type' were
(char-to-string (char-after)))))
(goto-char end)))))))
+(provide 'esh-arg)
;;; esh-arg.el ends here
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 1ed5d5d..6e03bda 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -105,6 +105,8 @@
(require 'eldoc))
(require 'esh-arg)
(require 'esh-proc)
+(require 'esh-module)
+(require 'esh-io)
(require 'esh-ext)
(eval-when-compile
@@ -285,7 +287,7 @@ otherwise t.")
"Return currently running command process, if non-Lisp."
eshell-last-async-proc)
-(defun eshell-cmd-initialize ()
+(defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the Eshell command processing module."
(set (make-local-variable 'eshell-current-command) nil)
(set (make-local-variable 'eshell-command-name) nil)
@@ -1337,7 +1339,7 @@ messages, and errors."
(eshell-print "\n"))
(eshell-close-handles 0 (list 'quote result)))))
-(defalias 'eshell-lisp-command* 'eshell-lisp-command)
+(defalias 'eshell-lisp-command* #'eshell-lisp-command)
(provide 'esh-cmd)
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index 35ebd36..978fc55 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -31,17 +31,12 @@
;;; Code:
-(provide 'esh-ext)
-
(require 'esh-util)
-(eval-when-compile
- (require 'cl-lib)
- (require 'esh-cmd))
+(eval-when-compile (require 'cl-lib))
(require 'esh-io)
(require 'esh-arg)
(require 'esh-opt)
-(require 'esh-proc)
(defgroup eshell-ext nil
"External commands are invoked when operating system executables are
@@ -177,9 +172,9 @@ external version."
;;; Functions:
-(defun eshell-ext-initialize ()
+(defun eshell-ext-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the external command handling code."
- (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t))
+ (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t))
(defun eshell-explicit-command (command args)
"If a command name begins with `*', call it externally always.
@@ -193,8 +188,6 @@ This bypasses all Lisp functions and aliases."
(error "%s: external command not found"
(substring command 1))))))
-(autoload 'eshell-close-handles "esh-io")
-
(defun eshell-remote-command (command args)
"Insert output from a remote COMMAND, using ARGS.
A remote command is something that executes on a different machine.
@@ -211,7 +204,7 @@ causing the user to wonder if anything's really going on..."
(progn
(setq exitcode
(shell-command
- (mapconcat 'shell-quote-argument
+ (mapconcat #'shell-quote-argument
(append (list command) args) " ")
outbuf errbuf))
(eshell-print (with-current-buffer outbuf (buffer-string)))
@@ -235,6 +228,8 @@ causing the user to wonder if anything's really going on..."
(cl-assert interp)
(if (functionp (car interp))
(apply (car interp) (append (cdr interp) args))
+ (require 'esh-proc)
+ (declare-function eshell-gather-process-output "esh-proc" (command args))
(eshell-gather-process-output
(car interp) (append (cdr interp) args)))))
@@ -249,7 +244,7 @@ Adds the given PATH to $PATH.")
(if args
(progn
(setq eshell-path-env (getenv "PATH")
- args (mapconcat 'identity args path-separator)
+ args (mapconcat #'identity args path-separator)
eshell-path-env
(if prepend
(concat args path-separator eshell-path-env)
@@ -336,4 +331,5 @@ line of the form #!<interp>."
(cdr interp)))))
(or interp (list fullname)))))))
+(provide 'esh-ext)
;;; esh-ext.el ends here
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index c33e732..ce1d021 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -68,8 +68,6 @@
;;; Code:
-(provide 'esh-io)
-
(require 'esh-arg)
(require 'esh-util)
@@ -171,7 +169,7 @@ not be added to this variable."
;;; Functions:
-(defun eshell-io-initialize ()
+(defun eshell-io-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the I/O subsystem code."
(add-hook 'eshell-parse-argument-hook
'eshell-parse-redirection nil t)
@@ -511,4 +509,5 @@ Returns what was actually sent, or nil if nothing was sent."
(eshell-output-object-to-target object (car target))
(setq target (cdr target))))))
+(provide 'esh-io)
;;; esh-io.el ends here
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 3029876..cff29be 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -58,13 +58,10 @@
;;; Code:
-(provide 'esh-mode)
-
(require 'esh-util)
(require 'esh-module)
(require 'esh-cmd)
-(require 'esh-io)
-(require 'esh-var)
+(require 'esh-arg) ;For eshell-parse-arguments
(defgroup eshell-mode nil
"This module contains code for handling input from the user."
@@ -202,6 +199,12 @@ This is used by `eshell-watch-for-password-prompt'."
:type 'boolean
:group 'eshell-mode)
+(defcustom eshell-directory-name
+ (locate-user-emacs-file "eshell/" ".eshell/")
+ "The directory where Eshell control files should be kept."
+ :type 'directory
+ :group 'eshell)
+
(defvar eshell-first-time-p t
"A variable which is non-nil the first time Eshell is loaded.")
@@ -292,7 +295,7 @@ and the hook `eshell-exit-hook'."
;; It's fine to run this unconditionally since it can be customized
;; via the `eshell-kill-processes-on-exit' variable.
(and (fboundp 'eshell-query-kill-processes)
- (not (memq 'eshell-query-kill-processes eshell-exit-hook))
+ (not (memq #'eshell-query-kill-processes eshell-exit-hook))
(eshell-query-kill-processes))
(run-hooks 'eshell-exit-hook))
@@ -334,7 +337,6 @@ and the hook `eshell-exit-hook'."
(define-key eshell-command-map [(control ?b)] 'eshell-backward-argument)
(define-key eshell-command-map [(control ?e)] 'eshell-show-maximum-output)
(define-key eshell-command-map [(control ?f)] 'eshell-forward-argument)
- (define-key eshell-command-map [return] 'eshell-copy-old-input)
(define-key eshell-command-map [(control ?m)] 'eshell-copy-old-input)
(define-key eshell-command-map [(control ?o)] 'eshell-kill-output)
(define-key eshell-command-map [(control ?r)] 'eshell-show-output)
@@ -410,23 +412,23 @@ and the hook `eshell-exit-hook'."
(when (and load-hook (boundp load-hook))
(if (memq initfunc (symbol-value load-hook)) (setq initfunc nil))
(run-hooks load-hook))
- ;; So we don't need the -initialize functions on the hooks (b#5375).
+ ;; So we don't need the -initialize functions on the hooks (bug#5375).
(and initfunc (fboundp initfunc) (funcall initfunc))))
(if eshell-send-direct-to-subprocesses
- (add-hook 'pre-command-hook 'eshell-intercept-commands t t))
+ (add-hook 'pre-command-hook #'eshell-intercept-commands t t))
(if eshell-scroll-to-bottom-on-input
- (add-hook 'pre-command-hook 'eshell-preinput-scroll-to-bottom t t))
+ (add-hook 'pre-command-hook #'eshell-preinput-scroll-to-bottom t t))
(when eshell-scroll-show-maximum-output
(set (make-local-variable 'scroll-conservatively) 1000))
(when eshell-status-in-mode-line
- (add-hook 'eshell-pre-command-hook 'eshell-command-started nil t)
- (add-hook 'eshell-post-command-hook 'eshell-command-finished nil t))
+ (add-hook 'eshell-pre-command-hook #'eshell-command-started nil t)
+ (add-hook 'eshell-post-command-hook #'eshell-command-finished nil t))
- (add-hook 'kill-buffer-hook 'eshell-kill-buffer-function t t)
+ (add-hook 'kill-buffer-hook #'eshell-kill-buffer-function t t)
(if eshell-first-time-p
(run-hooks 'eshell-first-time-mode-hook))
@@ -451,10 +453,10 @@ and the hook `eshell-exit-hook'."
(if eshell-send-direct-to-subprocesses
(progn
(setq eshell-send-direct-to-subprocesses nil)
- (remove-hook 'pre-command-hook 'eshell-intercept-commands t)
+ (remove-hook 'pre-command-hook #'eshell-intercept-commands t)
(message "Sending subprocess input on RET"))
(setq eshell-send-direct-to-subprocesses t)
- (add-hook 'pre-command-hook 'eshell-intercept-commands t t)
+ (add-hook 'pre-command-hook #'eshell-intercept-commands t t)
(message "Sending subprocess input directly")))
(defun eshell-self-insert-command ()
@@ -543,7 +545,7 @@ and the hook `eshell-exit-hook'."
"Push a mark at the end of the last input text."
(push-mark (1- eshell-last-input-end) t))
-(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark)
+(custom-add-option 'eshell-pre-command-hook #'eshell-push-command-mark)
(defsubst eshell-goto-input-start ()
"Goto the start of the last command input.
@@ -551,7 +553,7 @@ Putting this function on `eshell-pre-command-hook' will
mimic Plan 9's
9term behavior."
(goto-char eshell-last-input-start))
-(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark)
+(custom-add-option 'eshell-pre-command-hook #'eshell-goto-input-start)
(defsubst eshell-interactive-print (string)
"Print STRING to the eshell display buffer."
@@ -1021,4 +1023,5 @@ This function could be in the list
`eshell-output-filter-functions'."
(custom-add-option 'eshell-output-filter-functions
'eshell-handle-ansi-color)
+(provide 'esh-mode)
;;; esh-mode.el ends here
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 2583044..1911a49 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -22,9 +22,6 @@
;;; Code:
-(provide 'esh-module)
-
-(require 'eshell)
(require 'esh-util)
(defgroup eshell-module nil
@@ -101,4 +98,5 @@ customization group. Example: `eshell-cmpl' for that
module."
(unload-feature module)
(message "Unloading %s...done" (symbol-name module))))))
+(provide 'esh-module)
;;; esh-module.el ends here
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index a023a3c..3ea5873 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -23,9 +23,6 @@
;;; Code:
-(provide 'esh-opt)
-
-(require 'esh-ext)
;; Unused.
;; (defgroup eshell-opt nil
@@ -36,6 +33,10 @@
;;; User Functions:
+;; Macro expansion of eshell-eval-using-options refers to eshell-stringify-list
+;; defined in esh-util.
+(require 'esh-util)
+
(defmacro eshell-eval-using-options (name macro-args options &rest body-forms)
"Process NAME's MACRO-ARGS using a set of command line OPTIONS.
After doing so, stores settings in local symbols as declared by OPTIONS;
@@ -127,6 +128,8 @@ let-bound variable `args'."
(defun eshell--do-opts (name options args)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
+ (require 'esh-ext)
+ (declare-function eshell-external-command "esh-ext" (command args))
(let ((ext-command
(catch 'eshell-ext-command
(let ((usage-msg
@@ -145,6 +148,8 @@ This code doesn't really need to be macro expanded
everywhere."
(defun eshell-show-usage (name options)
"Display the usage message for NAME, using OPTIONS."
+ (require 'esh-ext)
+ (declare-function eshell-search-path "esh-ext" (name))
(let ((usage (format "usage: %s %s\n\n" name
(cadr (memq ':usage options))))
(extcmd (memq ':external options))
@@ -273,4 +278,5 @@ switch is unrecognized."
(setq index (1+ index))))))))
(nconc (mapcar #'cdr opt-vals) eshell--args)))
+(provide 'esh-opt)
;;; esh-opt.el ends here
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 3432582..d538ae3 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -23,9 +23,7 @@
;;; Code:
-(provide 'esh-proc)
-
-(require 'esh-cmd)
+(require 'esh-io)
(defgroup eshell-proc nil
"When Eshell invokes external commands, it always does so
@@ -118,14 +116,17 @@ information, for example."
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter."
;; Was there till 24.1, but it is not optional.
- (if (memq 'eshell-reset-after-proc eshell-kill-hook)
- (setq eshell-kill-hook (delq 'eshell-reset-after-proc eshell-kill-hook)))
+ (if (memq #'eshell-reset-after-proc eshell-kill-hook)
+ (setq eshell-kill-hook (delq #'eshell-reset-after-proc
eshell-kill-hook)))
(eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
-(defun eshell-proc-initialize ()
+(defun eshell-proc-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the process handling code."
(make-local-variable 'eshell-process-list)
+ ;; This is supposedly run after enabling esh-mode, when eshell-command-map
+ ;; already exists.
+ (defvar eshell-command-map)
(define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
(define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process)
(define-key eshell-command-map [(control ?k)] 'eshell-kill-process)
@@ -139,9 +140,11 @@ PROC and STATUS to functions on the latter."
"Reset the command input location after a process terminates.
The signals which will cause this to happen are matched by
`eshell-reset-signals'."
- (if (and (stringp status)
- (string-match eshell-reset-signals status))
- (eshell-reset)))
+ (when (and (stringp status)
+ (string-match eshell-reset-signals status))
+ (require 'esh-mode)
+ (declare-function eshell-reset "esh-mode" (&optional no-hooks))
+ (eshell-reset)))
(defun eshell-wait-for-process (&rest procs)
"Wait until PROC has successfully completed."
@@ -209,7 +212,8 @@ The prompt will be set to PROMPT."
(function
(lambda (proc)
(cons (process-name proc) t)))
- (process-list)) nil t))
+ (process-list))
+ nil t))
(defun eshell-insert-process (process)
"Insert the name of PROCESS into the current buffer at point."
@@ -220,10 +224,12 @@ The prompt will be set to PROMPT."
(defsubst eshell-record-process-object (object)
"Record OBJECT as now running."
- (if (and (eshell-processp object)
- eshell-current-subjob-p)
- (eshell-interactive-print
- (format "[%s] %d\n" (process-name object) (process-id object))))
+ (when (and (eshell-processp object)
+ eshell-current-subjob-p)
+ (require 'esh-mode)
+ (declare-function eshell-interactive-print "esh-mode" (string))
+ (eshell-interactive-print
+ (format "[%s] %d\n" (process-name object) (process-id object))))
(setq eshell-process-list
(cons (list object eshell-current-handles
eshell-current-subjob-p nil nil)
@@ -254,7 +260,7 @@ the full name of a command, otherwise just the nondirectory
part must match.")
(defun eshell-needs-pipe-p (command)
"Return non-nil if COMMAND needs `process-connection-type' to be nil.
See `eshell-needs-pipe'."
- (and eshell-in-pipeline-p
+ (and (bound-and-true-p eshell-in-pipeline-p)
(not (eq eshell-in-pipeline-p 'first))
;; FIXME should this return non-nil for anything that is
;; neither 'first nor 'last? See bug#1388 discussion.
@@ -267,6 +273,8 @@ See `eshell-needs-pipe'."
(defun eshell-gather-process-output (command args)
"Gather the output from COMMAND + ARGS."
+ (require 'esh-var)
+ (declare-function eshell-environment-variables "esh-var" ())
(unless (and (file-executable-p command)
(file-regular-p (file-truename command)))
(error "%s: not an executable file" command))
@@ -283,14 +291,14 @@ See `eshell-needs-pipe'."
(unless (eshell-needs-pipe-p command)
process-connection-type))
(command (file-local-name (expand-file-name command))))
- (apply 'start-file-process
+ (apply #'start-file-process
(file-name-nondirectory command) nil command args)))
(eshell-record-process-object proc)
(set-process-buffer proc (current-buffer))
- (if (eshell-interactive-output-p)
- (set-process-filter proc 'eshell-output-filter)
- (set-process-filter proc 'eshell-insertion-filter))
- (set-process-sentinel proc 'eshell-sentinel)
+ (set-process-filter proc (if (eshell-interactive-output-p)
+ #'eshell-output-filter
+ #'eshell-insertion-filter))
+ (set-process-sentinel proc #'eshell-sentinel)
(run-hook-with-args 'eshell-exec-hook proc)
(when (fboundp 'process-coding-system)
(let ((coding-systems (process-coding-system proc)))
@@ -325,14 +333,14 @@ See `eshell-needs-pipe'."
(set-buffer oldbuf)
(run-hook-with-args 'eshell-exec-hook command)
(setq exit-status
- (apply 'call-process-region
+ (apply #'call-process-region
(append (list eshell-last-sync-output-start (point)
command t
eshell-scratch-buffer nil)
args)))
;; When in a pipeline, record the place where the output of
;; this process will begin.
- (and eshell-in-pipeline-p
+ (and (bound-and-true-p eshell-in-pipeline-p)
(set-marker eshell-last-sync-output-start (point)))
;; Simulate the effect of the process filter.
(when (numberp exit-status)
@@ -349,11 +357,14 @@ See `eshell-needs-pipe'."
(setq lbeg lend)
(set-buffer proc-buf))
(set-buffer oldbuf))
+ (require 'esh-mode)
+ (declare-function eshell-update-markers "esh-mode" (pmark))
+ (defvar eshell-last-output-end) ;Defined in esh-mode.el.
(eshell-update-markers eshell-last-output-end)
;; Simulate the effect of eshell-sentinel.
(eshell-close-handles (if (numberp exit-status) exit-status -1))
(eshell-kill-process-function command exit-status)
- (or eshell-in-pipeline-p
+ (or (bound-and-true-p eshell-in-pipeline-p)
(setq eshell-last-sync-output-start nil))
(if (not (numberp exit-status))
(error "%s: external command failed: %s" command exit-status))
@@ -540,7 +551,11 @@ See the variable `eshell-kill-processes-on-exit'."
(defun eshell-send-eof-to-process ()
"Send EOF to process."
(interactive)
+ (require 'esh-mode)
+ (declare-function eshell-send-input "esh-mode"
+ (&optional use-region queue-p no-newline))
(eshell-send-input nil nil t)
(eshell-process-interact 'process-send-eof))
+(provide 'esh-proc)
;;; esh-proc.el ends here
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 118978e..6f355c7 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -478,24 +478,22 @@ list."
(insert-file-contents (or filename eshell-hosts-file))
(goto-char (point-min))
(while (re-search-forward
- "^\\([^#[:space:]]+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?"
nil t)
- (if (match-string 1)
- (cl-pushnew (match-string 1) hosts :test #'equal))
- (if (match-string 2)
- (cl-pushnew (match-string 2) hosts :test #'equal))
- (if (match-string 4)
- (cl-pushnew (match-string 4) hosts :test #'equal))))
- (sort hosts #'string-lessp)))
+ ;; "^ \t\\([^# \t\n]+\\)[ \t]+\\([^ \t\n]+\\)\\([ \t]*\\([^
\t\n]+\\)\\)?"
+ "^[ \t]*\\([^# \t\n]+\\)[ \t]+\\([^ \t\n].+\\)" nil t)
+ (push (cons (match-string 1)
+ (split-string (match-string 2)))
+ hosts)))
+ (nreverse hosts)))
(defun eshell-read-hosts (file result-var timestamp-var)
- "Read the contents of /etc/passwd for user names."
+ "Read the contents of /etc/hosts for host names."
(if (or (not (symbol-value result-var))
(not (symbol-value timestamp-var))
(time-less-p
(symbol-value timestamp-var)
(file-attribute-modification-time (file-attributes file))))
(progn
- (set result-var (eshell-read-hosts-file file))
+ (set result-var (apply #'nconc (eshell-read-hosts-file file)))
(set timestamp-var (current-time))))
(symbol-value result-var))
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index d8be72e..b08a5d2 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -105,11 +105,12 @@
;;; Code:
-(provide 'esh-var)
-
(require 'esh-util)
(require 'esh-cmd)
(require 'esh-opt)
+(require 'esh-module)
+(require 'esh-arg)
+(require 'esh-io)
(require 'pcomplete)
(require 'env)
@@ -198,7 +199,7 @@ function), and the arguments passed to this function would
be the list
;;; Functions:
-(defun eshell-var-initialize ()
+(defun eshell-var-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the variable handle code."
;; Break the association with our parent's environment. Otherwise,
;; changing a variable will affect all of Emacs.
@@ -206,6 +207,9 @@ function), and the arguments passed to this function would
be the list
(set (make-local-variable 'process-environment)
(eshell-copy-environment)))
+ ;; This is supposedly run after enabling esh-mode, when eshell-command-map
+ ;; already exists.
+ (defvar eshell-command-map)
(define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar)
(set (make-local-variable 'eshell-special-chars-inside-quoting)
@@ -213,16 +217,16 @@ function), and the arguments passed to this function
would be the list
(set (make-local-variable 'eshell-special-chars-outside-quoting)
(append eshell-special-chars-outside-quoting '(?$)))
- (add-hook 'eshell-parse-argument-hook 'eshell-interpolate-variable t t)
+ (add-hook 'eshell-parse-argument-hook #'eshell-interpolate-variable t t)
(add-hook 'eshell-prepare-command-hook
- 'eshell-handle-local-variables nil t)
+ #'eshell-handle-local-variables nil t)
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
- 'eshell-complete-variable-reference nil t)
+ #'eshell-complete-variable-reference nil t)
(add-hook 'pcomplete-try-first-hook
- 'eshell-complete-variable-assignment nil t)))
+ #'eshell-complete-variable-assignment nil t)))
(defun eshell-handle-local-variables ()
"Allow for the syntax `VAR=val <command> <args>'."
@@ -532,7 +536,7 @@ For example, to retrieve the second element of a user's
record in
(setq separator (caar indices)
refs (cdr refs)))
(setq value
- (mapcar 'eshell-convert
+ (mapcar #'eshell-convert
(split-string value separator)))))
(cond
((< (length refs) 0)
@@ -618,4 +622,5 @@ For example, to retrieve the second element of a user's
record in
(setq pcomplete-stub (substring arg pos))
(throw 'pcomplete-completions (pcomplete-entries)))))
+(provide 'esh-var)
;;; esh-var.el ends here
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 4516800..db20f7d 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -175,7 +175,10 @@
(eval-when-compile
(require 'cl-lib))
(require 'esh-util)
-(require 'esh-mode)
+(require 'esh-module) ;For eshell-using-module
+(require 'esh-proc) ;For eshell-wait-for-process
+(require 'esh-io) ;For eshell-last-command-status
+(require 'esh-cmd)
(defgroup eshell nil
"Command shell implemented entirely in Emacs Lisp.
@@ -217,12 +220,6 @@ shells such as bash, zsh, rc, 4dos."
:type 'string
:group 'eshell)
-(defcustom eshell-directory-name
- (locate-user-emacs-file "eshell/" ".eshell/")
- "The directory where Eshell control files should be kept."
- :type 'directory
- :group 'eshell)
-
;;;_* Running Eshell
;;
;; There are only three commands used to invoke Eshell. The first two
@@ -256,11 +253,12 @@ buffer selected (or created)."
buf))
(defun eshell-return-exits-minibuffer ()
+ ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
+ ;; already exists.
+ (defvar eshell-mode-map)
(define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
- (define-key eshell-mode-map [return] 'exit-minibuffer)
(define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
(define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
- (define-key eshell-mode-map [(meta return)] 'exit-minibuffer)
(define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
(defvar eshell-non-interactive-p nil
@@ -275,7 +273,6 @@ non-interactive sessions, such as when using
`eshell-command'.")
"Execute the Eshell command string COMMAND.
With prefix ARG, insert output into the current buffer at point."
(interactive)
- (require 'esh-cmd)
(unless arg
(setq arg current-prefix-arg))
(let ((eshell-non-interactive-p t))
@@ -363,7 +360,8 @@ corresponding to a successful execution."
(let ((result (eshell-do-eval
(list 'eshell-commands
(list 'eshell-command-to-value
- (eshell-parse-command command))) t)))
+ (eshell-parse-command command)))
+ t)))
(cl-assert (eq (car result) 'quote))
(if (and status-var (symbolp status-var))
(set status-var eshell-last-command-status))
@@ -404,5 +402,4 @@ Emacs."
(run-hooks 'eshell-load-hook)
(provide 'eshell)
-
;;; eshell.el ends here
diff --git a/lisp/faces.el b/lisp/faces.el
index ab6c384..fa526c3 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -55,6 +55,7 @@ This means to treat a terminal of type TYPE as if it were of
type ALIAS."
:group 'terminals
:version "25.1")
+(declare-function display-graphic-p "frame" (&optional display))
(declare-function xw-defined-colors "term/common-win" (&optional frame))
(defvar help-xref-stack-item)
@@ -1239,7 +1240,7 @@ of a global face. Value is the new attribute value."
;; explicitly in VALID, using color approximation code
;; in tty-colors.el.
(when (and (memq attribute '(:foreground :background))
- (not (memq (window-system frame) '(x w32 ns)))
+ (not (display-graphic-p frame))
(not (member new-value
'("unspecified"
"unspecified-fg" "unspecified-bg"))))
@@ -1833,7 +1834,7 @@ The argument FRAME specifies which frame to try.
The value may be different for frames on different display types.
If FRAME doesn't support colors, the value is nil.
If FRAME is nil, that stands for the selected frame."
- (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
+ (if (display-graphic-p frame)
(xw-defined-colors frame)
(mapcar 'car (tty-color-alist frame))))
(defalias 'x-defined-colors 'defined-colors)
@@ -1877,7 +1878,7 @@ or one of the strings \"unspecified-fg\" or
\"unspecified-bg\".
If FRAME is omitted or nil, use the selected frame."
(unless (member color '(unspecified "unspecified-bg" "unspecified-fg"))
- (if (member (framep (or frame (selected-frame))) '(x w32 ns))
+ (if (display-graphic-p frame)
(xw-color-defined-p color frame)
(numberp (tty-color-translate color frame)))))
(defalias 'x-color-defined-p 'color-defined-p)
@@ -1903,7 +1904,7 @@ return value is nil."
(cond
((member color '(unspecified "unspecified-fg" "unspecified-bg"))
nil)
- ((memq (framep (or frame (selected-frame))) '(x w32 ns))
+ ((display-graphic-p frame)
(xw-color-values color frame))
(t
(tty-color-values color frame))))
@@ -1917,7 +1918,7 @@ return value is nil."
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display."
- (if (memq (framep-on-display display) '(x w32 ns))
+ (if (display-graphic-p display)
(xw-display-color-p display)
(tty-display-color-p display)))
(defalias 'x-display-color-p 'display-color-p)
@@ -1928,12 +1929,9 @@ If omitted or nil, that stands for the selected frame's
display."
"Return non-nil if frames on DISPLAY can display shades of gray.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display."
- (let ((frame-type (framep-on-display display)))
- (cond
- ((memq frame-type '(x w32 ns))
- (x-display-grayscale-p display))
- (t
- (> (tty-color-gray-shades display) 2)))))
+ (if (display-graphic-p display)
+ (x-display-grayscale-p display)
+ (> (tty-color-gray-shades display) 2)))
(defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
"Read a color name or RGB triplet.
diff --git a/lisp/files-x.el b/lisp/files-x.el
index eedf630..b71e920 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -686,8 +686,11 @@ This does nothing if `enable-connection-local-variables'
is nil."
(dolist (variable (connection-local-get-profile-variables profile))
(unless (assq (car variable) connection-local-variables-alist)
(push variable connection-local-variables-alist))))
- ;; Push them to `file-local-variables-alist'.
- (hack-local-variables-filter connection-local-variables-alist nil)))
+ ;; Push them to `file-local-variables-alist'. Connection-local
+ ;; variables do not appear from external files. So we can regard
+ ;; them as safe.
+ (let ((enable-local-variables :all))
+ (hack-local-variables-filter connection-local-variables-alist nil))))
;;;###autoload
(defun hack-connection-local-variables-apply (criteria)
diff --git a/lisp/files.el b/lisp/files.el
index 7e98f5a..db76534 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2731,9 +2731,8 @@
ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo
("\\.dbk\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.jsm?\\'" . javascript-mode)
+ ("\\.js[mx]?\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
- ("\\.jsx\\'" . js-jsx-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
("\\.by\\'" . bovine-grammar-mode)
("\\.wy\\'" . wisent-grammar-mode)
@@ -6342,7 +6341,7 @@ See also `auto-save-file-name-p'."
;; We do this on all platforms, because even if we are not
;; running on DOS/Windows, the current directory may be on a
;; mounted VFAT filesystem, such as a USB memory stick.
- (while (string-match "[^A-Za-z0-9-_.~#+]" buffer-name limit)
+ (while (string-match "[^A-Za-z0-9_.~#+-]" buffer-name limit)
(let* ((character (aref buffer-name (match-beginning 0)))
(replacement
;; For multibyte characters, this will produce more than
diff --git a/lisp/frame.el b/lisp/frame.el
index 7cfe546..b5c936a 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -676,12 +676,16 @@ The optional argument PARAMETERS specifies additional
frame parameters."
"Make a frame on monitor MONITOR.
The optional argument DISPLAY can be a display name, and the optional
argument PARAMETERS specifies additional frame parameters."
- (interactive (list (completing-read
- (format "Make frame on monitor: ")
- (or (delq nil (mapcar (lambda (a)
- (cdr (assq 'name a)))
- (display-monitor-attributes-list)))
- '("")))))
+ (interactive
+ (list
+ (let* ((default (cdr (assq 'name (frame-monitor-attributes)))))
+ (completing-read
+ (format "Make frame on monitor (default %s): " default)
+ (or (delq nil (mapcar (lambda (a)
+ (cdr (assq 'name a)))
+ (display-monitor-attributes-list)))
+ '(""))
+ nil nil nil nil default))))
(let* ((monitor-workarea
(catch 'done
(dolist (a (display-monitor-attributes-list display))
@@ -970,7 +974,7 @@ recently selected windows nor the buffer list."
(select-frame frame norecord)
(raise-frame frame)
;; Ensure, if possible, that FRAME gets input focus.
- (when (memq (window-system frame) '(x w32 ns))
+ (when (display-multi-frame-p frame)
(x-focus-frame frame))
;; Move mouse cursor if necessary.
(cond
@@ -1023,16 +1027,15 @@ that variable should be nil."
"Do whatever is right to suspend the current frame.
Calls `suspend-emacs' if invoked from the controlling tty device,
`suspend-tty' from a secondary tty device, and
-`iconify-or-deiconify-frame' from an X frame."
+`iconify-or-deiconify-frame' from a graphical frame."
(interactive)
- (let ((type (framep (selected-frame))))
- (cond
- ((memq type '(x ns w32)) (iconify-or-deiconify-frame))
- ((eq type t)
- (if (controlling-tty-p)
- (suspend-emacs)
- (suspend-tty)))
- (t (suspend-emacs)))))
+ (cond
+ ((display-multi-frame-p) (iconify-or-deiconify-frame))
+ ((eq (framep (selected-frame)) t)
+ (if (controlling-tty-p)
+ (suspend-emacs)
+ (suspend-tty)))
+ (t (suspend-emacs))))
(defun make-frame-names-alist ()
;; Only consider the frames on the same display.
@@ -1852,6 +1855,14 @@ for FRAME."
;;;; Frame/display capabilities.
+;; These functions should make the features they test explicit in
+;; their names, so that when capabilities or the corresponding Emacs
+;; features change, it will be easy to find all the tests for such
+;; capabilities by a simple text search. See more about the history
+;; and the intent of these functions in
+;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2019-04/msg00004.html
+;; or in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35058#17.
+
(declare-function msdos-mouse-p "dosfns.c")
(defun display-mouse-p (&optional display)
@@ -1902,6 +1913,7 @@ frame's display)."
(fboundp 'image-mask-p)
(fboundp 'image-size)))
+(defalias 'display-blink-cursor-p 'display-graphic-p)
(defalias 'display-multi-frame-p 'display-graphic-p)
(defalias 'display-multi-font-p 'display-graphic-p)
@@ -1923,6 +1935,16 @@ frame's display)."
(t
nil))))
+(defun display-symbol-keys-p (&optional display)
+ "Return non-nil if DISPLAY supports symbol names as keys.
+This means that, for example, DISPLAY can differentiate between
+the keybinding RET and [return]."
+ (let ((frame-type (framep-on-display display)))
+ (or (memq frame-type '(x w32 ns pc))
+ ;; MS-DOS and MS-Windows terminals have built-in support for
+ ;; function (symbol) keys
+ (memq system-type '(ms-dos windows-nt)))))
+
(declare-function x-display-screens "xfns.c" (&optional terminal))
(defun display-screens (&optional display)
@@ -2079,7 +2101,7 @@ If DISPLAY is omitted or nil, it defaults to the selected
frame's display."
((eq frame-type 'pc)
4)
(t
- (truncate (log (length (tty-color-alist)) 2))))))
+ (logb (length (tty-color-alist)))))))
(declare-function x-display-color-cells "xfns.c" (&optional terminal))
@@ -2542,7 +2564,7 @@ terminals, cursor blinking is controlled by the terminal."
:init-value (not (or noninteractive
no-blinking-cursor
(eq system-type 'ms-dos)
- (not (memq window-system '(x w32 ns)))))
+ (not (display-blink-cursor-p))))
:initialize 'custom-initialize-delay
:group 'cursor
:global t
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 879e1fe..9f7d2c9 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -276,7 +276,7 @@ Actually a hash table holding subjects mapped to t.")
(defmacro gnus-agent-with-refreshed-group (group &rest body)
"Performs the body then updates the group's line in the group
buffer. Automatically blocks multiple updates due to recursion."
-`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
+ `(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
(when (and gnus-agent-need-update-total-fetched-for
(not gnus-agent-inhibit-update-total-fetched-for))
(with-current-buffer gnus-group-buffer
@@ -311,9 +311,10 @@ buffer. Automatically blocks multiple updates due to
recursion."
(defun gnus-agent-cat-set-property (category property value)
(if value
(setcdr (or (assq property category)
- (let ((cell (cons property nil)))
+ (let ((cell (cons property nil)))
(setcdr category (cons cell (cdr category)))
- cell)) value)
+ cell))
+ value)
(let ((category category))
(while (cond ((eq property (caadr category))
(setcdr category (cddr category))
@@ -378,7 +379,8 @@ manipulated as follows:
(setcdr (or (assq 'agent-groups category)
(let ((cell (cons 'agent-groups nil)))
(setcdr category (cons cell (cdr category)))
- cell)) new-g))
+ cell))
+ new-g))
(t
(let ((groups groups))
(while groups
@@ -395,7 +397,8 @@ manipulated as follows:
(setcdr (or (assq 'agent-groups category)
(let ((cell (cons 'agent-groups nil)))
(setcdr category (cons cell (cdr category)))
- cell)) groups))))))
+ cell))
+ groups))))))
(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
(list name `(agent-predicate . ,(or default-agent-predicate 'false))))
@@ -1557,11 +1560,8 @@ downloaded into the agent."
(skip-chars-forward " ")
(setq crosses nil)
(while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *")
- (push (cons (buffer-substring (match-beginning 1)
- (match-end 1))
- (string-to-number
- (buffer-substring (match-beginning 2)
- (match-end 2))))
+ (push (cons (match-string 1)
+ (string-to-number (match-string 2)))
crosses)
(goto-char (match-end 0)))
(gnus-agent-crosspost crosses (caar pos) date)))
@@ -2939,7 +2939,7 @@ The following commands are available:
'or)
((memq (car predicate) gnus-category-not)
'not))
- ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
+ ,@(mapcar #'gnus-category-make-function-1 (cdr predicate))))
(t
(error "Unknown predicate type: %s" predicate))))
@@ -2965,7 +2965,7 @@ return read articles, nil when it is known to always
return read
articles, and t_nil when the function may return both read and unread
articles."
(let ((func (car function))
- (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
+ (args (mapcar #'gnus-function-implies-unread-1 (cdr function))))
(cond ((eq func 'and)
(cond ((memq t args) ; if any argument returns only unread articles
;; then that argument constrains the result to only unread
articles.
@@ -3151,38 +3151,37 @@ FORCE is equivalent to setting the expiration
predicates to true."
(nov-file (concat dir ".overview"))
(cnt 0)
(completed -1)
- dlist
- type)
-
- ;; The normal article alist contains elements that look like
- ;; (article# . fetch_date) I need to combine other
- ;; information with this list. For example, a flag indicating
- ;; that a particular article MUST BE KEPT. To do this, I'm
- ;; going to transform the elements to look like (article#
- ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse
- ;; the process to generate the expired article alist.
-
- ;; Convert the alist elements to (article# fetch_date nil
- ;; nil).
- (setq dlist (mapcar (lambda (e)
- (list (car e) (cdr e) nil nil)) alist))
-
- ;; Convert the keep lists to elements that look like (article#
- ;; nil keep_flag nil) then append it to the expanded dlist
- ;; These statements are sorted by ascending precedence of the
- ;; keep_flag.
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'unread nil))
- unreads)))
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'marked nil))
- marked)))
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'special nil))
- specials)))
+ type
+
+ ;; The normal article alist contains elements that look like
+ ;; (article# . fetch_date) I need to combine other
+ ;; information with this list. For example, a flag indicating
+ ;; that a particular article MUST BE KEPT. To do this, I'm
+ ;; going to transform the elements to look like (article#
+ ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse
+ ;; the process to generate the expired article alist.
+ (dlist
+ (nconc
+ ;; Convert the alist elements to (article# fetch_date nil nil).
+ (mapcar (lambda (e)
+ (list (car e) (cdr e) nil nil))
+ alist)
+
+ ;; Convert the keep lists to elements that look like (article#
+ ;; nil keep_flag nil) then append it to the expanded dlist
+ ;; These statements are sorted by ascending precedence of the
+ ;; keep_flag.
+ (mapcar (lambda (e)
+ (list e nil 'unread nil))
+ unreads)
+
+ (mapcar (lambda (e)
+ (list e nil 'marked nil))
+ marked)
+
+ (mapcar (lambda (e)
+ (list e nil 'special nil))
+ specials))))
(set-buffer overview)
(erase-buffer)
@@ -3391,7 +3390,7 @@ article alist" type) actions))
(when actions
(gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
decoded article-number
- (mapconcat 'identity actions ", ")))))
+ (mapconcat #'identity actions ", ")))))
(t
(gnus-agent-message
10 "gnus-agent-expire: %s:%d: Article kept as \
@@ -3624,7 +3623,7 @@ If CACHED-HEADER is nil, articles are only excluded if
the article itself
has been fetched."
;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
- ;; 'car gnus-agent-article-alist))
+ ;; #'car gnus-agent-article-alist))
;; Functionally, I don't need to construct a temp list using mapcar.
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 8b87648..4981614 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -1,4 +1,4 @@
-;;; gnus-dup.el --- suppression of duplicate articles in Gnus
+;;; gnus-dup.el --- suppression of duplicate articles in Gnus -*-
lexical-binding: t -*-
;; Copyright (C) 1996-2019 Free Software Foundation, Inc.
@@ -57,10 +57,12 @@ seen in the same session."
(defvar gnus-dup-list nil
"List of seen message IDs, as strings.")
+
(defvar gnus-dup-hashtb nil
"Hash table of seen message IDs, for fast lookup.")
-(defvar gnus-dup-list-dirty nil)
+(defvar gnus-dup-list-dirty nil
+ "Non-nil if `gnus-dup-list' needs to be saved.")
;;;
;;; Starting and stopping
@@ -80,7 +82,7 @@ seen in the same session."
(if gnus-save-duplicate-list
(gnus-dup-read)
(setq gnus-dup-list nil))
- (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
+ (setq gnus-dup-hashtb (gnus-make-hashtable))
;; Enter all Message-IDs into the hash table.
(dolist (g gnus-dup-list)
(puthash g t gnus-dup-hashtb)))
@@ -105,7 +107,7 @@ seen in the same session."
(defun gnus-dup-enter-articles ()
"Enter articles from the current group for future duplicate suppression."
- (unless gnus-dup-list
+ (unless gnus-dup-hashtb
(gnus-dup-open))
(setq gnus-dup-list-dirty t) ; mark list for saving
(let (msgid)
@@ -121,15 +123,17 @@ seen in the same session."
(not (gethash msgid gnus-dup-hashtb)))
(push msgid gnus-dup-list)
(puthash msgid t gnus-dup-hashtb))))
- ;; Chop off excess Message-IDs from the list.
- (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
+ ;; Remove excess Message-IDs from the list and hash table.
+ (let* ((dups (cons nil gnus-dup-list))
+ (end (nthcdr gnus-duplicate-list-length dups)))
(when end
(mapc (lambda (id) (remhash id gnus-dup-hashtb)) (cdr end))
- (setcdr end nil))))
+ (setcdr end nil))
+ (setq gnus-dup-list (cdr dups))))
(defun gnus-dup-suppress-articles ()
"Mark duplicate articles as read."
- (unless gnus-dup-list
+ (unless gnus-dup-hashtb
(gnus-dup-open))
(gnus-message 8 "Suppressing duplicates...")
(let ((auto (and gnus-newsgroup-auto-expire
@@ -137,10 +141,9 @@ seen in the same session."
number)
(dolist (header gnus-newsgroup-headers)
(when (and (gethash (mail-header-id header) gnus-dup-hashtb)
- (gnus-summary-article-unread-p (mail-header-number header)))
- (setq gnus-newsgroup-unreads
- (delq (setq number (mail-header-number header))
- gnus-newsgroup-unreads))
+ (setq number (mail-header-number header))
+ (gnus-summary-article-unread-p number))
+ (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads))
(if (not auto)
(push (cons number gnus-duplicate-mark) gnus-newsgroup-reads)
(push number gnus-newsgroup-expirable)
@@ -149,9 +152,10 @@ seen in the same session."
(defun gnus-dup-unsuppress-article (article)
"Stop suppression of ARTICLE."
- (let* ((header (gnus-data-header (gnus-data-find article)))
- (id (when header (mail-header-id header))))
- (when id
+ (let (header id)
+ (when (and gnus-dup-hashtb
+ (setq header (gnus-data-header (gnus-data-find article)))
+ (setq id (mail-header-id header)))
(setq gnus-dup-list-dirty t)
(setq gnus-dup-list (delete id gnus-dup-list))
(remhash id gnus-dup-hashtb))))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index f1202e1..b1e4091 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1320,7 +1320,7 @@ if it is a string, only list groups matching REGEXP."
gnus-group-listed-groups)
;; List living groups, according to order in `gnus-group-list'.
(dolist (g (cdr gnus-group-list))
- (setq info (nth 1 (gethash g gnus-newsrc-hashtb))
+ (setq info (gnus-get-info g)
group (gnus-info-group info)
params (gnus-info-params info)
unread (gnus-group-unread group))
@@ -1389,39 +1389,35 @@ if it is a string, only list groups matching REGEXP."
;; List zombies and killed lists somewhat faster, which was
;; suggested by Jack Vinson <address@hidden>. It does
;; this by ignoring the group format specification altogether.
- (let (group)
- (if (> (length groups) gnus-group-listing-limit)
- (while groups
- (setq group (pop groups))
- (when (gnus-group-prepare-logic
- group
- (or (not regexp)
- (and (stringp regexp) (string-match regexp group))
- (and (functionp regexp) (funcall regexp group))))
- (add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-decoded-name group)
- "\n"))
- (list 'gnus-group (gethash group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))
- (while groups
- (setq group (pop groups))
+ (if (nthcdr gnus-group-listing-limit groups)
+ (dolist (group groups)
(when (gnus-group-prepare-logic
group
- (or (not regexp)
- (and (stringp regexp) (string-match regexp group))
- (and (functionp regexp) (funcall regexp group))))
- (gnus-group-insert-group-line
- group level nil
- (let ((active (gnus-active group)))
- (if active
- (if (zerop (cdr active))
- 0
- (- (1+ (cdr active)) (car active)))
- nil))
- (gnus-method-simplify (gnus-find-method-for-group group))))))))
+ (cond ((not regexp))
+ ((stringp regexp) (string-match-p regexp group))
+ ((functionp regexp) (funcall regexp group))))
+ (add-text-properties
+ (point) (prog1 (1+ (point))
+ (insert " " mark " *: "
+ (gnus-group-decoded-name group)
+ "\n"))
+ (list 'gnus-group group
+ 'gnus-unread t
+ 'gnus-level level))))
+ (dolist (group groups)
+ (when (gnus-group-prepare-logic
+ group
+ (cond ((not regexp))
+ ((stringp regexp) (string-match-p regexp group))
+ ((functionp regexp) (funcall regexp group))))
+ (gnus-group-insert-group-line
+ group level nil
+ (let ((active (gnus-active group)))
+ (and active
+ (if (zerop (cdr active))
+ 0
+ (- (cdr active) (car active) -1))))
+ (gnus-method-simplify (gnus-find-method-for-group group)))))))
(defun gnus-group-update-group-line ()
"Update the current line in the group buffer."
@@ -1527,7 +1523,7 @@ if it is a string, only list groups matching REGEXP."
(int-to-string (max 0 (- gnus-tmp-number-total number)))
"*"))
(gnus-tmp-subscribed
- (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
+ (cond ((<= gnus-tmp-level gnus-level-subscribed) ?\s)
((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
((= gnus-tmp-level gnus-level-zombie) ?Z)
(t ?K)))
@@ -1546,7 +1542,7 @@ if it is a string, only list groups matching REGEXP."
(gnus-tmp-moderated
(if (and gnus-moderated-hashtb
(gethash gnus-tmp-group gnus-moderated-hashtb))
- ?m ? ))
+ ?m ?\s))
(gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
(gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
@@ -1560,15 +1556,15 @@ if it is a string, only list groups matching REGEXP."
(if (and (numberp number)
(zerop number)
(cdr (assq 'tick gnus-tmp-marked)))
- ?* ? ))
+ ?* ?\s))
(gnus-tmp-summary-live
(if (and (not gnus-group-is-exiting-p)
(gnus-buffer-live-p (gnus-summary-buffer-name
gnus-tmp-group)))
- ?* ? ))
+ ?* ?\s))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
- gnus-process-mark ? ))
+ gnus-process-mark ?\s))
(buffer-read-only nil)
beg end
gnus-tmp-header) ; passed as parameter to user-funcs.
@@ -1768,10 +1764,8 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer
is not updated."
(defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line."
(let ((group (get-text-property (point-at-bol) 'gnus-group)))
- (when group
- (if (stringp group)
- group
- (symbol-name group)))))
+ (cond ((stringp group) group)
+ (group (symbol-name group)))))
(defun gnus-group-group-level ()
"Get the level of the newsgroup on the current line."
@@ -1791,7 +1785,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is
not updated."
(defun gnus-group-new-mail (group)
(if (nnmail-new-mail-p (gnus-group-real-name group))
gnus-new-mail-mark
- ? ))
+ ?\s))
(defun gnus-group-level (group)
"Return the estimated level of GROUP."
@@ -1881,7 +1875,7 @@ If FIRST-TOO, the current line is also eligible as a
target."
(if unmark
(progn
(setq gnus-group-marked (delete group gnus-group-marked))
- (insert-char ? 1 t))
+ (insert-char ?\s 1 t))
(setq gnus-group-marked
(cons group (delete group gnus-group-marked)))
(insert-char gnus-process-mark 1 t)))
@@ -2173,30 +2167,23 @@ Non-ASCII group names are allowed. The arguments are
the same as
they are omitted. Can handle COLLECTION as a list, hash table,
or vector."
(or collection (setq collection gnus-active-hashtb))
- (let (choices group)
- (cond ((listp collection)
- (if (symbolp (car collection))
- (dolist (symbol collection)
- (setq group (symbol-name symbol))
- (push (if (string-match "[^\000-\177]" group)
- (gnus-group-decoded-name group)
- group)
- choices))
- (setq choices collection)))
- ((vectorp collection)
- (mapatoms (lambda (symbol)
- (setq group (symbol-name symbol))
- (push (if (string-match "[^\000-\177]" group)
- (gnus-group-decoded-name group)
- group)
- choices))
- collection))
- ((hash-table-p collection)
- (setq choices (hash-table-keys collection))))
- (setq group (gnus-completing-read (or prompt "Group") (reverse choices)
- require-match initial-input
- (or hist 'gnus-group-history)
- def))
+ (let* ((choices
+ (mapcar
+ (lambda (g)
+ (if (string-match "[^\000-\177]" g)
+ (gnus-group-decoded-name g)
+ g))
+ (cond ((listp collection)
+ collection)
+ ((vectorp collection)
+ (mapatoms #'symbol-name collection))
+ ((hash-table-p collection)
+ (hash-table-keys collection)))))
+ (group
+ (gnus-completing-read (or prompt "Group") (reverse choices)
+ require-match initial-input
+ (or hist 'gnus-group-history)
+ def)))
(unless (cond ((and (listp collection)
(symbolp (car collection)))
(member group (mapcar 'symbol-name collection)))
@@ -2283,7 +2270,8 @@ Return the name of the group if selection was successful."
(nnheader-init-server-buffer)
;; Necessary because of funky inlining.
(require 'gnus-cache)
- (setq gnus-newsrc-hashtb (gnus-make-hashtable 100)))
+ (setq gnus-newsrc-hashtb (gnus-make-hashtable 100)
+ gnus-active-hashtb (gnus-make-hashtable 100)))
;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
@@ -2566,7 +2554,11 @@ If FAR, it is likely that the group is not on the
current line.
If TEST-MARKED, the line must be marked."
(when group
(let ((start (point))
- (active (and (gethash group gnus-active-hashtb)
+ (active (and (or
+ ;; Some kind of group may be only there.
+ (gnus-active group)
+ ;; All groups (but with exception) are there.
+ (gnus-group-entry group))
group)))
(beginning-of-line)
(cond
@@ -4015,21 +4007,15 @@ entail asking the server for the groups."
(gnus-agent gnus-plugged)); If we're actually plugged, store the
active file in the agent.
(gnus-read-active-file)))
;; Find all groups and sort them.
- (let ((groups
- (sort
- (hash-table-keys gnus-active-hashtb)
- 'string<))
- (buffer-read-only nil)
- group)
+ (let ((buffer-read-only nil))
(erase-buffer)
- (while groups
- (setq group (pop groups))
+ (dolist (group (sort (hash-table-keys gnus-active-hashtb) #'string<))
(add-text-properties
(point) (prog1 (1+ (point))
(insert " *: "
(gnus-group-decoded-name group)
"\n"))
- (list 'gnus-group (gethash group gnus-active-hashtb)
+ (list 'gnus-group group
'gnus-unread t
'gnus-level (inline (gnus-group-level group)))))
(goto-char (point-min))))
@@ -4151,20 +4137,19 @@ If DONT-SCAN is non-nil, scan non-activated groups as
well."
(when (not (or gnus-description-hashtb
(gnus-read-all-descriptions-files)))
(error "Couldn't request descriptions file"))
- (let ((buffer-read-only nil)
- (groups (sort (hash-table-keys gnus-description-hashtb)))
- b)
+ (let ((buffer-read-only nil))
(erase-buffer)
- (dolist (group groups)
- (setq b (point))
- (let ((charset (gnus-group-name-charset nil group)))
+ (dolist (group (sort (hash-table-keys gnus-description-hashtb) #'string<))
+ (let ((b (point))
+ (desc (gethash group gnus-description-hashtb))
+ (charset (gnus-group-name-charset nil group)))
(insert (format " *: %-20s %s\n"
(gnus-group-name-decode group charset)
- (gnus-group-name-decode group charset))))
- (add-text-properties
- b (1+ b) (list 'gnus-group (intern group gnus-description-hashtb)
- 'gnus-unread t 'gnus-marked nil
- 'gnus-level (1+ gnus-level-subscribed))))
+ (gnus-group-name-decode desc charset)))
+ (add-text-properties
+ b (1+ b) (list 'gnus-group group
+ 'gnus-unread t 'gnus-marked nil
+ 'gnus-level (1+ gnus-level-subscribed)))))
(goto-char (point-min))
(gnus-group-position-point)))
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 062dd1b..28020a1 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -1,4 +1,4 @@
-;;; gnus-icalendar.el --- reply to iCalendar meeting requests
+;;; gnus-icalendar.el --- reply to iCalendar meeting requests -*-
lexical-binding:t -*-
;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
@@ -244,7 +244,7 @@
(map-property ical-property))
args)))))
(mapc #'accumulate-args prop-map)
- (apply 'make-instance event-class args))))
+ (apply #'make-instance event-class args))))
(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email)
"Parse RFC5545 iCalendar in buffer BUF and return an event object.
@@ -301,7 +301,8 @@ status will be retrieved from the first matching attendee
record."
((string= key "DTSTAMP") (update-dtstamp))
((member key '("ORGANIZER" "DTSTART" "DTEND"
"LOCATION" "DURATION" "SEQUENCE"
- "RECURRENCE-ID" "UID")) line)
+ "RECURRENCE-ID" "UID"))
+ line)
(t nil))))
(when new-line
(push new-line reply-event-lines))))))
@@ -352,9 +353,9 @@ on the IDENTITIES list."
;;;
;;; gnus-icalendar-org
-;;;
-;;; TODO: this is an optional feature, and it's only available with org-mode
-;;; 7+, so will need to properly handle emacsen with no/outdated org-mode
+;;
+;; TODO: this is an optional feature, and it's only available with org-mode
+;; 7+, so will need to properly handle emacsen with no/outdated org-mode
(require 'org)
(require 'org-capture)
@@ -367,23 +368,19 @@ on the IDENTITIES list."
(defcustom gnus-icalendar-org-capture-file nil
"Target Org file for storing captured calendar events."
- :type '(choice (const nil) file)
- :group 'gnus-icalendar-org)
+ :type '(choice (const nil) file))
(defcustom gnus-icalendar-org-capture-headline nil
"Target outline in `gnus-icalendar-org-capture-file' for storing captured
events."
- :type '(repeat string)
- :group 'gnus-icalendar-org)
+ :type '(repeat string))
(defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org"
"Org-mode template name."
- :type '(string)
- :group 'gnus-icalendar-org)
+ :type '(string))
(defcustom gnus-icalendar-org-template-key "#"
"Org-mode template hotkey."
- :type '(string)
- :group 'gnus-icalendar-org)
+ :type '(string))
(defvar gnus-icalendar-org-enabled-p nil)
@@ -662,7 +659,7 @@ is searched."
(gnus-icalendar--update-org-event event reply-status)
(gnus-icalendar:org-event-save event reply-status)))
-(cl-defmethod gnus-icalendar-event:sync-to-org ((event
gnus-icalendar-event-cancel) reply-status)
+(cl-defmethod gnus-icalendar-event:sync-to-org ((event
gnus-icalendar-event-cancel) _reply-status)
(when (gnus-icalendar-find-org-event-file event)
(gnus-icalendar--cancel-org-event event)))
@@ -685,8 +682,7 @@ is searched."
(defcustom gnus-icalendar-reply-bufname "*CAL*"
"Buffer used for building iCalendar invitation reply."
- :type '(string)
- :group 'gnus-icalendar)
+ :type '(string))
(defcustom gnus-icalendar-additional-identities nil
"We need to know your identity to make replies to calendar requests work.
@@ -702,17 +698,13 @@ Your identity is guessed automatically from the variables
If you need even more aliases you can define them here. It really
only makes sense to define names or email addresses."
- :type '(repeat string)
- :group 'gnus-icalendar)
+ :type '(repeat string))
-(make-variable-buffer-local
- (defvar gnus-icalendar-reply-status nil))
+(defvar-local gnus-icalendar-reply-status nil)
-(make-variable-buffer-local
- (defvar gnus-icalendar-event nil))
+(defvar-local gnus-icalendar-event nil)
-(make-variable-buffer-local
- (defvar gnus-icalendar-handle nil))
+(defvar-local gnus-icalendar-handle nil)
(defun gnus-icalendar-identities ()
"Return list of regexp-quoted names and email addresses belonging to the
user.
@@ -738,7 +730,8 @@ These will be used to retrieve the RSVP information from
ical events."
(cadr x))))
(with-slots (organizer summary description location recur uid
- method rsvp participation-type) event
+ method rsvp participation-type)
+ event
(let ((headers `(("Summary" ,summary)
("Location" ,(or location ""))
("Time" ,(gnus-icalendar-event:org-timestamp event))
@@ -844,7 +837,7 @@ These will be used to retrieve the RSVP information from
ical events."
("Tentative" gnus-icalendar-reply (,handle tentative ,event))
("Decline" gnus-icalendar-reply (,handle declined ,event)))))
-(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event
gnus-icalendar-event-reply) handle)
+(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event
gnus-icalendar-event-reply) _handle)
"No buttons for REPLY events."
nil)
@@ -853,7 +846,7 @@ These will be used to retrieve the RSVP information from
ical events."
(gnus-icalendar--get-org-event-reply-status event))
"Not replied yet"))
-(cl-defmethod gnus-icalendar-event:inline-reply-status ((event
gnus-icalendar-event-reply))
+(cl-defmethod gnus-icalendar-event:inline-reply-status ((_event
gnus-icalendar-event-reply))
"No reply status for REPLY events."
nil)
@@ -880,7 +873,7 @@ These will be used to retrieve the RSVP information from
ical events."
(when org-entry-exists-p
`("Show Org Entry" gnus-icalendar--show-org-event ,event))))))
-
+;;;###autoload
(defun gnus-icalendar-mm-inline (handle)
(let ((event (gnus-icalendar-event-from-handle handle
(gnus-icalendar-identities))))
@@ -892,7 +885,7 @@ These will be used to retrieve the RSVP information from
ical events."
(buttons)
(when buttons
(mapc (lambda (x)
- (apply 'gnus-icalendar-insert-button x)
+ (apply #'gnus-icalendar-insert-button x)
(insert " "))
buttons)
(insert "\n\n"))))
@@ -973,6 +966,9 @@ These will be used to retrieve the RSVP information from
ical events."
(defvar gnus-mime-action-alist) ; gnus-art
(defun gnus-icalendar-setup ()
+ ;; FIXME: Get rid of this!
+ ;; The three add-to-list are now redundant (good), but I think the rest
+ ;; is still not automatically setup.
(add-to-list 'mm-inlined-types "text/calendar")
(add-to-list 'mm-automatic-display "text/calendar")
(add-to-list 'mm-inline-media-tests '("text/calendar"
gnus-icalendar-mm-inline identity))
@@ -987,7 +983,7 @@ These will be used to retrieve the RSVP information from
ical events."
(require 'gnus-art)
(add-to-list 'gnus-mime-action-alist
- (cons "save calendar event" 'gnus-icalendar-save-event)
+ (cons "save calendar event" #'gnus-icalendar-save-event)
t))
(provide 'gnus-icalendar)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 82141e0..2beb685 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2145,9 +2145,15 @@ The info element is shared with the same element of
(condition-case ()
(if (and (stringp (progn
(setq group (read cur)
- group (if (numberp group)
- (number-to-string group)
- (symbol-name group)))))
+ group
+ (encode-coding-string
+ (cond ((numberp group)
+ (number-to-string group))
+ ((symbolp group)
+ (symbol-name group))
+ ((stringp group)
+ group))
+ 'latin-1))))
(numberp (setq max (read cur)))
(numberp (setq min (read cur)))
(null (progn
@@ -2878,7 +2884,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
gnus-variable-list)
(mapcar (lambda (g)
(nth 1 (gethash g gnus-newsrc-hashtb)))
- gnus-group-list))
+ (delete "dummy.group" gnus-group-list)))
;; Insert the variables into the file.
(while variables
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 85c902a..b8aa302 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -27,7 +27,34 @@
(require 'cl-lib)
(defvar tool-bar-mode)
+(defvar gnus-category-predicate-alist)
+(defvar gnus-category-predicate-cache)
+(defvar gnus-inhibit-article-treatments)
+(defvar gnus-inhibit-demon)
+(defvar gnus-tmp-article-number)
+(defvar gnus-tmp-closing-bracket)
+(defvar gnus-tmp-current)
+(defvar gnus-tmp-dummy)
+(defvar gnus-tmp-expirable)
+(defvar gnus-tmp-from)
+(defvar gnus-tmp-group-name)
(defvar gnus-tmp-header)
+(defvar gnus-tmp-indentation)
+(defvar gnus-tmp-level)
+(defvar gnus-tmp-lines)
+(defvar gnus-tmp-number)
+(defvar gnus-tmp-opening-bracket)
+(defvar gnus-tmp-process)
+(defvar gnus-tmp-replied)
+(defvar gnus-tmp-score)
+(defvar gnus-tmp-score-char)
+(defvar gnus-tmp-subject)
+(defvar gnus-tmp-subject-or-nil)
+(defvar gnus-tmp-unread)
+(defvar gnus-tmp-unread-and-unselected)
+(defvar gnus-tmp-unread-and-unticked)
+(defvar gnus-tmp-user-defined)
+(defvar gnus-use-article-prefetch)
(require 'gnus)
(require 'gnus-group)
@@ -784,7 +811,7 @@ score file."
:group 'gnus-score-default
:type 'integer)
-(defun gnus-widget-reversible-match (widget value)
+(defun gnus-widget-reversible-match (_widget value)
"Ignoring WIDGET, convert VALUE to internal form.
VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
;; (debug value)
@@ -794,7 +821,7 @@ VALUE should have the form `FOO' or `(not FOO)', where FOO
is an symbol."
(eq (nth 0 value) 'not)
(symbolp (nth 1 value)))))
-(defun gnus-widget-reversible-to-internal (widget value)
+(defun gnus-widget-reversible-to-internal (_widget value)
"Ignoring WIDGET, convert VALUE to internal form.
VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
@@ -803,7 +830,7 @@ FOO is converted to (FOO nil) and (not FOO) is converted to
(FOO t)."
(list value nil)
(list (nth 1 value) t)))
-(defun gnus-widget-reversible-to-external (widget value)
+(defun gnus-widget-reversible-to-external (_widget value)
"Ignoring WIDGET, convert VALUE to external form.
VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
\(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)."
@@ -1385,7 +1412,8 @@ the normal Gnus MIME machinery."
(?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
?s)
(?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
- gnus-tmp-from) ?s)
+ gnus-tmp-from)
+ ?s)
(?F gnus-tmp-from ?s)
(?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
(?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
@@ -1397,12 +1425,15 @@ the normal Gnus MIME machinery."
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
(?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header))
- 0) ?d)
+ 0)
+ ?d)
(?G (or (nnir-article-group (mail-header-number gnus-tmp-header))
- "") ?s)
+ "")
+ ?s)
(?g (or (gnus-group-short-name
(nnir-article-group (mail-header-number gnus-tmp-header)))
- "") ?s)
+ "")
+ ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1427,7 +1458,8 @@ the normal Gnus MIME machinery."
(?P (gnus-pick-line-number) ?d)
(?B gnus-tmp-thread-tree-header-string ?s)
(user-date (gnus-user-date
- ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
+ ,(macroexpand '(mail-header-date gnus-tmp-header)))
+ ?s))
"An alist of format specifications that can appear in summary lines.
These are paired with what variables they correspond with, along with
the type of the variable (string, integer, character, etc).")
@@ -1672,6 +1704,7 @@ For example:
(eval-when-compile
;; Bind features so that require will believe that gnus-sum has
;; already been loaded (avoids infinite recursion)
+ (with-no-warnings (defvar features)) ;Not just a local variable.
(let ((features (cons 'gnus-sum features)))
(require 'gnus-art)))
@@ -3053,6 +3086,11 @@ When FORCE, rebuild the tool bar."
(defvar bidi-paragraph-direction)
+(defvar gnus-summary-mode-group nil
+ "Variable for communication with `gnus-summary-mode'.
+Allows the `gnus-newsgroup-name' local variable to be set before
+the summary mode hooks are run.")
+
(define-derived-mode gnus-summary-mode gnus-mode "Summary"
"Major mode for reading articles.
\\<gnus-summary-mode-map>
@@ -3102,18 +3140,16 @@ The following commands are available:
(defun gnus-summary-make-local-variables ()
"Make all the local summary buffer variables."
- (let (global)
- (dolist (local gnus-summary-local-variables)
- (if (consp local)
- (progn
- (if (eq (cdr local) 'global)
- ;; Copy the global value of the variable.
- (setq global (symbol-value (car local)))
- ;; Use the value from the list.
- (setq global (eval (cdr local))))
- (set (make-local-variable (car local)) global))
- ;; Simple nil-valued local variable.
- (set (make-local-variable local) nil)))))
+ (dolist (local gnus-summary-local-variables)
+ (if (consp local)
+ (let ((global (if (eq (cdr local) 'global)
+ ;; Copy the global value of the variable.
+ (symbol-value (car local))
+ ;; Use the value from the list.
+ (eval (cdr local)))))
+ (set (make-local-variable (car local)) global))
+ ;; Simple nil-valued local variable.
+ (set (make-local-variable local) nil))))
;; Summary data functions.
@@ -3468,11 +3504,6 @@ display only a single character."
(point)
(current-buffer))))))
-(defvar gnus-summary-mode-group nil
- "Variable for communication with `gnus-summary-mode'.
-Allows the `gnus-newsgroup-name' local variable to be set before
-the summary mode hooks are run.")
-
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer for GROUP.
This function does all setup work that relies on the specific
@@ -3525,13 +3556,12 @@ buffer that was in action when the last article was
fetched."
(score-file gnus-current-score-file)
(default-charset gnus-newsgroup-charset)
vlist)
- (let ((locals gnus-newsgroup-variables))
- (while locals
- (if (consp (car locals))
- (push (eval (caar locals)) vlist)
- (push (eval (car locals)) vlist))
- (setq locals (cdr locals)))
- (setq vlist (nreverse vlist)))
+ (dolist (local gnus-newsgroup-variables)
+ (push (eval (if (consp local) (car local)
+ local)
+ t)
+ vlist))
+ (setq vlist (nreverse vlist))
(with-temp-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
@@ -3546,12 +3576,11 @@ buffer that was in action when the last article was
fetched."
gnus-reffed-article-number reffed
gnus-current-score-file score-file
gnus-newsgroup-charset default-charset)
- (let ((locals gnus-newsgroup-variables))
- (while locals
- (if (consp (car locals))
- (set (caar locals) (pop vlist))
- (set (car locals) (pop vlist)))
- (setq locals (cdr locals))))))))
+ (dolist (local gnus-newsgroup-variables)
+ (set (if (consp local)
+ (car local)
+ local)
+ (pop vlist)))))))
(defun gnus-summary-article-unread-p (article)
"Say whether ARTICLE is unread or not."
@@ -3639,19 +3668,23 @@ buffer that was in action when the last article was
fetched."
pos)))
(setq gnus-summary-mark-positions pos))))
-(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
+(defun gnus-summary-insert-dummy-line (subject number)
"Insert a dummy root in the summary buffer."
(beginning-of-line)
(add-text-properties
- (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
- (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
+ (point) (let ((gnus-tmp-subject subject)
+ (gnus-tmp-number number))
+ (eval gnus-summary-dummy-line-format-spec t)
+ (point))
+ (list 'gnus-number number 'gnus-intangible number)))
(defun gnus-summary-extract-address-component (from)
(or (car (funcall gnus-extract-address-components from))
from))
-(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
- (let ((mail-parse-charset gnus-newsgroup-charset)
+(defun gnus-summary-from-or-to-or-newsgroups (header from)
+ (let ((gnus-tmp-from from)
+ (mail-parse-charset gnus-newsgroup-charset)
;; Is it really necessary to do this next part for each summary line?
;; Luckily, doesn't seem to slow things down much.
(mail-parse-ignored-charsets
@@ -3678,25 +3711,31 @@ buffer that was in action when the last article was
fetched."
(and
(memq 'Newsgroups gnus-extra-headers)
(eq (car (gnus-find-method-for-group
- gnus-newsgroup-name)) 'nntp)
+ gnus-newsgroup-name))
+ 'nntp)
(gnus-group-real-name gnus-newsgroup-name))))
(concat gnus-summary-newsgroup-prefix newsgroups)))))
(bidi-string-mark-left-to-right
(inline
(gnus-summary-extract-address-component gnus-tmp-from))))))
-(defun gnus-summary-insert-line (gnus-tmp-header
- gnus-tmp-level gnus-tmp-current
- undownloaded gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-expirable gnus-tmp-subject-or-nil
- &optional gnus-tmp-dummy gnus-tmp-score
- gnus-tmp-process)
- (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+(defun gnus-summary-insert-line (header level current undownloaded
+ unread replied expirable subject-or-nil
+ &optional dummy score process)
+ (if (>= level (length gnus-thread-indent-array))
(gnus-make-thread-indent-array (max (* 2 (length
gnus-thread-indent-array))
- gnus-tmp-level)))
- (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
+ level)))
+ (let* ((gnus-tmp-header header)
+ (gnus-tmp-level level)
+ (gnus-tmp-current current)
+ (gnus-tmp-unread unread)
+ (gnus-tmp-expirable expirable)
+ (gnus-tmp-subject-or-nil subject-or-nil)
+ (gnus-tmp-dummy dummy)
+ (gnus-tmp-process process)
+ (gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
- (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
+ (gnus-tmp-score (or score gnus-summary-default-score 0))
(gnus-tmp-score-char
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
@@ -3709,7 +3748,7 @@ buffer that was in action when the last article was
fetched."
(cond (gnus-tmp-process gnus-process-mark)
((memq gnus-tmp-current gnus-newsgroup-cached)
gnus-cached-mark)
- (gnus-tmp-replied gnus-replied-mark)
+ (replied gnus-replied-mark)
((memq gnus-tmp-current gnus-newsgroup-forwarded)
gnus-forwarded-mark)
((memq gnus-tmp-current gnus-newsgroup-saved)
@@ -4461,7 +4500,7 @@ Returns HEADER if it was entered in the DEPENDENCIES.
Returns nil otherwise."
;; build complete threads - if the roots haven't been expired by the
;; server, that is.
(let ((mail-parse-charset gnus-newsgroup-charset)
- id heads)
+ heads)
(maphash
(lambda (id refs)
(when (not (car refs))
@@ -4485,7 +4524,6 @@ Returns HEADER if it was entered in the DEPENDENCIES.
Returns nil otherwise."
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
(let ((eol (point-at-eol))
- (buffer (current-buffer))
header references in-reply-to)
;; overview: [num subject from date id refs chars lines misc]
@@ -4750,7 +4788,8 @@ If LINE, insert the rebuilt thread starting on line LINE."
(defun gnus-id-to-thread (id)
"Return the (sub-)thread where ID appears."
- (gethash id gnus-newsgroup-dependencies))
+ (when (hash-table-p gnus-newsgroup-dependencies)
+ (gethash id gnus-newsgroup-dependencies)))
(defun gnus-id-to-article (id)
"Return the article number of ID."
@@ -4939,8 +4978,16 @@ Note that THREAD must never, ever be anything else than
a variable -
using some other form will lead to serious barfage."
(or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
- (vector thread) 2))
+ (cond
+ ((and (boundp 'lexical-binding) lexical-binding)
+ ;; FIXME: This version could be a "defsubst" rather than a macro.
+ `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207"
+ [] 2]
+ ,thread))
+ (t
+ ;; Not sure how XEmacs handles these things, so let's keep the old code.
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
+ (vector thread) 2))))
(defsubst gnus-article-sort-by-number (h1 h2)
"Sort articles by article number."
@@ -5971,7 +6018,7 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
- marks var articles article mark mark-type
+ var articles article mark mark-type
bgn end)
;; Hack to avoid adjusting marks for imap.
(when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
@@ -6233,7 +6280,7 @@ The resulting hash table is returned, or nil if no Xrefs
were found."
(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (gnus-virtual-group-p from-newsgroup))
- name info xref-hashtb idlist method nth4)
+ name info xref-hashtb method nth4)
(with-current-buffer gnus-group-buffer
(when (setq xref-hashtb
(gnus-create-xref-hashtb from-newsgroup headers unreads))
@@ -7487,7 +7534,7 @@ The state which existed when entering the ephemeral is
reset."
(with-current-buffer buffer
(gnus-deaden-summary))))))
-(defun gnus-summary-wake-up-the-dead (&rest args)
+(defun gnus-summary-wake-up-the-dead (&rest _)
"Wake up the dead summary buffer."
(interactive)
(gnus-dead-summary-mode -1)
@@ -7713,6 +7760,12 @@ Given a prefix, will force an `article' buffer
configuration."
(gnus-article-setup-buffer))
(gnus-set-global-variables)
(with-current-buffer gnus-article-buffer
+ ;; The buffer may be non-empty and even narrowed, so go back to
+ ;; a sane state.
+ (widen)
+ ;; We're going to erase the buffer anyway so do it now: it can save us from
+ ;; uselessly performing multibyte-conversion of the current content.
+ (let ((inhibit-read-only t)) (erase-buffer))
(setq gnus-article-charset gnus-newsgroup-charset)
(setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
(mm-enable-multibyte))
@@ -7744,7 +7797,7 @@ be displayed."
(unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(let ((article (or article (gnus-summary-article-number)))
- (all-headers (not (not all-headers))) ;Must be t or nil.
+ (all-headers (and all-headers t)) ; Must be t or nil.
gnus-summary-display-article-function)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
@@ -7856,7 +7909,7 @@ If BACKWARD, the previous article is selected instead of
the next."
(gnus-summary-walk-group-buffer
gnus-newsgroup-name cmd unread backward point))))))))
-(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
+(defun gnus-summary-walk-group-buffer (_from-group cmd unread backward start)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(?\C-p (gnus-group-prev-unread-group 1))))
(cursor-in-echo-area t)
@@ -8150,7 +8203,7 @@ score higher than the default score."
"Select the first unread subject that has a score over the default score."
(interactive)
(let ((data gnus-newsgroup-data)
- article score)
+ article)
(while (and (setq article (gnus-data-number (car data)))
(or (gnus-data-read-p (car data))
(not (> (gnus-summary-article-score article)
@@ -8563,7 +8616,7 @@ If UNREPLIED (the prefix), limit to unreplied articles."
(gnus-summary-limit gnus-newsgroup-replied))
(gnus-summary-position-point))
-(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
+(defun gnus-summary-limit-exclude-marks (marks &optional _reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
If REVERSE, limit the summary buffer to articles that are marked
with MARKS. MARKS can either be a string of marks or a list of marks.
@@ -8865,7 +8918,7 @@ fetch-old-headers verbiage, and so on."
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit nil)
(maphash
- (lambda (id deps)
+ (lambda (_id deps)
(unless (car deps)
;; These threads have no parents -- they are roots.
(let ((nodes (cdr deps))
@@ -9523,6 +9576,9 @@ fetched headers for, whether they are displayed or not."
(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search t))
(dolist (header gnus-newsgroup-headers)
+ ;; FIXME: when called from gnus-summary-limit-include-thread via
+ ;; gnus-summary-limit-include-matching-articles, `regexp' is a decoded
+ ;; string whereas the header isn't decoded.
(when (string-match regexp (funcall func header))
(push (mail-header-number header) articles)))
(nreverse articles)))
@@ -9537,7 +9593,7 @@ be taken into consideration. If NOT-CASE-FOLD, case
won't be folded
in the comparisons. If NOT-MATCHING, return a list of all articles that
not match REGEXP on HEADER."
(let ((case-fold-search (not not-case-fold))
- articles d func)
+ articles func)
(if (consp header)
(if (eq (car header) 'extra)
(setq func
@@ -9657,6 +9713,10 @@ to save in."
(gnus-summary-remove-process-mark article))
(ps-despool filename))
+(defvar ps-right-header)
+(defvar ps-left-header)
+(defvar shr-ignore-cache)
+
(defun gnus-print-buffer ()
(let ((ps-left-header
(list
@@ -9882,7 +9942,7 @@ prefix specifies how many places to rotate each letter
forward."
;; Create buttons and stuff...
(gnus-treat-article nil))
-(defun gnus-summary-idna-message (&optional arg)
+(defun gnus-summary-idna-message (&optional _arg)
"Decode IDNA encoded domain names in the current articles.
IDNA encoded domain names looks like `xn--bar'. If a string
remain unencoded after running this function, it is likely an
@@ -9890,7 +9950,7 @@ invalid IDNA string (`xn--bar' is invalid).
You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/')
installed for this command to work."
- (interactive "P")
+ (interactive)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9902,9 +9962,9 @@ installed for this command to work."
(replace-match (puny-decode-domain (match-string 1))))
(set-window-start (get-buffer-window (current-buffer)) start))))))
-(defun gnus-summary-morse-message (&optional arg)
+(defun gnus-summary-morse-message (&optional _arg)
"Morse decode the current article."
- (interactive "P")
+ (interactive)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9962,11 +10022,11 @@ ACTION can be either `move' (the default), `crosspost'
or `copy'."
(cond ((and (eq action 'move)
(not (gnus-check-backend-function
'request-move-article gnus-newsgroup-name)))
- (error "The current group does not support article moving"))
+ (user-error "The current group does not support article moving"))
((and (eq action 'crosspost)
(not (gnus-check-backend-function
'request-replace-article gnus-newsgroup-name)))
- (error "The current group does not support article editing")))
+ (user-error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
(prefix (if (gnus-check-backend-function
'request-move-article gnus-newsgroup-name)
@@ -9983,8 +10043,7 @@ ACTION can be either `move' (the default), `crosspost'
or `copy'."
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
- (when (and (not to-newsgroup)
- (not select-method))
+ (unless (or to-newsgroup select-method)
(if (and gnus-move-split-methods
(not
(and (memq gnus-current-article articles)
@@ -10029,6 +10088,7 @@ ACTION can be either `move' (the default), `crosspost'
or `copy'."
(or (car select-method)
(gnus-group-decoded-name to-newsgroup))
articles)
+ ;; This `while' is not equivalent to a `dolist' (bug#33653#134).
(while articles
(setq article (pop articles))
;; Set any marks that may have changed in the summary buffer.
@@ -10039,8 +10099,9 @@ ACTION can be either `move' (the default), `crosspost'
or `copy'."
(cond
;; Move the article.
((eq action 'move)
- ;; Remove this article from future suppression.
- (gnus-dup-unsuppress-article article)
+ (when gnus-suppress-duplicates
+ ;; Remove this article from future suppression.
+ (gnus-dup-unsuppress-article article))
(let* ((from-method (gnus-find-method-for-group
gnus-newsgroup-name))
(to-method (or select-method
@@ -10231,7 +10292,7 @@ ACTION can be either `move' (the default), `crosspost'
or `copy'."
to-newsgroup
select-method))
- ;;;!!!Why is this necessary?
+ ;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
(when (eq action 'move)
@@ -10597,7 +10658,7 @@ groups."
(let ((mbl mml-buffer-list))
(setq mml-buffer-list nil)
(let ((rfc2047-quote-decoded-words-containing-tspecials t))
- (mime-to-mml ,'current-handles))
+ (mime-to-mml ',current-handles))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(set (make-local-variable 'mml-buffer-list) mbl1))
@@ -10885,8 +10946,8 @@ the actual number of articles unmarked is returned."
(set var (cons article (symbol-value var)))
(if (memq type '(processable cached replied forwarded recent saved))
(gnus-summary-update-secondary-mark article)
- ;;; !!! This is bogus. We should find out what primary
- ;;; !!! mark we want to set.
+ ;; !!! This is bogus. We should find out what primary
+ ;; !!! mark we want to set.
(gnus-summary-update-mark gnus-del-mark 'unread)))))
(defun gnus-summary-mark-as-expirable (n)
@@ -12015,10 +12076,10 @@ Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'marks reverse))
-(defun gnus-summary-sort-by-original (&optional reverse)
+(defun gnus-summary-sort-by-original (&optional _reverse)
"Sort the summary buffer using the default sorting method.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive)
(let* ((inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
@@ -12344,7 +12405,7 @@ save those articles instead."
(string= to-newsgroup prefix))
(setq to-newsgroup default))
(unless to-newsgroup
- (error "No group name entered"))
+ (user-error "No group name entered"))
(setq encoded (encode-coding-string
to-newsgroup
(gnus-group-name-charset to-method to-newsgroup)))
@@ -12356,7 +12417,7 @@ save those articles instead."
(gnus-activate-group encoded nil nil to-method)
(gnus-subscribe-group encoded))
(error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup))
+ (user-error "No such group: %s" to-newsgroup))
encoded)))
(defvar gnus-summary-save-parts-counter)
@@ -12654,14 +12715,21 @@ If REVERSE, save parts that do not match TYPE."
(c cond)
(list gnus-summary-highlight))
(while list
- (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
- nil))
+ (setcdr c `((,(caar list) ',(cdar list))))
(setq c (cdr c)
list (cdr list)))
- (gnus-byte-compile (list 'lambda nil cond))))))
+ (gnus-byte-compile
+ `(lambda ()
+ (with-no-warnings ;See docstring of gnus-summary-highlight.
+ (defvar score) (defvar default) (defvar default-high)
+ (defvar default-low) (defvar mark) (defvar uncached))
+ ,cond))))))
(defun gnus-summary-highlight-line ()
"Highlight current line according to `gnus-summary-highlight'."
+ (with-no-warnings ;See docstring of gnus-summary-highlight.
+ (defvar score) (defvar default) (defvar default-high) (defvar default-low)
+ (defvar mark) (defvar uncached))
(let* ((beg (point-at-bol))
(article (or (gnus-summary-article-number) gnus-current-article))
(score (or (cdr (assq article
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index dae4b0d..c8b6f0e 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1288,7 +1288,7 @@ called and its result is inserted."
;; According to RFC 822 and its successors, the field name must
;; consist of printable US-ASCII characters other than colon,
;; i.e., decimal 33-56 and 59-126.
- '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>address@hidden|}~]+:"))
+ '(looking-at "[ \t]\\|[][!\"#$%&'()*+,./0-9;<=>address@hidden|}~-]+:"))
"Set this non-nil if the system's mailer runs the header and body together.
\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
The value should be an expression to test whether the problem will
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index b689b51..3f25541 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -190,45 +190,45 @@ before the external MIME handler is invoked."
:group 'mime-display)
(defcustom mm-inline-media-tests
- '(("image/p?jpeg"
+ `(("image/p?jpeg"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'jpeg handle)))
("image/png"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'png handle)))
("image/gif"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'gif handle)))
("image/tiff"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'tiff handle)))
("image/xbm"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'xbm handle)))
("image/x-xbitmap"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'xbm handle)))
("image/xpm"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'xpm handle)))
("image/x-xpixmap"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'xpm handle)))
("image/bmp"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'bmp handle)))
("image/x-portable-bitmap"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(mm-valid-and-fit-image-p 'pbm handle)))
("text/plain" mm-inline-text identity)
("text/enriched" mm-inline-text identity)
@@ -246,13 +246,14 @@ before the external MIME handler is invoked."
("text/x-org" mm-display-org-inline identity)
("text/html"
mm-inline-text-html
- (lambda (handle)
+ ,(lambda (_handle)
mm-text-html-renderer))
("text/x-vcard"
mm-inline-text-vcard
- (lambda (handle)
+ ,(lambda (_handle)
(or (featurep 'vcard)
(locate-library "vcard"))))
+ ("text/calendar" gnus-icalendar-mm-inline identity)
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
("message/partial" mm-inline-partial identity)
@@ -261,13 +262,13 @@ before the external MIME handler is invoked."
("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
("application/zip" mm-archive-dissect-and-inline identity)
("audio/wav" mm-inline-audio
- (lambda (handle)
- (and (or (featurep 'nas-sound) (featurep 'native-sound))
+ ,(lambda (_handle)
+ (and (fboundp 'device-sound-enabled-p)
(device-sound-enabled-p))))
("audio/au"
mm-inline-audio
- (lambda (handle)
- (and (or (featurep 'nas-sound) (featurep 'native-sound))
+ ,(lambda (_handle)
+ (and (fboundp 'device-sound-enabled-p)
(device-sound-enabled-p))))
("application/pgp-signature" ignore identity)
("application/x-pkcs7-signature" ignore identity)
@@ -279,7 +280,7 @@ before the external MIME handler is invoked."
("multipart/related" ignore identity)
("image/.*"
mm-inline-image
- (lambda (handle)
+ ,(lambda (handle)
(and (mm-valid-image-format-p 'imagemagick)
(mm-with-unibyte-buffer
(mm-insert-part handle)
@@ -331,6 +332,7 @@ a list of regexps."
(defcustom mm-automatic-display
'("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim"
+ "text/calendar"
"text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
"message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
"application/emacs-lisp" "application/x-emacs-lisp"
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 8ce0943..1e1d264 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -476,29 +476,32 @@ If MODE is not set, try to find mode automatically."
(mm-decode-string text charset))
(t
text)))
- (require 'font-lock)
- ;; I find font-lock a bit too verbose.
- (let ((font-lock-verbose nil)
- (font-lock-support-mode nil)
+ (let ((font-lock-verbose nil) ; font-lock is a bit too verbose.
(enable-local-variables nil))
- ;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
- ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes.
+ ;; We used to set font-lock-mode-hook to nil to avoid enabling
+ ;; support modes, but now that we use font-lock-ensure, support modes
+ ;; aren't a problem any more. So we could probably get rid of this
+ ;; setting now, but it seems harmless and potentially still useful.
(set (make-local-variable 'font-lock-mode-hook) nil)
(setq buffer-file-name (mm-handle-filename handle))
(with-demoted-errors
- (if mode
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (funcall mode))
+ (if mode
+ (save-window-excursion
+ ;; According to Katsumi Yamaoka <address@hidden>, org-mode
+ ;; requires the buffer to be temporarily displayed here, but
+ ;; I could not reproduce this problem. Furthermore, if
+ ;; there's such a problem, we should fix org-mode rather than
+ ;; use switch-to-buffer which can have undesirable
+ ;; side-effects!
+ ;;(switch-to-buffer (current-buffer))
+ (funcall mode))
(let ((auto-mode-alist
(delq (rassq 'doc-view-mode-maybe auto-mode-alist)
(copy-sequence auto-mode-alist))))
(set-auto-mode)
(setq mode major-mode)))
- ;; The mode function might have already turned on font-lock.
;; Do not fontify if the guess mode is fundamental.
- (unless (or font-lock-mode
- (eq major-mode 'fundamental-mode))
+ (unless (eq major-mode 'fundamental-mode)
(font-lock-ensure))))
(setq text (buffer-string))
(when (eq mode 'diff-mode)
@@ -508,7 +511,7 @@ If MODE is not set, try to find mode automatically."
;; Set buffer unmodified to avoid confirmation when killing the
;; buffer.
(set-buffer-modified-p nil))
- (let ((b (1- (point))))
+ (let ((b (- (point) (save-restriction (widen) (point-min)))))
(mm-insert-inline handle text)
(dolist (ov ovs)
(move-overlay (nth 0 ov) (+ (nth 1 ov) b)
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 8f1217b..532ba11 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -701,7 +701,7 @@ from the document.")
(defun nndoc-lanl-gov-announce-type-p ()
(when (let ((case-fold-search nil))
- (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?:
[a-zA-Z-\\.]+/[0-9]+\\|arXiv:\\)" nil t))
+ (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?:
[a-zA-Z\\.-]+/[0-9]+\\|arXiv:\\)" nil t))
t))
(defun nndoc-transform-lanl-gov-announce (article)
@@ -732,7 +732,7 @@ from the document.")
(save-restriction
(narrow-to-region (car entry) (nth 1 entry))
(goto-char (point-min))
- (when (looking-at "^\\(Paper.*: \\|arXiv:\\)\\([0-9a-zA-Z-\\./]+\\)")
+ (when (looking-at "^\\(Paper.*: \\|arXiv:\\)\\([0-9a-zA-Z\\./-]+\\)")
(setq subject (concat " (" (match-string 2) ")"))
(when (re-search-forward "^From: \\(.*\\)" nil t)
(setq from (concat "<"
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index a95cdb4..b6dbbea 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -663,7 +663,7 @@ nn*-request-list should have been called before calling
this function."
(narrow-to-region (point) (point-at-eol))
(setq group (read buffer))
(unless (stringp group)
- (setq group (symbol-name group)))
+ (setq group (encode-coding-string (symbol-name group) 'latin-1)))
(if (and (numberp (setq max (read buffer)))
(numberp (setq min (read buffer))))
(push (list group (cons min max))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 5770777..205e9e4 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -259,7 +259,7 @@ non-nil.")
(t
(nnheader-re-read-dir nnml-current-directory)
(nnmail-activate 'nnml)
- (let ((active (nth 1 (assoc group nnml-group-alist))))
+ (let ((active (nth 1 (assoc-string group nnml-group-alist))))
(if (not active)
(nnheader-report 'nnml "No such group: %s" decoded)
(nnheader-report 'nnml "Selected group %s" decoded)
@@ -295,7 +295,7 @@ non-nil.")
(nnheader-report 'nnml "%s is a file"
(directory-file-name (nnml-group-pathname group
nil server))))
- ((assoc group nnml-group-alist)
+ ((assoc-string group nnml-group-alist)
t)
(t
(let (active)
@@ -379,7 +379,7 @@ non-nil.")
(nnml-nov-delete-article group number))
(push number rest)))
(push number rest)))
- (let ((active (nth 1 (assoc group nnml-group-alist))))
+ (let ((active (nth 1 (assoc-string group nnml-group-alist))))
(when active
(setcar active (or (and active-articles
(apply 'min active-articles))
@@ -520,7 +520,7 @@ non-nil.")
(nnheader-report 'nnml "No such directory: %s/" file))
;; Remove the group from all structures.
(setq nnml-group-alist
- (delq (assoc group nnml-group-alist) nnml-group-alist)
+ (delq (assoc-string group nnml-group-alist) nnml-group-alist)
nnml-current-group nil
nnml-current-directory nil)
;; Save the active file.
@@ -549,7 +549,7 @@ non-nil.")
(when (<= (length (directory-files old-dir)) 2)
(ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nnml-group-alist)))
+ (let ((entry (assoc-string group nnml-group-alist)))
(when entry
(setcar entry new-name))
(setq nnml-current-directory nil
@@ -597,7 +597,7 @@ non-nil.")
(when (setq path (nnml-article-to-file article))
(when (file-writable-p path)
(or (not nnmail-keep-last-article)
- (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
+ (not (eq (cdr (nth 1 (assoc-string group nnml-group-alist)))
article)))))))
;; Find an article number in the current group given the Message-ID.
@@ -742,7 +742,7 @@ article number. This function is called narrowed to an
article."
"Compute the next article number in GROUP on SERVER."
(let* ((encoded (if nnmail-group-names-not-encoded-p
(nnml-encoded-group-name group server)))
- (active (cadr (assoc (or encoded group) nnml-group-alist))))
+ (active (cadr (assoc-string (or encoded group) nnml-group-alist))))
;; The group wasn't known to nnml, so we just create an active
;; entry for it.
(unless active
@@ -783,7 +783,7 @@ article number. This function is called narrowed to an
article."
(cdr nnml-incremental-nov-buffer-alist)))))
(defun nnml-open-incremental-nov (group)
- (or (cdr (assoc group nnml-incremental-nov-buffer-alist))
+ (or (cdr (assoc-string group nnml-incremental-nov-buffer-alist))
(let ((buffer (nnml-get-nov-buffer group t)))
(push (cons group buffer) nnml-incremental-nov-buffer-alist)
buffer)))
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 7f2accc..0bfecb2 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -340,10 +340,10 @@ for decoding when the cdr that the data specify is not
available.")
(let (elem)
;; There may be two or more entries in `nnrss-group-alist' since
;; this function didn't delete them formerly.
- (while (setq elem (assoc group nnrss-group-alist))
+ (while (setq elem (assoc-string group nnrss-group-alist))
(setq nnrss-group-alist (delq elem nnrss-group-alist))))
(setq nnrss-server-data
- (delq (assoc group nnrss-server-data) nnrss-server-data))
+ (delq (assoc-string group nnrss-server-data) nnrss-server-data))
(nnrss-save-server-data server)
(ignore-errors
(let ((file-name-coding-system nnmail-pathname-coding-system))
@@ -367,7 +367,7 @@ for decoding when the cdr that the data specify is not
available.")
(with-current-buffer nntp-server-buffer
(erase-buffer)
(dolist (group groups)
- (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data)))
+ (let ((elem (assoc-string (gnus-group-decoded-name group)
nnrss-server-data)))
(insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
'active))
@@ -539,7 +539,7 @@ which RSS 2.0 allows."
(if (hash-table-p nnrss-group-hashtb)
(clrhash nnrss-group-hashtb)
(setq nnrss-group-hashtb (make-hash-table :test 'equal)))
- (let ((pair (assoc group nnrss-server-data)))
+ (let ((pair (assoc-string group nnrss-server-data)))
(setq nnrss-group-max (or (cadr pair) 0))
(setq nnrss-group-min (+ nnrss-group-max 1)))
(let ((file (nnrss-make-filename group server))
@@ -644,8 +644,8 @@ which RSS 2.0 allows."
(concat group ".xml"))
nnrss-directory))))
(setq xml (nnrss-fetch file t))
- (setq url (or (nth 2 (assoc group nnrss-server-data))
- (cadr (assoc group nnrss-group-alist))))
+ (setq url (or (nth 2 (assoc-string group nnrss-server-data))
+ (cadr (assoc-string group nnrss-group-alist))))
(unless url
(setq url
(cdr
@@ -653,7 +653,7 @@ which RSS 2.0 allows."
(nnrss-discover-feed
(read-string
(format "URL to search for %s: " group) "http://";)))))
- (let ((pair (assoc group nnrss-server-data)))
+ (let ((pair (assoc-string group nnrss-server-data)))
(if pair
(setcdr (cdr pair) (list url))
(push (list group nnrss-group-max url) nnrss-server-data)))
@@ -721,7 +721,7 @@ which RSS 2.0 allows."
(setq extra nil))
(when changed
(nnrss-save-group-data group server)
- (let ((pair (assoc group nnrss-server-data)))
+ (let ((pair (assoc-string group nnrss-server-data)))
(if pair
(setcar (cdr pair) nnrss-group-max)
(push (list group nnrss-group-max) nnrss-server-data)))
@@ -792,7 +792,7 @@ It is useful when `(setq nnrss-use-local t)'."
(insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
(dolist (elem nnrss-server-data)
(let ((url (or (nth 2 elem)
- (cadr (assoc (car elem) nnrss-group-alist)))))
+ (cadr (assoc-string (car elem) nnrss-group-alist)))))
(insert "$WGET -q -O \"$RSSDIR\"/'"
(nnrss-translate-file-chars (concat (car elem) ".xml"))
"' '" url "'\n"))))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 06b4ec8..50d69e7 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -40,7 +40,21 @@
"List of functions to run in help buffer in `describe-function'.
Those functions will be run after the header line and argument
list was inserted, and before the documentation will be inserted.
-The functions will receive the function name as argument.")
+The functions will receive the function name as argument.
+They can assume that a newline was output just before they were called,
+and they should terminate any of their own output with a newline.
+By convention they should indent their output by 2 spaces.")
+
+(defvar help-fns-describe-variable-functions nil
+ "List of functions to run in help buffer in `describe-variable'.
+Those functions will be run after the header line and value was inserted,
+and before the documentation will be inserted.
+The functions will receive the variable name as argument.
+They can assume that a newline was output just before they were called,
+and they should terminate any of their own output with a newline.
+By convention they should indent their output by 2 spaces.
+Current buffer is the buffer in which we queried the variable,
+and the output should go to `standard-output'.")
;; Functions
@@ -412,7 +426,7 @@ suitable file is found, return nil."
(defun help-fns--compiler-macro (function)
(let ((handler (function-get function 'compiler-macro)))
(when handler
- (insert "\nThis function has a compiler macro")
+ (insert " This function has a compiler macro")
(if (symbolp handler)
(progn
(insert (format-message " `%s'" handler))
@@ -486,7 +500,7 @@ suitable file is found, return nil."
(get function
'derived-mode-parent))))
(when parent-mode
- (insert (substitute-command-keys "\nParent mode: `"))
+ (insert (substitute-command-keys " Parent mode: `"))
(let ((beg (point)))
(insert (format "%s" parent-mode))
(make-text-button beg (point)
@@ -500,15 +514,15 @@ suitable file is found, return nil."
(get function 'byte-obsolete-info)))
(use (car obsolete)))
(when obsolete
- (insert "\nThis "
+ (insert " This "
(if (eq (car-safe (symbol-function function)) 'macro)
"macro"
"function")
" is obsolete")
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
- (insert (cond ((stringp use) (concat ";\n" use))
- (use (format-message ";\nuse `%s' instead." use))
+ (insert (cond ((stringp use) (concat ";\n " use))
+ (use (format-message ";\n use `%s' instead." use))
(t "."))
"\n"))))
@@ -538,17 +552,65 @@ FILE is the file where FUNCTION was probably defined."
(memq function
byte-compile-interactive-only-functions)))))
(when interactive-only
- (insert "\nThis function is for interactive use only"
+ (insert " This function is for interactive use only"
;; Cf byte-compile-form.
(cond ((stringp interactive-only)
- (format ";\nin Lisp code %s" interactive-only))
+ (format ";\n in Lisp code %s" interactive-only))
((and (symbolp 'interactive-only)
(not (eq interactive-only t)))
- (format-message ";\nin Lisp code use `%s' instead."
+ (format-message ";\n in Lisp code use `%s' instead."
interactive-only))
(t "."))
"\n")))))
+(add-hook 'help-fns-describe-function-functions #'help-fns--side-effects)
+(defun help-fns--side-effects (function)
+ (when (and (symbolp function)
+ (or (function-get function 'pure)
+ (function-get function 'side-effect-free)))
+ (insert " This function does not change global state, "
+ "including the match data.\n")))
+
+(defun help-fns--first-release (symbol)
+ "Return the likely first release that defined SYMBOL."
+ ;; Code below relies on the etc/NEWS* files.
+ ;; FIXME: Maybe we should also use the */ChangeLog* files when available.
+ ;; FIXME: Maybe we should also look for announcements of the addition
+ ;; of the *packages* in which the function is defined.
+ (let* ((name (symbol-name symbol))
+ (re (concat "\\_<" (regexp-quote name) "\\_>"))
+ (news (directory-files data-directory t "\\`NEWS.[1-9]"))
+ (first nil))
+ (with-temp-buffer
+ (dolist (f news)
+ (erase-buffer)
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (search-forward "\n*")
+ (while (re-search-forward re nil t)
+ (save-excursion
+ ;; Almost all entries are of the form "* ... in Emacs NN.MM."
+ ;; but there are also a few in the form "* Emacs NN.MM is a bug
+ ;; fix release ...".
+ (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)"
+ nil t))
+ (message "Ref found in non-versioned section in %S"
+ (file-name-nondirectory f))
+ (let ((version (match-string 1)))
+ (when (or (null first) (version< version first))
+ (setq first version))))))))
+ first))
+
+(add-hook 'help-fns-describe-function-functions
+ #'help-fns--mention-first-release)
+(add-hook 'help-fns-describe-variable-functions
+ #'help-fns--mention-first-release)
+(defun help-fns--mention-first-release (object)
+ (let ((first (if (symbolp object) (help-fns--first-release object))))
+ (when first
+ (princ (format " Probably introduced at or before Emacs version %s.\n"
+ first)))))
+
(defun help-fns-short-filename (filename)
(let* ((abbrev (abbreviate-file-name filename))
(short abbrev))
@@ -611,9 +673,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(memq (car-safe def) '(macro lambda closure)))
(stringp file-name)
(help-fns--autoloaded-p function file-name))
- (if (commandp def)
- "an interactive autoloaded "
- "an autoloaded ")
+ (concat
+ "an autoloaded " (if (commandp def)
+ "interactive "))
(if (commandp def) "an interactive " "a "))))
;; Print what kind of function-like object FUNCTION is.
@@ -627,14 +689,16 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(aliased
(format-message "an alias for `%s'" real-def))
((subrp def)
- (if (eq 'unevalled (cdr (subr-arity def)))
- (concat beg "special form")
- (concat beg "built-in function")))
+ (concat beg (if (eq 'unevalled (cdr (subr-arity def)))
+ "special form"
+ "built-in function")))
((autoloadp def)
- (format "%s autoloaded %s"
- (if (commandp def) "an interactive" "an")
- (if (eq (nth 4 def) 'keymap) "keymap"
- (if (nth 4 def) "Lisp macro" "Lisp function"))))
+ (format "an autoloaded %s"
+ (cond
+ ((commandp def) "interactive Lisp function")
+ ((eq (nth 4 def) 'keymap) "keymap")
+ ((nth 4 def) "Lisp macro")
+ (t "Lisp function"))))
((or (eq (car-safe def) 'macro)
;; For advised macros, def is a lambda
;; expression or a byte-code-function-p, so we
@@ -685,6 +749,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(help-xref-button 1 'help-function-def function file-name))))
(princ "."))))
+(defun help-fns--ensure-empty-line ()
+ (unless (eolp) (insert "\n"))
+ (unless (eq ?\n (char-before (1- (point)))) (insert "\n")))
+
;;;###autoload
(defun describe-function-1 (function)
(let ((pt1 (with-current-buffer (help-buffer) (point))))
@@ -722,12 +790,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
real-function key-bindings-buffer)
;; E.g. an alias for a not yet defined function.
((invalid-function void-function) doc-raw))))
+ (help-fns--ensure-empty-line)
(run-hook-with-args 'help-fns-describe-function-functions function)
- (insert "\n" (or doc "Not documented.")))
- (when (or (function-get function 'pure)
- (function-get function 'side-effect-free))
- (insert "\nThis function does not change global state, "
- "including the match data."))
+ (help-fns--ensure-empty-line)
+ (insert (or doc "Not documented.")))
;; Avoid asking the user annoying questions if she decides
;; to save the help buffer, when her locale's codeset
;; isn't UTF-8.
@@ -830,7 +896,6 @@ it is displayed along with the global value."
(message "You did not specify a variable")
(save-excursion
(let ((valvoid (not (with-current-buffer buffer (boundp variable))))
- (permanent-local (get variable 'permanent-local))
val val-start-pos locus)
;; Extract the value before setting up the output buffer,
;; in case `buffer' *is* the output buffer.
@@ -846,26 +911,26 @@ it is displayed along with the global value."
(prin1 variable)
(setq file-name (find-lisp-object-file-name variable 'defvar))
- (if file-name
- (progn
- (princ (format-message
- " is a variable defined in `%s'.\n"
- (if (eq file-name 'C-source)
- "C source code"
- (file-name-nondirectory file-name))))
- (with-current-buffer standard-output
- (save-excursion
- (re-search-backward (substitute-command-keys
- "`\\([^`']+\\)'")
- nil t)
- (help-xref-button 1 'help-variable-def
- variable file-name)))
- (if valvoid
- (princ "It is void as a variable.")
- (princ "Its ")))
- (if valvoid
- (princ " is void as a variable.")
- (princ (substitute-command-keys "'s ")))))
+ (princ (if file-name
+ (progn
+ (princ (format-message
+ " is a variable defined in `%s'.\n"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (file-name-nondirectory file-name))))
+ (with-current-buffer standard-output
+ (save-excursion
+ (re-search-backward (substitute-command-keys
+ "`\\([^`']+\\)'")
+ nil t)
+ (help-xref-button 1 'help-variable-def
+ variable file-name)))
+ (if valvoid
+ "It is void as a variable."
+ "Its "))
+ (if valvoid
+ " is void as a variable."
+ (substitute-command-keys "'s ")))))
(unless valvoid
(with-current-buffer standard-output
(setq val-start-pos (point))
@@ -894,7 +959,7 @@ it is displayed along with the global value."
(let* ((sv (get variable 'standard-value))
(origval (and (consp sv)
(condition-case nil
- (eval (car sv))
+ (eval (car sv) t)
(error :help-eval-error))))
from)
(when (and (consp sv)
@@ -969,132 +1034,17 @@ it is displayed along with the global value."
(let* ((alias (condition-case nil
(indirect-variable variable)
(error variable)))
- (obsolete (get variable 'byte-obsolete-variable))
- (watchpoints (get-variable-watchers variable))
- (use (car obsolete))
- (safe-var (get variable 'safe-local-variable))
(doc (or (documentation-property
variable 'variable-documentation)
(documentation-property
- alias 'variable-documentation)))
- (extra-line nil))
+ alias 'variable-documentation))))
- ;; Mention if it's a local variable.
- (cond
- ((and (local-variable-if-set-p variable)
- (or (not (local-variable-p variable))
- (with-temp-buffer
- (local-variable-if-set-p variable))))
- (setq extra-line t)
- (princ " Automatically becomes ")
- (if permanent-local
- (princ "permanently "))
- (princ "buffer-local when set.\n"))
- ((not permanent-local))
- ((bufferp locus)
- (setq extra-line t)
- (princ
- (substitute-command-keys
- " This variable's buffer-local value is permanent.\n")))
- (t
- (setq extra-line t)
- (princ (substitute-command-keys
- " This variable's value is permanent \
-if it is given a local binding.\n"))))
-
- ;; Mention if it's an alias.
- (unless (eq alias variable)
- (setq extra-line t)
- (princ (format-message
- " This variable is an alias for `%s'.\n"
- alias)))
-
- (when obsolete
- (setq extra-line t)
- (princ " This variable is obsolete")
- (if (nth 2 obsolete)
- (princ (format " since %s" (nth 2 obsolete))))
- (princ (cond ((stringp use) (concat ";\n " use))
- (use (format-message ";\n use `%s' instead."
- (car obsolete)))
- (t ".")))
- (terpri))
-
- (when watchpoints
- (setq extra-line t)
- (princ " Calls these functions when changed: ")
- (princ watchpoints)
- (terpri))
-
- (when (member (cons variable val)
- (with-current-buffer buffer
- file-local-variables-alist))
- (setq extra-line t)
- (if (member (cons variable val)
- (with-current-buffer buffer
- dir-local-variables-alist))
- (let ((file (and (buffer-file-name buffer)
- (not (file-remote-p
- (buffer-file-name buffer)))
- (dir-locals-find-file
- (buffer-file-name buffer))))
- (is-directory nil))
- (princ (substitute-command-keys
- " This variable's value is directory-local"))
- (when (consp file) ; result from cache
- ;; If the cache element has an mtime, we
- ;; assume it came from a file.
- (if (nth 2 file)
- ;; (car file) is a directory.
- (setq file (dir-locals--all-files (car file)))
- ;; Otherwise, assume it was set directly.
- (setq file (car file)
- is-directory t)))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (princ (substitute-command-keys
- (cond
- (is-directory "for the directory\n `")
- ;; Many files matched.
- ((and (consp file) (cdr file))
- (setq file (file-name-directory (car file)))
- (format "by one of the\n %s files in the
directory\n `"
- dir-locals-file))
- (t (setq file (car file))
- "by the file\n `"))))
- (with-current-buffer standard-output
- (insert-text-button
- file 'type 'help-dir-local-var-def
- 'help-args (list variable file)))
- (princ (substitute-command-keys "'.\n"))))
- (princ (substitute-command-keys
- " This variable's value is file-local.\n"))))
-
- (when (memq variable ignored-local-variables)
- (setq extra-line t)
- (princ " This variable is ignored as a file-local \
-variable.\n"))
-
- ;; Can be both risky and safe, eg auto-fill-function.
- (when (risky-local-variable-p variable)
- (setq extra-line t)
- (princ " This variable may be risky if used as a \
-file-local variable.\n")
- (when (assq variable safe-local-variable-values)
- (princ (substitute-command-keys
- " However, you have added it to \
-`safe-local-variable-values'.\n"))))
-
- (when safe-var
- (setq extra-line t)
- (princ " This variable is safe as a file local variable ")
- (princ "if its value\n satisfies the predicate ")
- (princ (if (byte-code-function-p safe-var)
- "which is a byte-compiled expression.\n"
- (format-message "`%s'.\n" safe-var))))
-
- (if extra-line (terpri))
+ (with-current-buffer buffer
+ (run-hook-with-args 'help-fns-describe-variable-functions
+ variable))
+
+ (with-current-buffer standard-output
+ (help-fns--ensure-empty-line))
(princ "Documentation:\n")
(with-current-buffer standard-output
(insert (or doc "Not documented as a variable."))))
@@ -1121,6 +1071,134 @@ file-local variable.\n")
;; Return the text we displayed.
(buffer-string))))))))
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-safe-local)
+(defun help-fns--var-safe-local (variable)
+ (let ((safe-var (get variable 'safe-local-variable)))
+ (when safe-var
+ (princ " This variable is safe as a file local variable ")
+ (princ "if its value\n satisfies the predicate ")
+ (princ (if (byte-code-function-p safe-var)
+ "which is a byte-compiled expression.\n"
+ (format-message "`%s'.\n" safe-var))))))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-risky)
+(defun help-fns--var-risky (variable)
+ ;; Can be both risky and safe, eg auto-fill-function.
+ (when (risky-local-variable-p variable)
+ (princ " This variable may be risky if used as a \
+file-local variable.\n")
+ (when (assq variable safe-local-variable-values)
+ (princ (substitute-command-keys
+ " However, you have added it to \
+`safe-local-variable-values'.\n")))))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-ignored-local)
+(defun help-fns--var-ignored-local (variable)
+ (when (memq variable ignored-local-variables)
+ (princ " This variable is ignored as a file-local \
+variable.\n")))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-file-local)
+(defun help-fns--var-file-local (variable)
+ (when (boundp variable)
+ (let ((val (symbol-value variable)))
+ (when (member (cons variable val)
+ file-local-variables-alist)
+ (if (member (cons variable val)
+ dir-local-variables-alist)
+ (let ((file (and buffer-file-name
+ (not (file-remote-p buffer-file-name))
+ (dir-locals-find-file buffer-file-name)))
+ (is-directory nil))
+ (princ (substitute-command-keys
+ " This variable's value is directory-local"))
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (princ ".\n")
+ (princ ", set ")
+ (princ (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the
directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
+ (with-current-buffer standard-output
+ (insert-text-button
+ file 'type 'help-dir-local-var-def
+ 'help-args (list variable file)))
+ (princ (substitute-command-keys "'.\n"))))
+ (princ (substitute-command-keys
+ " This variable's value is file-local.\n")))))))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-watchpoints)
+(defun help-fns--var-watchpoints (variable)
+ (let ((watchpoints (get-variable-watchers variable)))
+ (when watchpoints
+ (princ " Calls these functions when changed: ")
+ ;; FIXME: Turn function names into hyperlinks.
+ (princ watchpoints)
+ (terpri))))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-obsolete)
+(defun help-fns--var-obsolete (variable)
+ (let* ((obsolete (get variable 'byte-obsolete-variable))
+ (use (car obsolete)))
+ (when obsolete
+ (princ " This variable is obsolete")
+ (if (nth 2 obsolete)
+ (princ (format " since %s" (nth 2 obsolete))))
+ (princ (cond ((stringp use) (concat ";\n " use))
+ (use (format-message ";\n use `%s' instead."
+ (car obsolete)))
+ (t ".")))
+ (terpri))))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-alias)
+(defun help-fns--var-alias (variable)
+ ;; Mention if it's an alias.
+ (let ((alias (condition-case nil
+ (indirect-variable variable)
+ (error variable))))
+ (unless (eq alias variable)
+ (princ (format-message
+ " This variable is an alias for `%s'.\n"
+ alias)))))
+
+(add-hook 'help-fns-describe-variable-functions #'help-fns--var-bufferlocal)
+(defun help-fns--var-bufferlocal (variable)
+ (let ((permanent-local (get variable 'permanent-local))
+ (locus (variable-binding-locus variable)))
+ ;; Mention if it's a local variable.
+ (cond
+ ((and (local-variable-if-set-p variable)
+ (or (not (local-variable-p variable))
+ (with-temp-buffer
+ (local-variable-if-set-p variable))))
+ (princ " Automatically becomes ")
+ (if permanent-local
+ (princ "permanently "))
+ (princ "buffer-local when set.\n"))
+ ((not permanent-local))
+ ((bufferp locus)
+ (princ
+ (substitute-command-keys
+ " This variable's buffer-local value is permanent.\n")))
+ (t
+ (princ (substitute-command-keys
+ " This variable's value is permanent \
+if it is given a local binding.\n"))))))
(defvar help-xref-stack-item)
diff --git a/lisp/indent.el b/lisp/indent.el
index 34757a4..bf87d6a 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -65,15 +65,17 @@ e.g., `c-tab-always-indent', and do not respect this
variable."
"Indent line in proper way for current major mode.
Normally, this is done by calling the function specified by the
variable `indent-line-function'. However, if the value of that
-variable is `indent-relative' or `indent-relative-maybe', handle
-it specially (since those functions are used for tabbing); in
-that case, indent by aligning to the previous non-blank line."
+variable is `indent-relative' or `indent-relative-first-indent-point',
+handle it specially (since those functions are used for tabbing);
+in that case, indent by aligning to the previous non-blank line."
(interactive)
(save-restriction
(widen)
(syntax-propertize (line-end-position))
(if (memq indent-line-function
- '(indent-relative indent-relative-maybe))
+ '(indent-relative
+ indent-relative-maybe
+ indent-relative-first-indent-point))
;; These functions are used for tabbing, but can't be used for
;; indenting. Replace with something ad-hoc.
(let ((column (save-excursion
@@ -598,8 +600,9 @@ considered.
If the previous nonblank line has no indent points beyond the
column point starts at, then `tab-to-tab-stop' is done, if both
-FIRST-ONLY and UNINDENTED-OK are nil, otherwise nothing is done
-in this case.
+FIRST-ONLY and UNINDENTED-OK are nil, otherwise nothing is done.
+If there isn't a previous nonblank line and UNINDENTED-OK is nil,
+call `tab-to-tab-stop'.
See also `indent-relative-first-indent-point'."
(interactive "P")
diff --git a/lisp/info.el b/lisp/info.el
index f2a064a..f3b413a 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4768,7 +4768,7 @@ first line or header line, and for breadcrumb links.")
;; This is a serious problem for trying to handle multiple
;; frame types at once. We want this text to be invisible
;; on frames that can display the font above.
- (when (memq (framep (selected-frame)) '(x pc w32 ns))
+ (when (display-multi-font-p)
(add-text-properties (1- (match-beginning 2)) (match-end 2)
'(invisible t front-sticky nil
rear-nonsticky t))))))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 5f87d89..dfa9e4e 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2430,7 +2430,7 @@ See `set-language-info-alist' for use in programs."
("ind" . "Latin-1") ; MS-Windows Indonesian
("sme" . "UTF-8") ; MS-Windows Northern Sami (Norway)
("smf" . "UTF-8") ; MS-Windows Northern Sami (Sweden)
- ("smg" . "ITF-8") ; MS-Windows Northern Sami (Finland)
+ ("smg" . "UTF-8") ; MS-Windows Northern Sami (Finland)
("kdi" "Kannada" utf-8) ; MS-Windows Kannada
("mar" "Devanagari" utf-8) ; MS-Windows Marathi
("khm" "Khmer" utf-8) ; MS-Windows Khmer
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index bd05fce..3266b93 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -568,7 +568,7 @@ While this input method is active, the variable
(quail-delete-overlays)
(setq describe-current-input-method-function nil)
(quail-hide-guidance)
- (remove-hook 'post-command-hook 'quail-show-guidance t)
+ (remove-hook 'post-command-hook #'quail-show-guidance t)
(run-hooks 'quail-deactivate-hook))
(kill-local-variable 'input-method-function))
;; Let's activate Quail input method.
@@ -579,19 +579,18 @@ While this input method is active, the variable
(setq name (car (car quail-package-alist)))
(error "No Quail package loaded"))
(quail-select-package name)))
- (setq deactivate-current-input-method-function 'quail-deactivate)
- (setq describe-current-input-method-function 'quail-help)
+ (setq deactivate-current-input-method-function #'quail-deactivate)
+ (setq describe-current-input-method-function #'quail-help)
(quail-delete-overlays)
(setq quail-guidance-str "")
(quail-show-guidance)
;; If we are in minibuffer, turn off the current input method
;; before exiting.
(when (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)
- (add-hook 'post-command-hook 'quail-show-guidance nil t))
+ (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer)
+ (add-hook 'post-command-hook #'quail-show-guidance nil t))
(run-hooks 'quail-activate-hook)
- (make-local-variable 'input-method-function)
- (setq input-method-function 'quail-input-method)))
+ (setq-local input-method-function #'quail-input-method)))
(define-obsolete-variable-alias
'quail-inactivate-hook
@@ -1367,9 +1366,7 @@ If STR has `advice' text property, append the following
special event:
(let ((start (overlay-start overlay))
(end (overlay-end overlay)))
(if (< start end)
- (prog1
- (string-to-list (buffer-substring start end))
- (delete-region start end)))))
+ (string-to-list (delete-and-extract-region start end)))))
(defsubst quail-delete-region ()
"Delete the text in the current translation region of Quail."
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 0e8e5f6..ccf2cdc 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -14224,6 +14224,11 @@ Pop up a frame and enter GROUP.
;;;;;; 0 0 0))
;;; Generated autoloads from gnus/gnus-icalendar.el
+(autoload 'gnus-icalendar-mm-inline "gnus-icalendar" "\
+
+
+\(fn HANDLE)" nil nil)
+
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"gnus-icalendar" '("gnus-icalendar")))
;;;***
@@ -26849,9 +26854,9 @@ This enforces rescanning the buffer on next use." nil
nil)
(autoload 'regexp-opt "regexp-opt" "\
Return a regexp to match a string in the list STRINGS.
-Each string should be unique in STRINGS and should not contain
-any regexps, quoted or not. Optional PAREN specifies how the
-returned regexp is surrounded by grouping constructs.
+Each member of STRINGS is treated as a fixed string, not as a regexp.
+Optional PAREN specifies how the returned regexp is surrounded by
+grouping constructs.
If STRINGS is the empty list, the return value is a regexp that
never matches anything.
@@ -27908,6 +27913,7 @@ CHAR
matches any character in SET .... SET may be a character or string.
Ranges of characters can be specified as `A-Z' in strings.
Ranges may also be specified as conses like `(?A . ?Z)'.
+ Reversed ranges like `Z-A' and `(?Z . ?A)' are not permitted.
SET may also be the name of a character class: `digit',
`control', `hex-digit', `blank', `graph', `print', `alnum',
@@ -34621,16 +34627,16 @@ the arguments that would have been passed to
OPERATION.
(autoload 'url-copy-file "url-handlers" "\
Copy URL to NEWNAME. Both args must be strings.
-Signals a `file-already-exists' error if file NEWNAME already exists,
+Signal a `file-already-exists' error if file NEWNAME already exists,
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
This is what happens in interactive use with M-x.
Fourth arg KEEP-TIME non-nil means give the new file the same
last-modified time as the old one. (This works on only some systems.)
-Fifth arg PRESERVE-UID-GID is ignored.
+Args PRESERVE-UID-GID and PRESERVE-PERMISSIONS are ignored.
A prefix arg makes KEEP-TIME non-nil.
-\(fn URL NEWNAME &optional OK-IF-ALREADY-EXISTS KEEP-TIME PRESERVE-UID-GID)"
nil nil)
+\(fn URL NEWNAME &optional OK-IF-ALREADY-EXISTS KEEP-TIME PRESERVE-UID-GID
PRESERVE-PERMISSIONS)" nil nil)
(autoload 'url-file-local-copy "url-handlers" "\
Copy URL into a temporary file on this machine.
@@ -35321,6 +35327,12 @@ saving the buffer.
\(fn &optional HISTORIC NOT-URGENT)" t nil)
+(autoload 'vc-diff-mergebase "vc" "\
+Report diffs between the merge base of REV1 and REV2 revisions.
+The merge base is a common ancestor between REV1 and REV2 revisions.
+
+\(fn FILES REV1 REV2)" t nil)
+
(autoload 'vc-version-ediff "vc" "\
Show differences between revisions of the fileset in the
repository history using ediff.
@@ -35449,6 +35461,12 @@ When called interactively with a prefix argument,
prompt for REMOTE-LOCATION.
\(fn &optional REMOTE-LOCATION)" t nil)
+(autoload 'vc-log-mergebase "vc" "\
+Show a log of changes between the merge base of REV1 and REV2 revisions.
+The merge base is a common ancestor between REV1 and REV2 revisions.
+
+\(fn FILES REV1 REV2)" t nil)
+
(autoload 'vc-region-history "vc" "\
Show the history of the region between FROM and TO.
@@ -38153,37 +38171,36 @@ Zone out, completely." t nil)
;;;;;; "international/uni-digit.el" "international/uni-lowercase.el"
;;;;;; "international/uni-mirrored.el" "international/uni-name.el"
;;;;;; "international/uni-numeric.el" "international/uni-old-name.el"
-;;;;;; "international/uni-special-lowercase.el"
"international/uni-special-titlecase.el"
-;;;;;; "international/uni-special-uppercase.el"
"international/uni-titlecase.el"
-;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el"
-;;;;;; "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el"
-;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el"
-;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el"
-;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el"
-;;;;;; "language/indian.el" "language/japanese.el" "language/khmer.el"
-;;;;;; "language/korean.el" "language/lao.el" "language/misc-lang.el"
-;;;;;; "language/romanian.el" "language/sinhala.el" "language/slovak.el"
-;;;;;; "language/tai-viet.el" "language/thai.el" "language/tibetan.el"
-;;;;;; "language/utf-8-lang.el" "language/vietnamese.el" "ldefs-boot.el"
-;;;;;; "leim/ja-dic/ja-dic.el" "leim/leim-list.el" "leim/quail/4Corner.el"
-;;;;;; "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el"
"leim/quail/CTLau-b5.el"
-;;;;;; "leim/quail/CTLau.el" "leim/quail/ECDICT.el" "leim/quail/ETZY.el"
-;;;;;; "leim/quail/PY-b5.el" "leim/quail/PY.el" "leim/quail/Punct-b5.el"
-;;;;;; "leim/quail/Punct.el" "leim/quail/QJ-b5.el" "leim/quail/QJ.el"
-;;;;;; "leim/quail/SW.el" "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el"
-;;;;;; "leim/quail/ZOZY.el" "leim/quail/arabic.el" "leim/quail/croatian.el"
-;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el"
"leim/quail/czech.el"
-;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el"
"leim/quail/hanja-jis.el"
-;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el"
-;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el"
"leim/quail/latin-ltx.el"
-;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el"
"leim/quail/persian.el"
-;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el"
-;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el"
"leim/quail/quick-cns.el"
-;;;;;; "leim/quail/rfc1345.el" "leim/quail/sgml-input.el"
"leim/quail/slovak.el"
-;;;;;; "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el"
"leim/quail/tsang-b5.el"
-;;;;;; "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" "leim/quail/vnvni.el"
-;;;;;; "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el"
"mail/rmailedit.el"
-;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el"
"mail/rmailsort.el"
+;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el"
+;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el"
+;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el"
+;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el"
+;;;;;; "language/european.el" "language/georgian.el" "language/greek.el"
+;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el"
+;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el"
+;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el"
+;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el"
+;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el"
+;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/leim-list.el"
+;;;;;; "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el"
+;;;;;; "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" "leim/quail/ECDICT.el"
+;;;;;; "leim/quail/ETZY.el" "leim/quail/PY-b5.el" "leim/quail/PY.el"
+;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el"
+;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el"
+;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el"
+;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el"
"leim/quail/cyrillic.el"
+;;;;;; "leim/quail/czech.el" "leim/quail/georgian.el" "leim/quail/greek.el"
+;;;;;; "leim/quail/hanja-jis.el" "leim/quail/hanja.el" "leim/quail/hanja3.el"
+;;;;;; "leim/quail/hebrew.el" "leim/quail/ipa-praat.el"
"leim/quail/latin-alt.el"
+;;;;;; "leim/quail/latin-ltx.el" "leim/quail/latin-post.el"
"leim/quail/latin-pre.el"
+;;;;;; "leim/quail/persian.el" "leim/quail/programmer-dvorak.el"
+;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el"
"leim/quail/quick-b5.el"
+;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el"
+;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el"
"leim/quail/symbol-ksc.el"
+;;;;;; "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el"
"leim/quail/tsang-cns.el"
+;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el"
+;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" "mail/rmailkwd.el"
+;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el"
"net/tramp-loaddefs.el"
;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-keys.el"
diff --git a/lisp/leim/quail/sami.el b/lisp/leim/quail/sami.el
index d4cf4ec..7cfd0b7 100644
--- a/lisp/leim/quail/sami.el
+++ b/lisp/leim/quail/sami.el
@@ -1,6 +1,6 @@
;;; sami.el --- Quail package for inputting Sámi -*-coding: utf-8;-*-
-;; Copyright (C) 1998, 2001-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2019 Free Software Foundation, Inc.
;; Author: Wojciech S. Gac <address@hidden>
;; Maintainer: Wojciech S. Gac <address@hidden>>
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index a780292..81dc11d 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -363,7 +363,9 @@ Use Unicode characters for footnoting."
("ק" "ר" "ש" "ת" "תק" "תר" "תש" "תת" "תתק")))
(defconst footnote-hebrew-numeric-regex
- (concat "[" (apply #'concat (apply #'append footnote-hebrew-numeric)) "']+"))
+ (let ((numchars (string-to-list
+ (apply #'concat (apply #'append footnote-hebrew-numeric)))))
+ (concat (regexp-opt-charset (cons ?' numchars)) "+")))
;; (defconst footnote-hebrew-numeric-regex
"\\([אבגדהוזחט]'\\)?\\(ת\\)?\\(ת\\)?\\([קרשת]\\)?\\([טיכלמנסעפצ]\\)?\\([אבגדהוזחט]\\)?")
(defun footnote--hebrew-numeric (n)
@@ -457,9 +459,19 @@ Conversion is done based upon the current selected style."
(defun footnote--current-regexp ()
"Return the regexp of the index of the current style."
- (concat (nth 2 (or (assq footnote-style footnote-style-alist)
- (nth 0 footnote-style-alist)))
- "*"))
+ (let ((regexp (nth 2 (or (assq footnote-style footnote-style-alist)
+ (nth 0 footnote-style-alist)))))
+ (concat
+ ;; Hack to avoid repetition of repetition.
+ ;; FIXME: I'm not sure the added * makes sense at all; there is
+ ;; always a single number within the footnote-{start,end}-tag pairs.
+ ;; Worse, the code goes on and adds yet another + later on, in
+ ;; footnote-refresh-footnotes, just in case. That makes even less sense.
+ ;; Likely, both the * and the extra + should go away.
+ (if (string-match "[^\\]\\\\\\{2\\}*[*+?]\\'" regexp)
+ (substring regexp 0 -1)
+ regexp)
+ "*")))
(defun footnote--refresh-footnotes (&optional index-regexp)
"Redraw all footnotes.
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index cb57d8e..a0b9688 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -383,7 +383,7 @@ by translating things like \"address@hidden" into
\"address@hidden"."
;; Matches telephone extensions.
(defconst mail-extr-telephone-extension-pattern
(purecopy
- "\\(\\([Ee]xt\\|\\|[Tt]ph\\|[Tt]el\\|[Xx]\\).?\\)? *\\+?[0-9][- 0-9]+"))
+ "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\).?\\)? *\\+?[0-9][- 0-9]+"))
;; Matches ham radio call signs.
;; Help from: Mat Maessen N2NJZ <address@hidden>, Mark Feit
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 8eeaa8b..f3aa55f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -53,7 +53,7 @@ It is used for TCP/IP devices."
"When this method name is used, forward all calls to Android Debug Bridge.")
(defcustom tramp-adb-prompt
-
"^\\(?:[[:digit:]]*|?\\)?\\(?:[[:alnum:]\e;address@hidden:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]"
+
"^[[:digit:]]*|?\\(?:[[:alnum:]\e;address@hidden:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'string
:version "24.4"
@@ -968,7 +968,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(program (car command))
(args (cdr command))
(command
- (format "cd %s; %s"
+ (format "cd %s && exec %s"
(tramp-shell-quote-argument localname)
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))
@@ -1000,24 +1000,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; otherwise we might be interrupted by
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point)))
+ (inhibit-read-only t))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-adb-maybe-open-connection', in
;; order to cleanup the prompt afterwards.
(tramp-adb-maybe-open-connection v)
- (widen)
- (delete-region mark (point-max))
- (narrow-to-region (point-max) (point-max))
+ (delete-region (point-min) (point-max))
;; Send the command.
- (let* ((p (tramp-get-connection-process v))
- (prompt
- (tramp-get-connection-property p "prompt" nil)))
- (tramp-set-connection-property
- p "prompt" (regexp-quote command))
- (tramp-adb-send-command v command)
- (tramp-set-connection-property p "prompt" prompt)
+ (let* ((p (tramp-get-connection-process v)))
+ (tramp-adb-send-command v command nil t) ; nooutput
;; Stop process if indicated.
(when stop
(stop-process p))
@@ -1032,6 +1024,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
+ ;; Read initial output. Remove the first line,
+ ;; which is the command echo.
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward "[\n]" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point))
;; Return process.
p))))
@@ -1119,26 +1119,27 @@ This happens for Android >= 4.0."
;; Connection functions
-(defun tramp-adb-send-command (vec command)
+(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
- (tramp-adb-maybe-open-connection vec)
+ (unless neveropen (tramp-adb-maybe-open-connection vec))
(tramp-message vec 6 "%s" command)
(tramp-send-string vec command)
- ;; FIXME: Race condition.
- (tramp-adb-wait-for-output (tramp-get-connection-process vec))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (save-excursion
- (goto-char (point-min))
- ;; We can't use stty to disable echo of command. stty is said
- ;; to be added to toybox 0.7.6. busybox shall have it, but this
- ;; isn't used any longer for Android.
- (delete-matching-lines (regexp-quote command))
- ;; When the local machine is W32, there are still trailing ^M.
- ;; There must be a better solution by setting the correct coding
- ;; system, but this requires changes in core Tramp.
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" nil nil)))))
+ (unless nooutput
+ ;; FIXME: Race condition.
+ (tramp-adb-wait-for-output (tramp-get-connection-process vec))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (save-excursion
+ (goto-char (point-min))
+ ;; We can't use stty to disable echo of command. stty is said
+ ;; to be added to toybox 0.7.6. busybox shall have it, but this
+ ;; isn't used any longer for Android.
+ (delete-matching-lines (regexp-quote command))
+ ;; When the local machine is W32, there are still trailing ^M.
+ ;; There must be a better solution by setting the correct coding
+ ;; system, but this requires changes in core Tramp.
+ (goto-char (point-min))
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" nil nil))))))
(defun tramp-adb-send-command-and-check (vec command)
"Run COMMAND and check its exit status.
@@ -1245,6 +1246,9 @@ connection if a previous connection has died for some
reason."
(tramp-adb-wait-for-output p 30)
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
+
+ ;; Set sentinel and query flag. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
(process-put p 'vector vec)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
@@ -1299,7 +1303,6 @@ connection if a previous connection has died for some
reason."
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
"Default connection-local variables for remote adb connections.")
-(add-to-list 'tramp-connection-local-safe-shell-file-names "/system/bin/sh")
;; `connection-local-set-profile-variables' and
;; `connection-local-set-profiles' exists since Emacs 26.1.
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 9e131b1..ba4c26c 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -584,9 +584,7 @@ offered."
(defun tramp-archive-handle-file-readable-p (filename)
"Like `file-readable-p' for file archives."
- (with-parsed-tramp-file-name
- (tramp-archive-gvfs-file-name filename) nil
- (tramp-check-cached-permissions v ?r)))
+ (file-readable-p (tramp-archive-gvfs-file-name filename)))
(defun tramp-archive-handle-file-system-info (filename)
"Like `file-system-info' for file archives."
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 2d8f420..8fea82d 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1136,7 +1136,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"Like `file-executable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-executable-p"
- (tramp-check-cached-permissions v ?x))))
+ (and (file-exists-p filename)
+ (tramp-check-cached-permissions v ?x)))))
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@@ -1258,7 +1259,20 @@ file-notify events."
"Like `file-readable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-readable-p"
- (tramp-check-cached-permissions v ?r))))
+ (and (file-exists-p filename)
+ (or (tramp-check-cached-permissions v ?r)
+ ;; If the user is different from what we guess to be
+ ;; the user, we don't know. Let's check, whether
+ ;; access is restricted explicitly.
+ (and (/= (tramp-gvfs-get-remote-uid v 'integer)
+ (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer)))
+ (not
+ (string-equal
+ "FALSE"
+ (cdr (assoc
+ "access::can-read"
+ (tramp-gvfs-get-file-attributes filename)))))))))))
(defun tramp-gvfs-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 946d7f8..da168ad 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -173,21 +173,10 @@ NAME must be equal to `tramp-current-connection'."
;;; Default connection-local variables for Tramp:
-;;;###tramp-autoload
-(defvar tramp-connection-local-safe-shell-file-names nil
- "List of safe `shell-file-name' values for remote hosts.")
-(add-to-list 'tramp-connection-local-safe-shell-file-names "/bin/sh")
-
(defconst tramp-connection-local-default-profile
'((shell-file-name . "/bin/sh")
(shell-command-switch . "-c"))
"Default connection-local variables for remote connections.")
-(put 'shell-file-name 'safe-local-variable
- (lambda (item)
- (and (stringp item)
- (member item tramp-connection-local-safe-shell-file-names))))
-(put 'shell-command-switch 'safe-local-variable
- (lambda (item) (and (stringp item) (string-equal item "-c"))))
;; `connection-local-set-profile-variables' and
;; `connection-local-set-profiles' exists since Emacs 26.1.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2b4399f..d9751a9 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2769,15 +2769,6 @@ the result will be a local, non-Tramp, file name."
;;; Remote commands:
-(defun tramp-process-sentinel (proc event)
- "Flush file caches."
- (unless (process-live-p proc)
- (let ((vec (process-get proc 'vector)))
- (when vec
- (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
- (tramp-flush-connection-properties proc)
- (tramp-flush-directory-properties vec "")))))
-
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
@@ -2926,6 +2917,9 @@ the result will be a local, non-Tramp, file name."
(let ((pid (tramp-send-command-and-read v "echo $$")))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could have
+ ;; trashed the connection buffer. Remove this.
(widen)
(delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
@@ -5314,87 +5308,90 @@ Return ATTR."
(defun tramp-get-remote-path (vec)
"Compile list of remote directories for $PATH.
Nonexistent directories are removed from spec."
- (with-tramp-connection-property
- ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
- ;; cache the result for the session only. Otherwise, the result
- ;; is cached persistently.
- (if (memq 'tramp-own-remote-path tramp-remote-path)
- (tramp-get-connection-process vec)
- vec)
- "remote-path"
- (let* ((remote-path (copy-tree tramp-remote-path))
- (elt1 (memq 'tramp-default-remote-path remote-path))
- (elt2 (memq 'tramp-own-remote-path remote-path))
- (default-remote-path
- (when elt1
- (or
- (tramp-send-command-and-read
- vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
- ;; Default if "getconf" is not available.
- (progn
- (tramp-message
- vec 3
- "`getconf PATH' not successful, using default value \"%s\"."
- "/bin:/usr/bin")
- "/bin:/usr/bin"))))
- (own-remote-path
- ;; The login shell could return more than just the $PATH
- ;; string. So we use `tramp-end-of-heredoc' as marker.
- (when elt2
- (or
- (tramp-send-command-and-read
- vec
- (format
- "%s %s %s 'echo %s \\\"$PATH\\\"'"
- (tramp-get-method-parameter vec 'tramp-remote-shell)
- (mapconcat
- #'identity
- (tramp-get-method-parameter vec 'tramp-remote-shell-login)
- " ")
- (mapconcat
- #'identity
- (tramp-get-method-parameter vec 'tramp-remote-shell-args)
- " ")
- (tramp-shell-quote-argument tramp-end-of-heredoc))
- 'noerror (regexp-quote tramp-end-of-heredoc))
- (progn
- (tramp-message
- vec 2 "Could not retrieve `tramp-own-remote-path'")
- nil)))))
-
- ;; Replace place holder `tramp-default-remote-path'.
- (when elt1
- (setcdr elt1
- (append
- (split-string (or default-remote-path "") ":" 'omit)
- (cdr elt1)))
- (setq remote-path (delq 'tramp-default-remote-path remote-path)))
-
- ;; Replace place holder `tramp-own-remote-path'.
- (when elt2
- (setcdr elt2
- (append
- (split-string (or own-remote-path "") ":" 'omit)
- (cdr elt2)))
- (setq remote-path (delq 'tramp-own-remote-path remote-path)))
-
- ;; Remove double entries.
- (setq elt1 remote-path)
- (while (consp elt1)
- (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
- (setcar elt2 nil))
- (setq elt1 (cdr elt1)))
-
- ;; Remove non-existing directories.
- (delq
- nil
- (mapcar
- (lambda (x)
- (and
- (stringp x)
- (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
- x))
- remote-path)))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; Expand connection-local variables.
+ (tramp-set-connection-local-variables vec)
+ (with-tramp-connection-property
+ ;; When `tramp-own-remote-path' is in `tramp-remote-path', we
+ ;; cache the result for the session only. Otherwise, the
+ ;; result is cached persistently.
+ (if (memq 'tramp-own-remote-path tramp-remote-path)
+ (tramp-get-connection-process vec)
+ vec)
+ "remote-path"
+ (let* ((remote-path (copy-tree tramp-remote-path))
+ (elt1 (memq 'tramp-default-remote-path remote-path))
+ (elt2 (memq 'tramp-own-remote-path remote-path))
+ (default-remote-path
+ (when elt1
+ (or
+ (tramp-send-command-and-read
+ vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror)
+ ;; Default if "getconf" is not available.
+ (progn
+ (tramp-message
+ vec 3
+ "`getconf PATH' not successful, using default value
\"%s\"."
+ "/bin:/usr/bin")
+ "/bin:/usr/bin"))))
+ (own-remote-path
+ ;; The login shell could return more than just the $PATH
+ ;; string. So we use `tramp-end-of-heredoc' as marker.
+ (when elt2
+ (or
+ (tramp-send-command-and-read
+ vec
+ (format
+ "%s %s %s 'echo %s \\\"$PATH\\\"'"
+ (tramp-get-method-parameter vec 'tramp-remote-shell)
+ (mapconcat
+ #'identity
+ (tramp-get-method-parameter vec 'tramp-remote-shell-login)
+ " ")
+ (mapconcat
+ #'identity
+ (tramp-get-method-parameter vec 'tramp-remote-shell-args)
+ " ")
+ (tramp-shell-quote-argument tramp-end-of-heredoc))
+ 'noerror (regexp-quote tramp-end-of-heredoc))
+ (progn
+ (tramp-message
+ vec 2 "Could not retrieve `tramp-own-remote-path'")
+ nil)))))
+
+ ;; Replace place holder `tramp-default-remote-path'.
+ (when elt1
+ (setcdr elt1
+ (append
+ (split-string (or default-remote-path "") ":" 'omit)
+ (cdr elt1)))
+ (setq remote-path (delq 'tramp-default-remote-path remote-path)))
+
+ ;; Replace place holder `tramp-own-remote-path'.
+ (when elt2
+ (setcdr elt2
+ (append
+ (split-string (or own-remote-path "") ":" 'omit)
+ (cdr elt2)))
+ (setq remote-path (delq 'tramp-own-remote-path remote-path)))
+
+ ;; Remove double entries.
+ (setq elt1 remote-path)
+ (while (consp elt1)
+ (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
+ (setcar elt2 nil))
+ (setq elt1 (cdr elt1)))
+
+ ;; Remove non-existing directories.
+ (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (and
+ (stringp x)
+ (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
+ x))
+ remote-path))))))
(defun tramp-get-remote-locale (vec)
"Determine remote locale, supporting UTF8 if possible."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 48c363a..32963ac 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2801,14 +2801,14 @@ for all methods. Resulting data are derived from
default settings."
:port method :require '(:port) :max most-positive-fixnum))))
;; Generic function.
-(defun tramp-parse-group (regexp match-level skip-regexp)
+(defun tramp-parse-group (regexp match-level skip-chars)
"Return a (user host) tuple allowed to access.
User is always nil."
(let (result)
(when (re-search-forward regexp (point-at-eol) t)
(setq result (list nil (match-string match-level))))
(or
- (> (skip-chars-forward skip-regexp) 0)
+ (> (skip-chars-forward skip-chars) 0)
(forward-line 1))
result))
@@ -2864,7 +2864,7 @@ User is always nil."
(tramp-parse-group
(concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)"
"\\|" "\\(" tramp-host-regexp "\\)")
- 1 "[ \t]+"))
+ 1 " \t"))
;; Generic function.
(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
@@ -3641,7 +3641,7 @@ support symbolic links."
(prog1
;; Run the process.
(setq p (start-file-process-shell-command
- "*Async Shell*" buffer command))
+ (buffer-name output-buffer) buffer command))
;; Display output.
(with-current-buffer output-buffer
(display-buffer output-buffer '(nil (allow-no-window . t)))
@@ -3881,7 +3881,7 @@ of."
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
- ;; password from the debug buffer.
+ ;; password from the debug buffer and the traces.
(process-send-string
proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
;; Hide password prompt.
@@ -4074,9 +4074,14 @@ for process communication also."
(let ((inhibit-read-only t)
last-coding-system-used
;; We do not want to run timers.
+ (tl timer-list)
(stimers (with-timeout-suspend))
timer-list timer-idle-list
result)
+ ;; Enable our progress reporter.
+ (dolist (timer tl)
+ (if (eq (timer--function timer) #'tramp-progress-reporter-update)
+ (push timer timer-list)))
;; JUST-THIS-ONE is set due to Bug#12145.
(tramp-message
proc 10 "%s %s %s %s\n%s"
@@ -4166,12 +4171,20 @@ The STRING is expected to use Unix line-endings, but
the lines sent to
the remote host use line-endings as defined in the variable
`tramp-rsh-end-of-line'. The communication buffer is erased before sending."
(let* ((p (tramp-get-connection-process vec))
- (chunksize (tramp-get-connection-property p "chunksize" nil)))
+ (chunksize (tramp-get-connection-property p "chunksize" nil))
+ ;; We do not want to run timers.
+ (tl timer-list)
+ (stimers (with-timeout-suspend))
+ timer-list timer-idle-list)
(unless p
(tramp-error
vec 'file-error "Can't send string to remote host -- not logged in"))
(tramp-set-connection-property p "last-cmd-time" (current-time))
(tramp-message vec 10 "%s" string)
+ ;; Enable our progress reporter.
+ (dolist (timer tl)
+ (if (eq (timer--function timer) #'tramp-progress-reporter-update)
+ (push timer timer-list)))
(with-current-buffer (tramp-get-connection-buffer vec)
;; Clean up the buffer. We cannot call `erase-buffer' because
;; narrowing might be in effect.
@@ -4184,17 +4197,33 @@ the remote host use line-endings as defined in the
variable
(string-equal (substring string -1) tramp-rsh-end-of-line))
(setq string (concat string tramp-rsh-end-of-line)))
;; Send the string.
- (if (and chunksize (not (zerop chunksize)))
- (let ((pos 0)
- (end (length string)))
- (while (< pos end)
- (tramp-message
- vec 10 "Sending chunk from %s to %s"
- pos (min (+ pos chunksize) end))
- (process-send-string
- p (substring string pos (min (+ pos chunksize) end)))
- (setq pos (+ pos chunksize))))
- (process-send-string p string)))))
+ (with-local-quit
+ (if (and chunksize (not (zerop chunksize)))
+ (let ((pos 0)
+ (end (length string)))
+ (while (< pos end)
+ (tramp-message
+ vec 10 "Sending chunk from %s to %s"
+ pos (min (+ pos chunksize) end))
+ (process-send-string
+ p (substring string pos (min (+ pos chunksize) end)))
+ (setq pos (+ pos chunksize))))
+ (process-send-string p string)))
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers))))
+
+(defun tramp-process-sentinel (proc event)
+ "Flush file caches and remove shell prompt."
+ (unless (process-live-p proc)
+ (let ((vec (process-get proc 'vector))
+ (prompt (tramp-get-connection-property proc "prompt" nil)))
+ (when vec
+ (tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
+ (tramp-flush-connection-properties proc)
+ (tramp-flush-directory-properties vec ""))
+ (goto-char (point-max))
+ (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
+ (delete-region (point) (point-max))))))
(defun tramp-get-inode (vec)
"Returns the virtual inode number.
@@ -4892,6 +4921,12 @@ Only works for Bourne-like shells."
;; and friends, for most of the handlers this is the major
;; difference between the different backends. Other handlers but
;; *-process-file would profit from this as well.
+;;
+;; * Get rid of `shell-command'. In its primary implementation, it
+;; uses `process-file-shell-command' and
+;; `start-file-process-shell-command', which is sufficient due to
+;; connection-local `shell-file-name'.
+
;;; tramp.el ends here
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 40df23e..e297b9d 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -342,7 +342,7 @@ Please submit bug reports and other feedback to the author,
Neil W. Van Dyke
(mapconcat (lambda (c)
(let ((s (char-to-string c)))
(cond ((string= s " ") "+")
- ((string-match "[a-zA-Z_.-/]" s) s)
+ ((string-match "[a-zA-Z_./~-]" s) s)
(t (upcase (format "%%%02x" c))))))
(encode-coding-string str 'utf-8)
""))
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index bb371c5..9d919cc 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -327,11 +327,11 @@ behavior for explicit filling, you might as well use
\\[newline-and-indent]."
(defcustom comment-empty-lines nil
"If nil, `comment-region' does not comment out empty lines.
If t, it always comments out empty lines.
-If `eol' it only comments out empty lines if comments are
-terminated by the end of line (i.e. `comment-end' is empty)."
+If `eol', it only comments out empty lines if comments are
+terminated by the end of line (i.e., `comment-end' is empty)."
:type '(choice (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "EOl-terminated" eol))
+ (const :tag "Always" t)
+ (const :tag "EOL-terminated" eol))
:group 'comment)
;;;;
diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el
index 7d44f56..df5ddfd 100644
--- a/lisp/obsolete/vi.el
+++ b/lisp/obsolete/vi.el
@@ -132,7 +132,7 @@ command extensions.")
(define-key vi-com-map "\C-e" 'vi-expose-line-below)
(define-key vi-com-map "\C-f" 'vi-forward-windowful)
(define-key vi-com-map "\C-g" 'keyboard-quit)
- (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB
+ (define-key vi-com-map "\C-i" 'indent-relative-first-indent-point) ; TAB
(define-key vi-com-map "\C-j" 'vi-next-line) ; LFD
(define-key vi-com-map "\C-k" 'vi-kill-line) ; extension
(define-key vi-com-map "\C-l" 'recenter)
diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el
index bb27d92..2251a1b 100644
--- a/lisp/org/org-eshell.el
+++ b/lisp/org/org-eshell.el
@@ -37,7 +37,7 @@
eshell buffer) or a command line prefixed by a buffer name
followed by a colon."
(let* ((buffer-and-command
- (if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link)
+ (if (string-match "\\([A-Za-z0-9+*-]+\\):\\(.*\\)" link)
(list (match-string 1 link)
(match-string 2 link))
(list eshell-buffer-name link)))
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index b6e864f..147527d 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -484,8 +484,8 @@ Line numbers are counted from the beginning of the table.
This
variable is initialized with `org-table-analyze'.")
(defconst org-table-range-regexp
-
"@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(address@hidden([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
- ;; 1 2 3 4
5
+
"@\\([-+]?I*[-+]?[0-9]*\\)\\(\\$[-+]?[0-9]+\\)?\\(address@hidden([-+]?I*[-+]?[0-9]*\\)\\(\\$[-+]?[0-9]+\\)?\\)?"
+ ;; 1 2 3 4
5
"Regular expression for matching ranges in formulas.")
(defconst org-table-range-regexp2
diff --git a/lisp/org/org.el b/lisp/org/org.el
index bf7e305..ce6dd24 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -430,7 +430,7 @@ Matched keyword is in group 1.")
(defconst org-deadline-time-hour-regexp
(concat "\\<" org-deadline-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy \t.-]*\\)>")
"Matches the DEADLINE keyword together with a time-and-hour stamp.")
(defconst org-deadline-line-regexp
@@ -446,7 +446,7 @@ Matched keyword is in group 1.")
(defconst org-scheduled-time-hour-regexp
(concat "\\<" org-scheduled-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9+:hdwmy \t.-]*\\)>")
"Matches the SCHEDULED keyword together with a time-and-hour stamp.")
(defconst org-closed-time-regexp
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 430a207..4a9dac7 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -565,8 +565,8 @@ FILE is created there."
;; On POSIX systems there are four cases to distinguish:
-;; 1. FILE is an absolute filename. Then it should be a file in
-;; temporary file directory. This is the way,
+;; 1. FILE is an absolute filename or "update-game-score" does not exist.
+;; Then FILE should be a file in a temporary file directory. This is how
;; `gamegrid-add-score' was supposed to be used in the past and
;; is covered here for backward-compatibility.
;;
@@ -583,21 +583,18 @@ FILE is created there."
;; update FILE. This is for the case that a user has installed
;; a game on her own.
;;
-;; 4. "update-game-score" does not exist or is not setgid/setuid.
-;; Create/update FILE in the user's home directory, without
-;; using "update-game-score". There is presumably no shared
-;; game directory.
+;; 4. "update-game-score" is not setgid/setuid. Use it to
+;; create/update FILE in the user's home directory. There is
+;; presumably no shared game directory.
(defvar gamegrid-shared-game-dir)
(defun gamegrid-add-score-with-update-game-score (file score)
- (let ((gamegrid-shared-game-dir
- (not (zerop (logand (or (file-modes
- (expand-file-name "update-game-score"
- exec-directory))
- 0)
- #o6000)))))
- (cond ((file-name-absolute-p file)
+ (let* ((update-game-score-modes
+ (file-modes (expand-file-name "update-game-score" exec-directory)))
+ (gamegrid-shared-game-dir
+ (not (zerop (logand #o6000 (or update-game-score-modes 0))))))
+ (cond ((or (not update-game-score-modes) (file-name-absolute-p file))
(gamegrid-add-score-insecure file score))
((and gamegrid-shared-game-dir
(file-exists-p (expand-file-name file
shared-game-score-directory)))
@@ -607,12 +604,23 @@ FILE is created there."
(expand-file-name file shared-game-score-directory) score))
;; Else: Add the score to a score file in the user's home
;; directory.
- (t
+ (gamegrid-shared-game-dir
+ ;; If gamegrid-shared-game-dir is non-nil the
+ ;; "update-gamescore" program is setuid, so don't use it.
(unless (file-exists-p
(directory-file-name gamegrid-user-score-file-directory))
(make-directory gamegrid-user-score-file-directory t))
(gamegrid-add-score-insecure file score
- gamegrid-user-score-file-directory)))))
+ gamegrid-user-score-file-directory))
+ (t
+ (unless (file-exists-p
+ (directory-file-name gamegrid-user-score-file-directory))
+ (make-directory gamegrid-user-score-file-directory t))
+ (let ((f (expand-file-name file
+ gamegrid-user-score-file-directory)))
+ (unless (file-exists-p f)
+ (write-region "" nil f nil 'silent nil 'excl))
+ (gamegrid-add-score-with-update-game-score-1 file f score))))))
(defun gamegrid-add-score-with-update-game-score-1 (file target score)
(let ((default-directory "/")
diff --git a/lisp/printing.el b/lisp/printing.el
index 27856eb..f2495ec 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,4 +1,4 @@
-;;; printing.el --- printing utilities
+;;; printing.el --- printing utilities -*- lexical-binding:t -*-
;; Copyright (C) 2000-2001, 2003-2019 Free Software Foundation, Inc.
@@ -460,7 +460,7 @@ Please send all bug fixes and enhancements to
;; subjects shows up at the printer. With major mode printing you don't need
;; to switch from gnus *Summary* buffer first.
;;
-;; Current global keyboard mapping for GNU Emacs is:
+;; Current global keyboard mapping is:
;;
;; (global-set-key [print] 'pr-ps-fast-fire)
;; (global-set-key [M-print] 'pr-ps-mode-using-ghostscript)
@@ -468,14 +468,6 @@ Please send all bug fixes and enhancements to
;; (global-set-key [C-print] 'pr-txt-fast-fire)
;; (global-set-key [C-M-print] 'pr-txt-fast-fire)
;;
-;; And for XEmacs is:
-;;
-;; (global-set-key 'f22 'pr-ps-fast-fire)
-;; (global-set-key '(meta f22) 'pr-ps-mode-using-ghostscript)
-;; (global-set-key '(shift f22) 'pr-ps-mode-using-ghostscript)
-;; (global-set-key '(control f22) 'pr-txt-fast-fire)
-;; (global-set-key '(control meta f22) 'pr-txt-fast-fire)
-;;
;; As a suggestion of global keyboard mapping for some `printing' commands:
;;
;; (global-set-key "\C-ci" 'pr-interface)
@@ -493,7 +485,7 @@ Please send all bug fixes and enhancements to
;; Below it's shown a brief description of `printing' options, please, see the
;; options declaration in the code for a long documentation.
;;
-;; `pr-path-style' Specify which path style to use for external
+;; `pr-filename-style' Specify which filename style to use for external
;; commands.
;;
;; `pr-path-alist' Specify an alist for command paths.
@@ -999,7 +991,7 @@ Please send all bug fixes and enhancements to
;; - automagic region detection.
;; - menu entry hiding.
;; - fast fire PostScript printing command.
-;; - `pr-path-style' variable.
+;; - `pr-filename-style' variable.
;;
;; Thanks to Kim F. Storm <address@hidden> for beta-test and for suggestions:
;; - PostScript Print and PostScript Print Preview merge.
@@ -1023,7 +1015,7 @@ Please send all bug fixes and enhancements to
(require 'lpr)
(require 'ps-print)
-
+(require 'easymenu)
(and (string< ps-print-version "6.6.4")
(error "`printing' requires `ps-print' package version 6.6.4 or later"))
@@ -1038,93 +1030,16 @@ Please send all bug fixes and enhancements to
;; To avoid compilation gripes
-;; Emacs has this since at least 21.1.
-(when (featurep 'xemacs)
- (or (fboundp 'subst-char-in-string) ; hacked from subr.el
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> (setq i (1- i)) 0)
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr))))
-
-
-;; Emacs has this since at least 21.1, but the SUFFIX argument
-;; (which this file uses) only since 22.1. So the fboundp test
-;; wasn't even correct/adequate. Whatever, no-one is using
-;; this file on older Emacs version, so it's irrelevant.
-(when (featurep 'xemacs)
- (or (fboundp 'make-temp-file) ; hacked from subr.el
- (defun make-temp-file (prefix &optional dir-flag suffix)
- "Create a temporary file.
-The returned file name (created by appending some random characters at the end
-of PREFIX, and expanding against `temporary-file-directory' if necessary),
-is guaranteed to point to a newly created empty file.
-You can then use `write-region' to write new data into the file.
-
-If DIR-FLAG is non-nil, create a new empty directory instead of a file.
-
-If SUFFIX is non-nil, add that at the end of the file name."
- (let ((umask (default-file-modes))
- file)
- (unwind-protect
- (progn
- ;; Create temp files with strict access rights. It's easy to
- ;; loosen them later, whereas it's impossible to close the
- ;; time-window of loose permissions otherwise.
- (set-default-file-modes ?\700)
- (while (condition-case ()
- (progn
- (setq file
- (make-temp-name
- (expand-file-name prefix
temporary-file-directory)))
- (if suffix
- (setq file (concat file suffix)))
- (if dir-flag
- (make-directory file)
- (write-region "" nil file nil 'silent nil 'excl))
- nil)
- (file-already-exists t))
- ;; the file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- file)
- ;; Reset the umask.
- (set-default-file-modes umask))))))
-
-
-(eval-when-compile
- ;; User Interface --- declared here to avoid compiler warnings
- (defvar pr-path-style)
- (defvar pr-auto-region)
- (defvar pr-menu-char-height)
- (defvar pr-menu-char-width)
- (defvar pr-menu-lock)
- (defvar pr-ps-printer-alist)
- (defvar pr-txt-printer-alist)
- (defvar pr-ps-utility-alist)
-
-
- ;; Internal fun alias to avoid compilation gripes
- (defalias 'pr-menu-lookup 'ignore)
- (defalias 'pr-menu-lock 'ignore)
- (defalias 'pr-menu-alist 'ignore)
- (defalias 'pr-even-or-odd-pages 'ignore)
- (defalias 'pr-menu-get-item 'ignore)
- (defalias 'pr-menu-set-item-name 'ignore)
- (defalias 'pr-menu-set-utility-title 'ignore)
- (defalias 'pr-menu-set-ps-title 'ignore)
- (defalias 'pr-menu-set-txt-title 'ignore)
- (defalias 'pr-region-active-p 'ignore)
- (defalias 'pr-do-update-menus 'ignore)
- (defalias 'pr-update-mode-line 'ignore)
- (defalias 'pr-read-string 'ignore)
- (defalias 'pr-set-keymap-parents 'ignore)
- (defalias 'pr-keep-region-active 'ignore))
-
+;; User Interface --- declared here to avoid compiler warnings
+(define-obsolete-variable-alias 'pr-path-style 'pr-filename-style "27.1")
+(defvar pr-filename-style)
+(defvar pr-auto-region)
+(defvar pr-menu-char-height)
+(defvar pr-menu-char-width)
+(defvar pr-menu-lock)
+(defvar pr-ps-printer-alist)
+(defvar pr-txt-printer-alist)
+(defvar pr-ps-utility-alist)
;; Internal Vars --- defined here to avoid compiler warnings
(defvar pr-menu-print-item "print"
@@ -1151,480 +1066,206 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; XEmacs Definitions
-
-
-(cond
- ((featurep 'xemacs) ; XEmacs
- ;; XEmacs
- (defalias 'pr-set-keymap-parents 'set-keymap-parents)
- (defalias 'pr-set-keymap-name 'set-keymap-name)
-
- ;; XEmacs
- (defun pr-read-string (prompt initial history default)
- (let ((str (read-string prompt initial)))
- (if (and str (not (string= str "")))
- str
- default)))
-
- ;; XEmacs
- (defvar zmacs-region-stays nil)
-
- ;; XEmacs
- (defun pr-keep-region-active ()
- (setq zmacs-region-stays t))
-
- ;; XEmacs
- (defun pr-region-active-p ()
- (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p)))
-
- ;; XEmacs
- (defun pr-menu-char-height ()
- (font-height (face-font 'default)))
-
- ;; XEmacs
- (defun pr-menu-char-width ()
- (font-width (face-font 'default)))
-
- ;; XEmacs
- (defmacro pr-xemacs-global-menubar (&rest body)
- `(save-excursion
- (let ((temp (get-buffer-create (make-temp-name " *Temp"))))
- ;; be sure to access global menubar
- (set-buffer temp)
- ,@body
- (kill-buffer temp))))
-
- ;; XEmacs
- (defun pr-global-menubar (pr-menu-spec)
- ;; Menu binding
- (pr-xemacs-global-menubar
- (add-submenu nil (cons "Printing" pr-menu-spec) "Apps"))
- (setq pr-menu-print-item nil))
-
- ;; XEmacs
- (defvar current-mouse-event nil)
- (defun pr-menu-position (entry index horizontal)
- (make-event
- 'button-release
- (list 'button 1
- 'x (- (event-x-pixel current-mouse-event) ; X
- (* horizontal pr-menu-char-width))
- 'y (- (event-y-pixel current-mouse-event) ; Y
- (* (pr-menu-index entry index) pr-menu-char-height)))))
-
- (defvar pr-menu-position nil)
- (defvar pr-menu-state nil)
-
- ;; XEmacs
- (defvar current-menubar nil) ; to avoid compilation gripes
- (defun pr-menu-lookup (path)
- (car (find-menu-item current-menubar (cons "Printing" path))))
-
- ;; XEmacs
- (defun pr-menu-lock (entry index horizontal state path)
- (when pr-menu-lock
- (or (and pr-menu-position (eq state pr-menu-state))
- (setq pr-menu-position (pr-menu-position entry index horizontal)
- pr-menu-state state))
- (let* ((menu (pr-menu-lookup path))
- (result (get-popup-menu-response menu pr-menu-position)))
- (and (misc-user-event-p result)
- (funcall (event-function result)
- (event-object result))))
- (setq pr-menu-position nil)))
-
- ;; XEmacs
- (defalias 'pr-update-mode-line 'set-menubar-dirty-flag)
-
- ;; XEmacs
- (defvar pr-ps-name-old "PostScript Printers")
- (defvar pr-txt-name-old "Text Printers")
- (defvar pr-ps-utility-old "PostScript Utility")
- (defvar pr-even-or-odd-old "Print All Pages")
-
- ;; XEmacs
- (defun pr-do-update-menus (&optional force)
- (pr-menu-alist pr-ps-printer-alist
- 'pr-ps-name
- 'pr-menu-set-ps-title
- '("Printing")
- 'pr-ps-printer-menu-modified
- force
- pr-ps-name-old
- 'postscript 2)
- (pr-menu-alist pr-txt-printer-alist
- 'pr-txt-name
- 'pr-menu-set-txt-title
- '("Printing")
- 'pr-txt-printer-menu-modified
- force
- pr-txt-name-old
- 'text 2)
- (let ((save-var pr-ps-utility-menu-modified))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("Printing" "PostScript Print" "File")
- 'save-var
- force
- pr-ps-utility-old
- nil 1))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("Printing" "PostScript Preview" "File")
- 'pr-ps-utility-menu-modified
- force
- pr-ps-utility-old
- nil 1)
- (pr-even-or-odd-pages ps-even-or-odd-pages force))
-
- ;; XEmacs
- (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
- entry index)
- (when (and alist (or force (symbol-value modified-sym)))
- (pr-xemacs-global-menubar
- (add-submenu menu-path
- (pr-menu-create name alist var-sym
- fun entry index)))
- (funcall fun (symbol-value var-sym))
- (set modified-sym nil)))
-
- ;; XEmacs
- (defun pr-relabel-menu-item (newname var-sym)
- (pr-xemacs-global-menubar
- (relabel-menu-item
- (list "Printing" (symbol-value var-sym))
- newname)
- (set var-sym newname)))
-
- ;; XEmacs
- (defun pr-menu-set-ps-title (value &optional item entry index)
- (pr-relabel-menu-item (format "PostScript Printer: %s" value)
- 'pr-ps-name-old)
- (pr-ps-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
-
- ;; XEmacs
- (defun pr-menu-set-txt-title (value &optional item entry index)
- (pr-relabel-menu-item (format "Text Printer: %s" value)
- 'pr-txt-name-old)
- (pr-txt-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
-
- ;; XEmacs
- (defun pr-menu-set-utility-title (value &optional item entry index)
- (pr-xemacs-global-menubar
- (let ((newname (format "%s" value)))
- (relabel-menu-item
- (list "Printing" "PostScript Print" "File" pr-ps-utility-old)
- newname)
- (relabel-menu-item
- (list "Printing" "PostScript Preview" "File" pr-ps-utility-old)
- newname)
- (setq pr-ps-utility-old newname)))
- (pr-ps-set-utility value)
- (and index
- (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
-
- ;; XEmacs
- (defun pr-even-or-odd-pages (value &optional no-lock)
- (pr-relabel-menu-item (cdr (assq value pr-even-or-odd-alist))
- 'pr-even-or-odd-old)
- (setq ps-even-or-odd-pages value)
- (or no-lock
- (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
-
- )
- (t ; GNU Emacs
- ;; Do nothing
- )) ; end cond featurep
+;; GNU Emacs Definitions
+(defun pr-keep-region-active ()
+ (setq deactivate-mark nil))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; GNU Emacs Definitions
+(defun pr-region-active-p ()
+ (and pr-auto-region (use-region-p)))
-(eval-and-compile
- (unless (featurep 'xemacs)
- (defvar pr-menu-bar nil
- "Specify Printing menu-bar entry.")))
-
-(cond
- ((featurep 'xemacs) ; XEmacs
- ;; Do nothing
- )
- (t ; GNU Emacs
- ;; GNU Emacs
- (defalias 'pr-set-keymap-parents 'set-keymap-parent)
- (defalias 'pr-set-keymap-name 'ignore)
- (defalias 'pr-read-string 'read-string)
-
- ;; GNU Emacs
- (defvar deactivate-mark)
-
- ;; GNU Emacs
- (defun pr-keep-region-active ()
- (setq deactivate-mark nil))
-
- ;; GNU Emacs
- (defun pr-region-active-p ()
- (and pr-auto-region transient-mark-mode mark-active))
-
- ;; GNU Emacs
- (defun pr-menu-char-height ()
- (frame-char-height))
-
- ;; GNU Emacs
- (defun pr-menu-char-width ()
- (frame-char-width))
-
- ;; GNU Emacs
- ;; Menu binding
- ;; Replace existing "print" item by "Printing" item.
- ;; If you're changing this file, you'll load it a second,
- ;; third... time, but "print" item exists only in the first load.
- (eval-when-compile
- (require 'easymenu)) ; to avoid compilation gripes
-
- (declare-function easy-menu-add-item "easymenu"
- (map path item &optional before))
- (declare-function easy-menu-remove-item "easymenu" (map path name))
-
- (eval-and-compile
- (defun pr-global-menubar (pr-menu-spec)
- (require 'easymenu)
- (let ((menu-file (if (= emacs-major-version 21)
- '("menu-bar" "files") ; GNU Emacs 21
- '("menu-bar" "file")))) ; GNU Emacs 22 or higher
- (cond
- (pr-menu-print-item
- (easy-menu-add-item global-map menu-file
- (easy-menu-create-menu "Print" pr-menu-spec)
- "print-buffer")
- (dolist (item '("print-buffer" "print-region"
- "ps-print-buffer-faces" "ps-print-region-faces"
- "ps-print-buffer" "ps-print-region"))
- (easy-menu-remove-item global-map menu-file item))
- (setq pr-menu-print-item nil
- pr-menu-bar (vector 'menu-bar
- (pr-get-symbol (nth 1 menu-file))
- (pr-get-symbol "Print"))))
- (t
- (easy-menu-add-item global-map menu-file
- (easy-menu-create-menu "Print" pr-menu-spec)))
- ))))
-
- (eval-and-compile
+;; Menu binding
+;; Replace existing "print" item by "Printing" item.
+;; If you're changing this file, you'll load it a second,
+;; third... time, but "print" item exists only in the first load.
+
+(defvar pr-menu-bar nil
+ "Specify Printing menu-bar entry.")
+
+(defun pr-global-menubar (menu-spec)
+ (let ((menu-file '("menu-bar" "file")))
(cond
- (lpr-windows-system
- ;; GNU Emacs for Windows 9x/NT
- (defun pr-menu-position (entry index horizontal)
- (let ((pos (cdr (mouse-pixel-position))))
- (list
- (list (or (car pos) 0) ; X
- (- (or (cdr pos) 0) ; Y
- (* (pr-menu-index entry index) pr-menu-char-height)))
- (selected-frame)))) ; frame
- )
+ (pr-menu-print-item
+ (easy-menu-add-item global-map menu-file
+ (easy-menu-create-menu "Print" menu-spec)
+ "print-buffer")
+ (dolist (item '("print-buffer" "print-region"
+ "ps-print-buffer-faces" "ps-print-region-faces"
+ "ps-print-buffer" "ps-print-region"))
+ (easy-menu-remove-item global-map menu-file item))
+ (setq pr-menu-print-item nil
+ pr-menu-bar (vector 'menu-bar
+ (easy-menu-intern (nth 1 menu-file))
+ (easy-menu-intern "Print"))))
(t
- ;; GNU Emacs
- (defun pr-menu-position (entry index horizontal)
- (let ((pos (cdr (mouse-pixel-position))))
- (list
- (list (- (or (car pos) 0) ; X
- (* horizontal pr-menu-char-width))
- (- (or (cdr pos) 0) ; Y
- (* (pr-menu-index entry index) pr-menu-char-height)))
- (selected-frame)))) ; frame
- )))
-
- (defvar pr-menu-position nil)
- (defvar pr-menu-state nil)
-
- ;; GNU Emacs
- (defun pr-menu-lookup (path)
- (lookup-key global-map
- (if path
- (vconcat pr-menu-bar
- (mapcar 'pr-get-symbol
- (if (listp path)
- path
- (list path))))
- pr-menu-bar)))
-
- ;; GNU Emacs
- (defun pr-menu-lock (entry index horizontal state path)
- (when pr-menu-lock
- (or (and pr-menu-position (eq state pr-menu-state))
- (setq pr-menu-position (pr-menu-position entry index horizontal)
- pr-menu-state state))
- (let* ((menu (pr-menu-lookup path))
- (result (x-popup-menu pr-menu-position menu)))
- (and result
- (let ((command (lookup-key menu (vconcat result))))
- (if (fboundp command)
- (funcall command)
- (eval command)))))
- (setq pr-menu-position nil)))
-
- ;; GNU Emacs
- (defalias 'pr-update-mode-line 'force-mode-line-update)
-
- ;; GNU Emacs
- (defun pr-do-update-menus (&optional force)
- (pr-menu-alist pr-ps-printer-alist
- 'pr-ps-name
- 'pr-menu-set-ps-title
- "PostScript Printers"
- 'pr-ps-printer-menu-modified
- force
- "PostScript Printers"
- 'postscript 2)
- (pr-menu-alist pr-txt-printer-alist
- 'pr-txt-name
- 'pr-menu-set-txt-title
- "Text Printers"
- 'pr-txt-printer-menu-modified
- force
- "Text Printers"
- 'text 2)
- (let ((save-var pr-ps-utility-menu-modified))
- (pr-menu-alist pr-ps-utility-alist
- 'pr-ps-utility
- 'pr-menu-set-utility-title
- '("PostScript Print" "File" "PostScript Utility")
- 'save-var
- force
- "PostScript Utility"
- nil 1))
+ (easy-menu-add-item global-map menu-file
+ (easy-menu-create-menu "Print" menu-spec)))
+ )))
+
+(defun pr-menu-position (entry index horizontal)
+ (let ((pos (cdr (mouse-pixel-position))))
+ (list
+ (list (- (or (car pos) 0) ; X
+ (if lpr-windows-system
+ 0 ;; GNU Emacs for Windows 9x/NT
+ (* horizontal pr-menu-char-width)))
+ (- (or (cdr pos) 0) ; Y
+ (* (pr-menu-index entry index) pr-menu-char-height)))
+ (selected-frame)))) ; frame
+
+(defvar pr-menu-position nil)
+(defvar pr-menu-state nil)
+
+(defun pr-menu-lookup (path)
+ (lookup-key global-map
+ (if path
+ (vconcat pr-menu-bar
+ (mapcar #'easy-menu-intern
+ (if (listp path)
+ path
+ (list path))))
+ pr-menu-bar)))
+
+(defun pr-menu-lock (entry index horizontal state path)
+ (when pr-menu-lock
+ (or (and pr-menu-position (eq state pr-menu-state))
+ (setq pr-menu-position (pr-menu-position entry index horizontal)
+ pr-menu-state state))
+ (let* ((menu (pr-menu-lookup path))
+ (result (x-popup-menu pr-menu-position menu)))
+ (and result
+ (let ((command (lookup-key menu (vconcat result))))
+ (if (fboundp command)
+ (funcall command)
+ (eval command)))))
+ (setq pr-menu-position nil)))
+
+(defun pr-do-update-menus (&optional force)
+ (pr-menu-alist pr-ps-printer-alist
+ 'pr-ps-name
+ #'pr-menu-set-ps-title
+ "PostScript Printers"
+ 'pr-ps-printer-menu-modified
+ force
+ "PostScript Printers"
+ 'postscript 2)
+ (pr-menu-alist pr-txt-printer-alist
+ 'pr-txt-name
+ #'pr-menu-set-txt-title
+ "Text Printers"
+ 'pr-txt-printer-menu-modified
+ force
+ "Text Printers"
+ 'text 2)
+ (defvar pr--save-var)
+ (let ((pr--save-var pr-ps-utility-menu-modified))
(pr-menu-alist pr-ps-utility-alist
'pr-ps-utility
- 'pr-menu-set-utility-title
- '("PostScript Preview" "File" "PostScript Utility")
- 'pr-ps-utility-menu-modified
+ #'pr-menu-set-utility-title
+ '("PostScript Print" "File" "PostScript Utility")
+ 'pr--save-var
force
"PostScript Utility"
- nil 1)
- (pr-even-or-odd-pages ps-even-or-odd-pages force))
-
- ;; GNU Emacs
- (defun pr-menu-get-item (name-list)
- ;; NAME-LIST is a string or a list of strings.
- (or (listp name-list)
- (setq name-list (list name-list)))
- (and name-list
- (let* ((reversed (reverse name-list))
- (name (pr-get-symbol (car reversed)))
- (path (nreverse (cdr reversed)))
- (menu (lookup-key
- global-map
- (vconcat pr-menu-bar
- (mapcar 'pr-get-symbol path)))))
- (assq name (nthcdr 2 menu)))))
-
- ;; GNU Emacs
- (defvar pr-temp-menu nil)
-
- ;; GNU Emacs
- (defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
- entry index)
- (when (and alist (or force (symbol-value modified-sym)))
- (easy-menu-define pr-temp-menu nil ""
- (pr-menu-create name alist var-sym fun entry index))
- (let ((item (pr-menu-get-item menu-path)))
- (and item
- (let* ((binding (nthcdr 3 item))
- (key-binding (cdr binding)))
- (setcar binding pr-temp-menu)
- (and key-binding (listp (car key-binding))
- (setcdr binding (cdr key-binding))) ; skip KEY-BINDING
- (funcall fun (symbol-value var-sym) item))))
- (set modified-sym nil)))
-
- ;; GNU Emacs
- (defun pr-menu-set-item-name (item name)
- (and item
- (setcar (nthcdr 2 item) name))) ; ITEM-NAME
-
- ;; GNU Emacs
- (defun pr-menu-set-ps-title (value &optional item entry index)
- (pr-menu-set-item-name (or item
- (pr-menu-get-item "PostScript Printers"))
- (format "PostScript Printer: %s" value))
- (pr-ps-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
-
- ;; GNU Emacs
- (defun pr-menu-set-txt-title (value &optional item entry index)
- (pr-menu-set-item-name (or item
- (pr-menu-get-item "Text Printers"))
- (format "Text Printer: %s" value))
- (pr-txt-set-printer value)
- (and index
- (pr-menu-lock entry index 12 'toggle nil)))
-
- ;; GNU Emacs
- (defun pr-menu-set-utility-title (value &optional item entry index)
- (let ((name (symbol-name value)))
- (if item
- (pr-menu-set-item-name item name)
- (pr-menu-set-item-name
- (pr-menu-get-item
- '("PostScript Print" "File" "PostScript Utility"))
- name)
- (pr-menu-set-item-name
- (pr-menu-get-item
- '("PostScript Preview" "File" "PostScript Utility"))
- name)))
- (pr-ps-set-utility value)
- (and index
- (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
-
- ;; GNU Emacs
- (defun pr-even-or-odd-pages (value &optional no-lock)
- (pr-menu-set-item-name (pr-menu-get-item "Print All Pages")
- (cdr (assq value pr-even-or-odd-alist)))
- (setq ps-even-or-odd-pages value)
- (or no-lock
- (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
-
- )) ; end cond featurep
-
+ nil 1))
+ (pr-menu-alist pr-ps-utility-alist
+ 'pr-ps-utility
+ #'pr-menu-set-utility-title
+ '("PostScript Preview" "File" "PostScript Utility")
+ 'pr-ps-utility-menu-modified
+ force
+ "PostScript Utility"
+ nil 1)
+ (pr-even-or-odd-pages ps-even-or-odd-pages force))
+
+(defun pr-menu-get-item (name-list)
+ ;; NAME-LIST is a string or a list of strings.
+ (or (listp name-list)
+ (setq name-list (list name-list)))
+ (and name-list
+ (let* ((reversed (reverse name-list))
+ (name (easy-menu-intern (car reversed)))
+ (path (nreverse (cdr reversed)))
+ (menu (lookup-key
+ global-map
+ (vconcat pr-menu-bar
+ (mapcar #'easy-menu-intern path)))))
+ (assq name (nthcdr 2 menu)))))
+
+(defvar pr-temp-menu nil)
+
+(defun pr-menu-alist (alist var-sym fun menu-path modified-sym force name
+ entry index)
+ (when (and alist (or force (symbol-value modified-sym)))
+ (easy-menu-define pr-temp-menu nil ""
+ (pr-menu-create name alist var-sym fun entry index))
+ (let ((item (pr-menu-get-item menu-path)))
+ (and item
+ (progn
+ (setf (nth 3 item) pr-temp-menu)
+ (funcall fun (symbol-value var-sym) item))))
+ (set modified-sym nil)))
+
+(defun pr-menu-set-item-name (item name)
+ (and item
+ (setcar (nthcdr 2 item) name))) ; ITEM-NAME
+
+(defun pr-menu-set-ps-title (value &optional item entry index)
+ (pr-menu-set-item-name (or item
+ (pr-menu-get-item "PostScript Printers"))
+ (format "PostScript Printer: %s" value))
+ (pr-ps-set-printer value)
+ (and index
+ (pr-menu-lock entry index 12 'toggle nil)))
+
+(defun pr-menu-set-txt-title (value &optional item entry index)
+ (pr-menu-set-item-name (or item
+ (pr-menu-get-item "Text Printers"))
+ (format "Text Printer: %s" value))
+ (pr-txt-set-printer value)
+ (and index
+ (pr-menu-lock entry index 12 'toggle nil)))
+
+(defun pr-menu-set-utility-title (value &optional item entry index)
+ (let ((name (symbol-name value)))
+ (if item
+ (pr-menu-set-item-name item name)
+ (pr-menu-set-item-name
+ (pr-menu-get-item
+ '("PostScript Print" "File" "PostScript Utility"))
+ name)
+ (pr-menu-set-item-name
+ (pr-menu-get-item
+ '("PostScript Preview" "File" "PostScript Utility"))
+ name)))
+ (pr-ps-set-utility value)
+ (and index
+ (pr-menu-lock entry index 5 nil '("PostScript Print" "File"))))
+
+(defun pr-even-or-odd-pages (value &optional no-lock)
+ (pr-menu-set-item-name (pr-menu-get-item "Print All Pages")
+ (cdr (assq value pr-even-or-odd-alist)))
+ (setq ps-even-or-odd-pages value)
+ (or no-lock
+ (pr-menu-lock 'postscript-options 8 12 'toggle nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal Functions (I)
-(defun pr-dosify-file-name (path)
+(defun pr-dosify-file-name (filename)
"Replace unix-style directory separator character with dos/windows one."
- (interactive "sPath: ")
- (if (eq pr-path-style 'windows)
- (subst-char-in-string ?/ ?\\ path)
- path))
-
+ (if (eq pr-filename-style 'windows)
+ (subst-char-in-string ?/ ?\\ filename)
+ filename))
-(defun pr-unixify-file-name (path)
- "Replace dos/windows-style directory separator character with unix one."
- (interactive "sPath: ")
- (if (eq pr-path-style 'windows)
- (subst-char-in-string ?\\ ?/ path)
- path))
-
-
-(defun pr-standard-file-name (path)
+(defun pr-standard-file-name (filename)
"Ensure the proper directory separator depending on the OS.
That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
separator; otherwise, ensure unix-style directory separator."
+ ;; FIXME: Why not use pr-dosify-file-name?
(if (or pr-cygwin-system lpr-windows-system)
- (subst-char-in-string ?/ ?\\ path)
- (subst-char-in-string ?\\ ?/ path)))
-
+ (subst-char-in-string ?/ ?\\ filename)
+ filename))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization Functions
@@ -1672,22 +1313,21 @@ separator; otherwise, ensure unix-style directory
separator."
:group 'postscript)
-(defcustom pr-path-style
+(defcustom pr-filename-style
(if (and (not pr-cygwin-system)
lpr-windows-system)
'windows
'unix)
- "Specify which path style to use for external commands.
+ "Specify which filename style to use for external commands.
Valid values are:
windows Windows 9x/NT style (\\)
unix Unix style (/)"
- :type '(choice :tag "Path style"
+ :type '(choice :tag "Filename style"
(const :tag "Windows 9x/NT Style (\\)" :value windows)
- (const :tag "Unix Style (/)" :value unix))
- :group 'printing)
+ (const :tag "Unix Style (/)" :value unix)))
(defcustom pr-path-alist
@@ -1708,13 +1348,13 @@ Where:
ENTRY It's a symbol, used to identify this entry.
There must exist at least one of the following entries:
- unix this entry is used when Emacs is running on GNU or
+ `unix' this entry is used when Emacs is running on GNU or
Unix system.
- cygwin this entry is used when Emacs is running on Windows
+ `cygwin' this entry is used when Emacs is running on
Windows
95/98/NT/2000 with Cygwin.
- windows this entry is used when Emacs is running on Windows
+ `windows' this entry is used when Emacs is running on
Windows
95/98/NT/2000.
DIRECTORY It should be a string or a symbol. If it's a symbol, it should
@@ -1764,8 +1404,7 @@ Examples:
(choice :menu-tag "Directory"
:tag "Directory"
(string :value "")
- (symbol :value symbol)))))
- :group 'printing)
+ (symbol :value symbol))))))
(defcustom pr-txt-name 'default
@@ -1778,8 +1417,7 @@ This variable should be modified by customization engine.
If this variable is
modified by other means (for example, a lisp function), use `pr-update-menus'
function (see it for documentation) to update text printer menu."
:type 'symbol
- :set 'pr-txt-name-custom-set
- :group 'printing)
+ :set 'pr-txt-name-custom-set)
(defcustom pr-txt-printer-alist
@@ -1910,8 +1548,7 @@ Useful links:
:tag "Printer Name"
(const :tag "None" nil)
string)))
- :set 'pr-alist-custom-set
- :group 'printing)
+ :set 'pr-alist-custom-set)
(defcustom pr-ps-name 'default
@@ -1924,8 +1561,7 @@ This variable should be modified by customization engine.
If this variable is
modified by other means (for example, a lisp function), use `pr-update-menus'
function (see it for documentation) to update PostScript printer menu."
:type 'symbol
- :set 'pr-ps-name-custom-set
- :group 'printing)
+ :set 'pr-ps-name-custom-set)
(defcustom pr-ps-printer-alist
@@ -2196,33 +1832,21 @@ Useful links:
(variable :tag "Other"))
(sexp :tag "Value")))
))
- :set 'pr-alist-custom-set
- :group 'printing)
-
-
-(defcustom pr-temp-dir
- (pr-dosify-file-name
- (if (boundp 'temporary-file-directory)
- (symbol-value 'temporary-file-directory)
- ;; hacked from `temporary-file-directory' variable in files.el
- (file-name-as-directory
- (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
- (cond (lpr-windows-system "c:/temp")
- (t "/tmp")
- )))))
+ :set 'pr-alist-custom-set)
+
+
+(defcustom pr-temp-dir temporary-file-directory
"Specify a directory for temporary files during printing.
See also `pr-ps-temp-file' and `pr-file-modes'."
- :type '(directory :tag "Temporary Directory")
- :group 'printing)
+ :type '(directory :tag "Temporary Directory"))
(defcustom pr-ps-temp-file "prspool-"
"Specify PostScript temporary file name prefix.
See also `pr-temp-dir' and `pr-file-modes'."
- :type '(file :tag "PostScript Temporary File Name")
- :group 'printing)
+ :type '(file :tag "PostScript Temporary File Name"))
;; It uses 0600 as default instead of (default-file-modes).
@@ -2234,8 +1858,7 @@ See also `pr-temp-dir' and `pr-file-modes'."
It should be an integer; only the low 9 bits are used.
See also `pr-temp-dir' and `pr-ps-temp-file'."
- :type '(integer :tag "File Permission Bits")
- :group 'printing)
+ :type '(integer :tag "File Permission Bits"))
(defcustom pr-gv-command
@@ -2275,8 +1898,7 @@ Useful links:
* MacGSView (Mac OS)
`http://www.cs.wisc.edu/~ghost/macos/index.htm'
"
- :type '(string :tag "Ghostview Utility")
- :group 'printing)
+ :type '(string :tag "Ghostview Utility"))
(defcustom pr-gs-command
@@ -2301,8 +1923,7 @@ Useful links:
* Printer compatibility
`http://www.cs.wisc.edu/~ghost/doc/printer.htm'
"
- :type '(string :tag "Ghostscript Utility")
- :group 'printing)
+ :type '(string :tag "Ghostscript Utility"))
(defcustom pr-gs-switches
@@ -2343,8 +1964,7 @@ Useful links:
* Printer compatibility
`http://www.cs.wisc.edu/~ghost/doc/printer.htm'
"
- :type '(repeat (string :tag "Ghostscript Switch"))
- :group 'printing)
+ :type '(repeat (string :tag "Ghostscript Switch")))
(defcustom pr-gs-device
@@ -2359,8 +1979,7 @@ A note on the gs switches:
See `pr-gs-switches' for documentation.
See also `pr-ps-printer-alist'."
- :type '(string :tag "Ghostscript Device")
- :group 'printing)
+ :type '(string :tag "Ghostscript Device"))
(defcustom pr-gs-resolution 300
@@ -2372,8 +1991,7 @@ A note on the gs switches:
See `pr-gs-switches' for documentation.
See also `pr-ps-printer-alist'."
- :type '(integer :tag "Ghostscript Resolution")
- :group 'printing)
+ :type '(integer :tag "Ghostscript Resolution"))
(defcustom pr-print-using-ghostscript nil
@@ -2384,32 +2002,27 @@ ghostscript to print a PostScript file.
In GNU or Unix system, if ghostscript is set as a PostScript filter, this
variable should be nil."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-faces-p nil
"Non-nil means print with face attributes."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-spool-p nil
"Non-nil means spool printing in a buffer."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-file-landscape nil
"Non-nil means print PostScript file in landscape orientation."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-file-duplex nil
"Non-nil means print PostScript file in duplex mode."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-file-tumble nil
@@ -2419,8 +2032,7 @@ If tumble is off, produces a printing suitable for
binding on the left or
right.
If tumble is on, produces a printing suitable for binding at the top or
bottom."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-auto-region t
@@ -2431,8 +2043,7 @@ Note that this will only work if you're using transient
mark mode.
When this variable is non-nil, the `*-buffer*' commands will behave like
`*-region*' commands, that is, `*-buffer*' commands will print only the region
marked instead of all buffer."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-auto-mode t
@@ -2442,8 +2053,7 @@ That is, if current major-mode is declared in
`pr-mode-alist', the `*-buffer*'
and `*-region*' commands will behave like `*-mode*' commands; otherwise,
`*-buffer*' commands will print the current buffer and `*-region*' commands
will print the current region."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-mode-alist
@@ -2642,8 +2252,7 @@ DEFAULT It's a way to set default values when
this entry is selected.
(const :tag "inherits-from:" inherits-from:)
(variable :tag "Other"))
(sexp :tag "Value")))
- ))
- :group 'printing)
+ )))
(defcustom pr-ps-utility 'mpage
@@ -2659,8 +2268,7 @@ function (see it for documentation) to update PostScript
utility menu.
NOTE: Don't forget to download and install the utilities declared on
`pr-ps-utility-alist'."
:type '(symbol :tag "PS File Utility")
- :set 'pr-ps-utility-custom-set
- :group 'printing)
+ :set 'pr-ps-utility-custom-set)
(defcustom pr-ps-utility-alist
@@ -2871,38 +2479,34 @@ Useful links:
(variable :tag "Other"))
(sexp :tag "Value")))
))
- :set 'pr-alist-custom-set
- :group 'printing)
+ :set 'pr-alist-custom-set)
(defcustom pr-menu-lock t
"Non-nil means menu is locked while selecting toggle options.
See also `pr-menu-char-height' and `pr-menu-char-width'."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
-(defcustom pr-menu-char-height (pr-menu-char-height)
+(defcustom pr-menu-char-height (frame-char-height)
"Specify menu char height in pixels.
This variable is used to guess which vertical position should be locked the
menu, so don't forget to adjust it if menu position is not ok.
See also `pr-menu-lock' and `pr-menu-char-width'."
- :type 'integer
- :group 'printing)
+ :type 'integer)
-(defcustom pr-menu-char-width (pr-menu-char-width)
+(defcustom pr-menu-char-width (frame-char-width)
"Specify menu char width in pixels.
This variable is used to guess which horizontal position should be locked the
menu, so don't forget to adjust it if menu position is not ok.
See also `pr-menu-lock' and `pr-menu-char-height'."
- :type 'integer
- :group 'printing)
+ :type 'integer)
(defcustom pr-setting-database
@@ -3017,8 +2621,7 @@ SETTING It's a cons like:
(const :tag "Ghostscript Resolution" pr-gs-resolution)
(variable :tag "Other"))
(sexp :tag "Value")))
- ))
- :group 'printing)
+ )))
(defcustom pr-visible-entry-list
@@ -3070,8 +2673,7 @@ Any other value is ignored."
(const postscript-options)
(const postscript-process)
(const printing)
- (const help)))
- :group 'printing)
+ (const help))))
(defcustom pr-delete-temp-file t
@@ -3081,8 +2683,7 @@ Set `pr-delete-temp-file' to nil, if the following
message (or a similar)
happens when printing:
Error: could not open \"c:\\temp\\prspool.ps\" for reading."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-list-directory nil
@@ -3094,16 +2695,14 @@ argument of functions below) are also printed (as
dired-mode listings).
It's used by `pr-ps-directory-preview', `pr-ps-directory-using-ghostscript',
`pr-ps-directory-print', `pr-ps-directory-ps-print', `pr-printify-directory'
and `pr-txt-directory'."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
(defcustom pr-buffer-name "*Printing Interface*"
"Specify the name of the buffer interface for printing package.
It's used by `pr-interface'."
- :type 'string
- :group 'printing)
+ :type 'string)
(defcustom pr-buffer-name-ignore
@@ -3115,16 +2714,14 @@ NOTE: Case is important for matching, that is,
`case-fold-search' is always
nil.
It's used by `pr-interface'."
- :type '(repeat (regexp :tag "Buffer Name Regexp"))
- :group 'printing)
+ :type '(repeat (regexp :tag "Buffer Name Regexp")))
(defcustom pr-buffer-verbose t
"Non-nil means to be verbose when editing a field in interface buffer.
It's used by `pr-interface'."
- :type 'boolean
- :group 'printing)
+ :type 'boolean)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3167,15 +2764,6 @@ See `pr-ps-printer-alist'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Macros
-
-
-(defmacro pr-save-file-modes (&rest body)
- "Execute BODY with file permissions temporarily set to `pr-file-modes'."
- (declare (obsolete with-file-modes "25.1"))
- `(with-file-modes pr-file-modes ,@body))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keys & Menus
@@ -3195,252 +2783,211 @@ See `pr-ps-printer-alist'.")
(and pr-print-using-ghostscript (not pr-spool-p)))
-(defalias 'pr-get-symbol
- (if (featurep 'emacs) 'easy-menu-intern ; since 22.1
- (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el
- 'easy-menu-intern
- (lambda (s) (if (stringp s) (intern s) s)))))
-
-
(defconst pr-menu-spec
- ;; Menu mapping:
- ;; unfortunately XEmacs doesn't support :active for submenus,
- ;; only for items.
- ;; So, it uses :included instead of :active.
- ;; Also, XEmacs doesn't support :help tag.
- (let ((pr-:active (if (featurep 'xemacs)
- :included ; XEmacs
- :active)) ; GNU Emacs
- (pr-:help (if (featurep 'xemacs)
- 'ignore ; XEmacs
- #'(lambda (text) (list :help text))))) ; GNU Emacs
- `(
- ["Printing Interface" pr-interface
- ,@(funcall
- pr-:help "Use buffer interface instead of menu interface")]
+ '(
+ ["Printing Interface" pr-interface
+ :help "Use buffer interface instead of menu interface"]
+ "--"
+ ("PostScript Preview" :included (pr-visible-p 'postscript)
+ :help "Preview PostScript instead of sending to printer"
+ ("Directory" :active (not pr-spool-p)
+ ["1-up" (pr-ps-directory-preview 1 nil nil t) t]
+ ["2-up" (pr-ps-directory-preview 2 nil nil t) t]
+ ["4-up" (pr-ps-directory-preview 4 nil nil t) t]
+ ["Other..." (pr-ps-directory-preview nil nil nil t)
+ :keys "\\[pr-ps-buffer-preview]"])
+ ("Buffer" :active (not pr-spool-p)
+ ["1-up" (pr-ps-buffer-preview 1 t) t]
+ ["2-up" (pr-ps-buffer-preview 2 t) t]
+ ["4-up" (pr-ps-buffer-preview 4 t) t]
+ ["Other..." (pr-ps-buffer-preview nil t)
+ :keys "\\[pr-ps-buffer-preview]"])
+ ("Region" :active (and (not pr-spool-p) (ps-mark-active-p))
+ ["1-up" (pr-ps-region-preview 1 t) t]
+ ["2-up" (pr-ps-region-preview 2 t) t]
+ ["4-up" (pr-ps-region-preview 4 t) t]
+ ["Other..." (pr-ps-region-preview nil t)
+ :keys "\\[pr-ps-region-preview]"])
+ ("Mode" :active (and (not pr-spool-p) (pr-mode-alist-p))
+ ["1-up" (pr-ps-mode-preview 1 t) t]
+ ["2-up" (pr-ps-mode-preview 2 t) t]
+ ["4-up" (pr-ps-mode-preview 4 t) t]
+ ["Other..." (pr-ps-mode-preview nil t)
+ :keys "\\[pr-ps-mode-preview]"])
+ ("File"
+ ["No Preprocessing..." (call-interactively 'pr-ps-file-preview)
+ :keys "\\[pr-ps-file-preview]"
+ :help "Preview PostScript file"]
"--"
- ("PostScript Preview" :included (pr-visible-p 'postscript)
- ,@(funcall
- pr-:help "Preview PostScript instead of sending to printer")
- ("Directory" ,pr-:active (not pr-spool-p)
- ["1-up" (pr-ps-directory-preview 1 nil nil t) t]
- ["2-up" (pr-ps-directory-preview 2 nil nil t) t]
- ["4-up" (pr-ps-directory-preview 4 nil nil t) t]
- ["Other..." (pr-ps-directory-preview nil nil nil t)
- :keys "\\[pr-ps-buffer-preview]"])
- ("Buffer" ,pr-:active (not pr-spool-p)
- ["1-up" (pr-ps-buffer-preview 1 t) t]
- ["2-up" (pr-ps-buffer-preview 2 t) t]
- ["4-up" (pr-ps-buffer-preview 4 t) t]
- ["Other..." (pr-ps-buffer-preview nil t)
- :keys "\\[pr-ps-buffer-preview]"])
- ("Region" ,pr-:active (and (not pr-spool-p) (ps-mark-active-p))
- ["1-up" (pr-ps-region-preview 1 t) t]
- ["2-up" (pr-ps-region-preview 2 t) t]
- ["4-up" (pr-ps-region-preview 4 t) t]
- ["Other..." (pr-ps-region-preview nil t)
- :keys "\\[pr-ps-region-preview]"])
- ("Mode" ,pr-:active (and (not pr-spool-p) (pr-mode-alist-p))
- ["1-up" (pr-ps-mode-preview 1 t) t]
- ["2-up" (pr-ps-mode-preview 2 t) t]
- ["4-up" (pr-ps-mode-preview 4 t) t]
- ["Other..." (pr-ps-mode-preview nil t)
- :keys "\\[pr-ps-mode-preview]"])
- ("File"
- ["No Preprocessing..." (call-interactively 'pr-ps-file-preview)
- :keys "\\[pr-ps-file-preview]"
- ,@(funcall
- pr-:help "Preview PostScript file")]
- "--"
- ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
- ,@(funcall
- pr-:help "Select PostScript utility")]
- "--"
- ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist]
- ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist]
- ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist]
- ["Other..." (pr-ps-file-up-preview nil t t)
- :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist]
- "--"
- ["Landscape" pr-toggle-file-landscape-menu
- :style toggle :selected pr-file-landscape
- ,@(funcall
- pr-:help "Toggle landscape for PostScript file")
- :active pr-ps-utility-alist]
- ["Duplex" pr-toggle-file-duplex-menu
- :style toggle :selected pr-file-duplex
- ,@(funcall
- pr-:help "Toggle duplex for PostScript file")
- :active pr-ps-utility-alist]
- ["Tumble" pr-toggle-file-tumble-menu
- :style toggle :selected pr-file-tumble
- ,@(funcall
- pr-:help "Toggle tumble for PostScript file")
- :active (and pr-file-duplex pr-ps-utility-alist)])
- ["Despool..." (call-interactively 'pr-despool-preview)
- :active pr-spool-p :keys "\\[pr-despool-preview]"
- ,@(funcall
- pr-:help "Despool PostScript buffer to printer or file (C-u)")])
- ("PostScript Print" :included (pr-visible-p 'postscript)
- ,@(funcall
- pr-:help "Send PostScript to printer or file (C-u)")
- ("Directory"
- ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t]
- ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t]
- ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t]
- ["Other..." (pr-ps-directory-ps-print nil nil nil t)
- :keys "\\[pr-ps-buffer-ps-print]"])
- ("Buffer"
- ["1-up" (pr-ps-buffer-ps-print 1 t) t]
- ["2-up" (pr-ps-buffer-ps-print 2 t) t]
- ["4-up" (pr-ps-buffer-ps-print 4 t) t]
- ["Other..." (pr-ps-buffer-ps-print nil t)
- :keys "\\[pr-ps-buffer-ps-print]"])
- ("Region" ,pr-:active (ps-mark-active-p)
- ["1-up" (pr-ps-region-ps-print 1 t) t]
- ["2-up" (pr-ps-region-ps-print 2 t) t]
- ["4-up" (pr-ps-region-ps-print 4 t) t]
- ["Other..." (pr-ps-region-ps-print nil t)
- :keys "\\[pr-ps-region-ps-print]"])
- ("Mode" ,pr-:active (pr-mode-alist-p)
- ["1-up" (pr-ps-mode-ps-print 1 t) t]
- ["2-up" (pr-ps-mode-ps-print 2 t) t]
- ["4-up" (pr-ps-mode-ps-print 4 t) t]
- ["Other..." (pr-ps-mode-ps-print nil t)
- :keys "\\[pr-ps-mode-ps-print]"])
- ("File"
- ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print)
- :keys "\\[pr-ps-file-ps-print]"
- ,@(funcall
- pr-:help "Send PostScript file to printer")]
- "--"
- ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
- ,@(funcall
- pr-:help "Select PostScript utility")]
- "--"
- ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist]
- ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist]
- ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist]
- ["Other..." (pr-ps-file-up-ps-print nil t t)
- :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist]
- "--"
- ["Landscape" pr-toggle-file-landscape-menu
- :style toggle :selected pr-file-landscape
- ,@(funcall
- pr-:help "Toggle landscape for PostScript file")
- :active pr-ps-utility-alist]
- ["Duplex" pr-toggle-file-duplex-menu
- :style toggle :selected pr-file-duplex
- ,@(funcall
- pr-:help "Toggle duplex for PostScript file")
- :active pr-ps-utility-alist]
- ["Tumble" pr-toggle-file-tumble-menu
- :style toggle :selected pr-file-tumble
- ,@(funcall
- pr-:help "Toggle tumble for PostScript file")
- :active (and pr-file-duplex pr-ps-utility-alist)])
- ["Despool..." (call-interactively 'pr-despool-ps-print)
- :active pr-spool-p :keys "\\[pr-despool-ps-print]"
- ,@(funcall
- pr-:help "Despool PostScript buffer to printer or file (C-u)")])
- ["PostScript Printers" pr-update-menus
- :active pr-ps-printer-alist :included (pr-visible-p 'postscript)
- ,@(funcall
- pr-:help "Select PostScript printer")]
+ ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
+ :help "Select PostScript utility"]
"--"
- ("Printify" :included (pr-visible-p 'text)
- ,@(funcall
- pr-:help
- "Replace non-printing chars with printable representations.")
- ["Directory" pr-printify-directory t]
- ["Buffer" pr-printify-buffer t]
- ["Region" pr-printify-region (ps-mark-active-p)])
- ("Print" :included (pr-visible-p 'text)
- ,@(funcall
- pr-:help "Send text to printer")
- ["Directory" pr-txt-directory t]
- ["Buffer" pr-txt-buffer t]
- ["Region" pr-txt-region (ps-mark-active-p)]
- ["Mode" pr-txt-mode (pr-mode-alist-p)])
- ["Text Printers" pr-update-menus
- :active pr-txt-printer-alist :included (pr-visible-p 'text)
- ,@(funcall
- pr-:help "Select text printer")]
+ ["1-up..." (pr-ps-file-up-preview 1 t t) pr-ps-utility-alist]
+ ["2-up..." (pr-ps-file-up-preview 2 t t) pr-ps-utility-alist]
+ ["4-up..." (pr-ps-file-up-preview 4 t t) pr-ps-utility-alist]
+ ["Other..." (pr-ps-file-up-preview nil t t)
+ :keys "\\[pr-ps-file-up-preview]" :active pr-ps-utility-alist]
"--"
- ["Landscape" pr-toggle-landscape-menu
- :style toggle :selected ps-landscape-mode
- :included (pr-visible-p 'postscript-options)]
- ["Print Header" pr-toggle-header-menu
- :style toggle :selected ps-print-header
- :included (pr-visible-p 'postscript-options)]
- ["Print Header Frame" pr-toggle-header-frame-menu
- :style toggle :selected ps-print-header-frame :active ps-print-header
- :included (pr-visible-p 'postscript-options)]
- ["Line Number" pr-toggle-line-menu
- :style toggle :selected ps-line-number
- :included (pr-visible-p 'postscript-options)]
- ["Zebra Stripes" pr-toggle-zebra-menu
- :style toggle :selected ps-zebra-stripes
- :included (pr-visible-p 'postscript-options)]
- ["Duplex" pr-toggle-duplex-menu
- :style toggle :selected ps-spool-duplex
- :included (pr-visible-p 'postscript-options)]
- ["Tumble" pr-toggle-tumble-menu
- :style toggle :selected ps-spool-tumble :active ps-spool-duplex
- :included (pr-visible-p 'postscript-options)]
- ["Upside-Down" pr-toggle-upside-down-menu
- :style toggle :selected ps-print-upside-down
- :included (pr-visible-p 'postscript-options)]
- ("Print All Pages" :included (pr-visible-p 'postscript-options)
- ,@(funcall
- pr-:help "Select odd/even pages/sheets to print")
- ["All Pages" (pr-even-or-odd-pages nil)
- :style radio :selected (eq ps-even-or-odd-pages nil)]
- ["Even Pages" (pr-even-or-odd-pages 'even-page)
- :style radio :selected (eq ps-even-or-odd-pages 'even-page)]
- ["Odd Pages" (pr-even-or-odd-pages 'odd-page)
- :style radio :selected (eq ps-even-or-odd-pages 'odd-page)]
- ["Even Sheets" (pr-even-or-odd-pages 'even-sheet)
- :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)]
- ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet)
- :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)])
+ ["Landscape" pr-toggle-file-landscape-menu
+ :style toggle :selected pr-file-landscape
+ :help "Toggle landscape for PostScript file"
+ :active pr-ps-utility-alist]
+ ["Duplex" pr-toggle-file-duplex-menu
+ :style toggle :selected pr-file-duplex
+ :help "Toggle duplex for PostScript file"
+ :active pr-ps-utility-alist]
+ ["Tumble" pr-toggle-file-tumble-menu
+ :style toggle :selected pr-file-tumble
+ :help "Toggle tumble for PostScript file"
+ :active (and pr-file-duplex pr-ps-utility-alist)])
+ ["Despool..." (call-interactively 'pr-despool-preview)
+ :active pr-spool-p :keys "\\[pr-despool-preview]"
+ :help "Despool PostScript buffer to printer or file (C-u)"])
+ ("PostScript Print" :included (pr-visible-p 'postscript)
+ :help "Send PostScript to printer or file (C-u)"
+ ("Directory"
+ ["1-up" (pr-ps-directory-ps-print 1 nil nil t) t]
+ ["2-up" (pr-ps-directory-ps-print 2 nil nil t) t]
+ ["4-up" (pr-ps-directory-ps-print 4 nil nil t) t]
+ ["Other..." (pr-ps-directory-ps-print nil nil nil t)
+ :keys "\\[pr-ps-buffer-ps-print]"])
+ ("Buffer"
+ ["1-up" (pr-ps-buffer-ps-print 1 t) t]
+ ["2-up" (pr-ps-buffer-ps-print 2 t) t]
+ ["4-up" (pr-ps-buffer-ps-print 4 t) t]
+ ["Other..." (pr-ps-buffer-ps-print nil t)
+ :keys "\\[pr-ps-buffer-ps-print]"])
+ ("Region" :active (ps-mark-active-p)
+ ["1-up" (pr-ps-region-ps-print 1 t) t]
+ ["2-up" (pr-ps-region-ps-print 2 t) t]
+ ["4-up" (pr-ps-region-ps-print 4 t) t]
+ ["Other..." (pr-ps-region-ps-print nil t)
+ :keys "\\[pr-ps-region-ps-print]"])
+ ("Mode" :active (pr-mode-alist-p)
+ ["1-up" (pr-ps-mode-ps-print 1 t) t]
+ ["2-up" (pr-ps-mode-ps-print 2 t) t]
+ ["4-up" (pr-ps-mode-ps-print 4 t) t]
+ ["Other..." (pr-ps-mode-ps-print nil t)
+ :keys "\\[pr-ps-mode-ps-print]"])
+ ("File"
+ ["No Preprocessing..." (call-interactively 'pr-ps-file-ps-print)
+ :keys "\\[pr-ps-file-ps-print]"
+ :help "Send PostScript file to printer"]
"--"
- ["Spool Buffer" pr-toggle-spool-menu
- :style toggle :selected pr-spool-p
- :included (pr-visible-p 'postscript-process)
- ,@(funcall
- pr-:help "Toggle PostScript spooling")]
- ["Print with faces" pr-toggle-faces-menu
- :style toggle :selected pr-faces-p
- :included (pr-visible-p 'postscript-process)
- ,@(funcall
- pr-:help "Toggle PostScript printing with faces")]
- ["Print via Ghostscript" pr-toggle-ghostscript-menu
- :style toggle :selected pr-print-using-ghostscript
- :included (pr-visible-p 'postscript-process)
- ,@(funcall
- pr-:help "Toggle PostScript generation using ghostscript")]
+ ["PostScript Utility" pr-update-menus :active pr-ps-utility-alist
+ :help "Select PostScript utility"]
"--"
- ["Auto Region" pr-toggle-region-menu
- :style toggle :selected pr-auto-region
- :included (pr-visible-p 'printing)]
- ["Auto Mode" pr-toggle-mode-menu
- :style toggle :selected pr-auto-mode
- :included (pr-visible-p 'printing)]
- ["Menu Lock" pr-toggle-lock-menu
- :style toggle :selected pr-menu-lock
- :included (pr-visible-p 'printing)]
+ ["1-up..." (pr-ps-file-up-ps-print 1 t t) pr-ps-utility-alist]
+ ["2-up..." (pr-ps-file-up-ps-print 2 t t) pr-ps-utility-alist]
+ ["4-up..." (pr-ps-file-up-ps-print 4 t t) pr-ps-utility-alist]
+ ["Other..." (pr-ps-file-up-ps-print nil t t)
+ :keys "\\[pr-ps-file-up-ps-print]" :active pr-ps-utility-alist]
"--"
- ("Customize" :included (pr-visible-p 'help)
- ["printing" pr-customize t]
- ["ps-print" ps-print-customize t]
- ["lpr" lpr-customize t])
- ("Show Settings" :included (pr-visible-p 'help)
- ["printing" pr-show-pr-setup t]
- ["ps-print" pr-show-ps-setup t]
- ["lpr" pr-show-lpr-setup t])
- ["Help" pr-help :active t :included (pr-visible-p 'help)]
- )))
+ ["Landscape" pr-toggle-file-landscape-menu
+ :style toggle :selected pr-file-landscape
+ :help "Toggle landscape for PostScript file"
+ :active pr-ps-utility-alist]
+ ["Duplex" pr-toggle-file-duplex-menu
+ :style toggle :selected pr-file-duplex
+ :help "Toggle duplex for PostScript file"
+ :active pr-ps-utility-alist]
+ ["Tumble" pr-toggle-file-tumble-menu
+ :style toggle :selected pr-file-tumble
+ :help "Toggle tumble for PostScript file"
+ :active (and pr-file-duplex pr-ps-utility-alist)])
+ ["Despool..." (call-interactively 'pr-despool-ps-print)
+ :active pr-spool-p :keys "\\[pr-despool-ps-print]"
+ :help "Despool PostScript buffer to printer or file (C-u)"])
+ ["PostScript Printers" pr-update-menus
+ :active pr-ps-printer-alist :included (pr-visible-p 'postscript)
+ :help "Select PostScript printer"]
+ "--"
+ ("Printify" :included (pr-visible-p 'text)
+ :help
+ "Replace non-printing chars with printable representations."
+ ["Directory" pr-printify-directory t]
+ ["Buffer" pr-printify-buffer t]
+ ["Region" pr-printify-region (ps-mark-active-p)])
+ ("Print" :included (pr-visible-p 'text)
+ :help "Send text to printer"
+ ["Directory" pr-txt-directory t]
+ ["Buffer" pr-txt-buffer t]
+ ["Region" pr-txt-region (ps-mark-active-p)]
+ ["Mode" pr-txt-mode (pr-mode-alist-p)])
+ ["Text Printers" pr-update-menus
+ :active pr-txt-printer-alist :included (pr-visible-p 'text)
+ :help "Select text printer"]
+ "--"
+ ["Landscape" pr-toggle-landscape-menu
+ :style toggle :selected ps-landscape-mode
+ :included (pr-visible-p 'postscript-options)]
+ ["Print Header" pr-toggle-header-menu
+ :style toggle :selected ps-print-header
+ :included (pr-visible-p 'postscript-options)]
+ ["Print Header Frame" pr-toggle-header-frame-menu
+ :style toggle :selected ps-print-header-frame :active ps-print-header
+ :included (pr-visible-p 'postscript-options)]
+ ["Line Number" pr-toggle-line-menu
+ :style toggle :selected ps-line-number
+ :included (pr-visible-p 'postscript-options)]
+ ["Zebra Stripes" pr-toggle-zebra-menu
+ :style toggle :selected ps-zebra-stripes
+ :included (pr-visible-p 'postscript-options)]
+ ["Duplex" pr-toggle-duplex-menu
+ :style toggle :selected ps-spool-duplex
+ :included (pr-visible-p 'postscript-options)]
+ ["Tumble" pr-toggle-tumble-menu
+ :style toggle :selected ps-spool-tumble :active ps-spool-duplex
+ :included (pr-visible-p 'postscript-options)]
+ ["Upside-Down" pr-toggle-upside-down-menu
+ :style toggle :selected ps-print-upside-down
+ :included (pr-visible-p 'postscript-options)]
+ ("Print All Pages" :included (pr-visible-p 'postscript-options)
+ :help "Select odd/even pages/sheets to print"
+ ["All Pages" (pr-even-or-odd-pages nil)
+ :style radio :selected (eq ps-even-or-odd-pages nil)]
+ ["Even Pages" (pr-even-or-odd-pages 'even-page)
+ :style radio :selected (eq ps-even-or-odd-pages 'even-page)]
+ ["Odd Pages" (pr-even-or-odd-pages 'odd-page)
+ :style radio :selected (eq ps-even-or-odd-pages 'odd-page)]
+ ["Even Sheets" (pr-even-or-odd-pages 'even-sheet)
+ :style radio :selected (eq ps-even-or-odd-pages 'even-sheet)]
+ ["Odd Sheets" (pr-even-or-odd-pages 'odd-sheet)
+ :style radio :selected (eq ps-even-or-odd-pages 'odd-sheet)])
+ "--"
+ ["Spool Buffer" pr-toggle-spool-menu
+ :style toggle :selected pr-spool-p
+ :included (pr-visible-p 'postscript-process)
+ :help "Toggle PostScript spooling"]
+ ["Print with faces" pr-toggle-faces-menu
+ :style toggle :selected pr-faces-p
+ :included (pr-visible-p 'postscript-process)
+ :help "Toggle PostScript printing with faces"]
+ ["Print via Ghostscript" pr-toggle-ghostscript-menu
+ :style toggle :selected pr-print-using-ghostscript
+ :included (pr-visible-p 'postscript-process)
+ :help "Toggle PostScript generation using ghostscript"]
+ "--"
+ ["Auto Region" pr-toggle-region-menu
+ :style toggle :selected pr-auto-region
+ :included (pr-visible-p 'printing)]
+ ["Auto Mode" pr-toggle-mode-menu
+ :style toggle :selected pr-auto-mode
+ :included (pr-visible-p 'printing)]
+ ["Menu Lock" pr-toggle-lock-menu
+ :style toggle :selected pr-menu-lock
+ :included (pr-visible-p 'printing)]
+ "--"
+ ("Customize" :included (pr-visible-p 'help)
+ ["printing" pr-customize t]
+ ["ps-print" ps-print-customize t]
+ ["lpr" lpr-customize t])
+ ("Show Settings" :included (pr-visible-p 'help)
+ ["printing" pr-show-pr-setup t]
+ ["ps-print" pr-show-ps-setup t]
+ ["lpr" pr-show-lpr-setup t])
+ ["Help" pr-help :active t :included (pr-visible-p 'help)]
+ ))
(defun pr-menu-bind ()
@@ -3453,19 +3000,17 @@ Calls `pr-update-menus' to adjust menus."
;; Key binding
-(let ((pr-print-key (if (featurep 'xemacs)
- 'f22 ; XEmacs
- 'print))) ; GNU Emacs
- (global-set-key `[,pr-print-key] 'pr-ps-fast-fire)
- ;; Well, M-print and S-print are used because in my keyboard S-print works
- ;; and M-print doesn't. But M-print can work in other keyboard.
- (global-set-key `[(meta ,pr-print-key)]
'pr-ps-mode-using-ghostscript)
- (global-set-key `[(shift ,pr-print-key)]
'pr-ps-mode-using-ghostscript)
- ;; Well, C-print and C-M-print are used because in my keyboard C-M-print
works
- ;; and C-print doesn't. But C-print can work in other keyboard.
- (global-set-key `[(control ,pr-print-key)] 'pr-txt-fast-fire)
- (global-set-key `[(control meta ,pr-print-key)] 'pr-txt-fast-fire))
-
+;; FIXME: These should be moved to a function so that just loading the file
+;; doesn't affect the global keymap!
+(global-set-key [print] 'pr-ps-fast-fire)
+;; Well, M-print and S-print are used because on my keyboard S-print works
+;; and M-print doesn't. But M-print can work on other keyboards.
+(global-set-key [(meta print)] 'pr-ps-mode-using-ghostscript)
+(global-set-key [(shift print)] 'pr-ps-mode-using-ghostscript)
+;; Well, C-print and C-M-print are used because in my keyboard C-M-print works
+;; and C-print doesn't. But C-print can work in other keyboard.
+(global-set-key [(control print)] 'pr-txt-fast-fire)
+(global-set-key [(control meta print)] 'pr-txt-fast-fire)
;;; You can also use something like:
;;;(global-set-key "\C-ci" 'pr-interface)
@@ -3962,13 +3507,16 @@ file name.
See also documentation for `pr-list-directory'."
(interactive (pr-interactive-ps-dir-args (pr-prompt "PS preview dir")))
- (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename
- (pr-prompt "PS preview dir"))
- (setq filename (pr-ps-file filename))
- (pr-ps-file-list n-up dir file-regexp filename)
- (or pr-spool-p
- (pr-ps-file-preview filename)))
-
+ (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
+ (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
+ (pr--filename filename))
+ (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
+ (pr-prompt "PS preview dir"))
+ (setq pr--filename (pr-ps-file pr--filename))
+ (pr-ps-file-list pr--n-up pr--dir pr--file-regexp pr--filename)
+ (or pr-spool-p
+ (pr-ps-file-preview pr--filename))))
;;;###autoload
(defun pr-ps-directory-using-ghostscript (n-up dir file-regexp &optional
filename)
@@ -3988,12 +3536,16 @@ file name.
See also documentation for `pr-list-directory'."
(interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir GS")))
- (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename
- (pr-prompt "PS print dir GS"))
- (let ((file (pr-ps-file filename)))
- (pr-ps-file-list n-up dir file-regexp file)
- (pr-ps-file-using-ghostscript file)
- (or filename (pr-delete-file file))))
+ (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
+ (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
+ (pr--filename filename))
+ (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
+ (pr-prompt "PS print dir GS"))
+ (let ((file (pr-ps-file pr--filename)))
+ (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file)
+ (pr-ps-file-using-ghostscript file)
+ (or pr--filename (pr-delete-file file)))))
;;;###autoload
@@ -4014,12 +3566,16 @@ file name.
See also documentation for `pr-list-directory'."
(interactive (pr-interactive-ps-dir-args (pr-prompt "PS print dir")))
- (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename
- (pr-prompt "PS print dir"))
- (let ((file (pr-ps-file filename)))
- (pr-ps-file-list n-up dir file-regexp file)
- (pr-ps-file-print file)
- (or filename (pr-delete-file file))))
+ (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
+ (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
+ (pr--filename filename))
+ (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
+ (pr-prompt "PS print dir"))
+ (let ((file (pr-ps-file pr--filename)))
+ (pr-ps-file-list pr--n-up pr--dir pr--file-regexp file)
+ (pr-ps-file-print file)
+ (or pr--filename (pr-delete-file file)))))
;;;###autoload
@@ -4043,11 +3599,16 @@ file name.
See also documentation for `pr-list-directory'."
(interactive (pr-interactive-ps-dir-args
(pr-prompt (pr-prompt-gs "PS print dir"))))
- (pr-set-ps-dir-args 'n-up 'dir 'file-regexp 'filename
- (pr-prompt (pr-prompt-gs "PS print dir")))
- (if (pr-using-ghostscript-p)
- (pr-ps-directory-using-ghostscript n-up dir file-regexp filename)
- (pr-ps-directory-print n-up dir file-regexp filename)))
+ (defvar pr--n-up) (defvar pr--dir) (defvar pr--file-regexp)
+ (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--dir dir) (pr--file-regexp file-regexp)
+ (pr--filename filename))
+ (pr-set-ps-dir-args 'pr--n-up 'pr--dir 'pr--file-regexp 'pr--filename
+ (pr-prompt (pr-prompt-gs "PS print dir")))
+ (funcall (if (pr-using-ghostscript-p)
+ #'pr-ps-directory-using-ghostscript
+ #'pr-ps-directory-print)
+ pr--n-up pr--dir pr--file-regexp pr--filename)))
;;;###autoload
@@ -4191,11 +3752,13 @@ See also `pr-ps-buffer-ps-print'."
See also `pr-ps-buffer-preview'."
(interactive (pr-interactive-n-up-file "PS preview mode"))
- (pr-set-n-up-and-filename 'n-up 'filename "PS preview mode")
- (let ((file (pr-ps-file filename)))
- (and (pr-ps-mode n-up file)
- (not pr-spool-p)
- (pr-ps-file-preview file))))
+ (defvar pr--n-up) (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--filename filename))
+ (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS preview mode")
+ (let ((file (pr-ps-file pr--filename)))
+ (and (pr-ps-mode pr--n-up file)
+ (not pr-spool-p)
+ (pr-ps-file-preview file)))))
;;;###autoload
@@ -4204,12 +3767,14 @@ See also `pr-ps-buffer-preview'."
See also `pr-ps-buffer-using-ghostscript'."
(interactive (pr-interactive-n-up-file "PS print GS mode"))
- (pr-set-n-up-and-filename 'n-up 'filename "PS print GS mode")
- (let ((file (pr-ps-file filename)))
- (when (and (pr-ps-mode n-up file)
- (not pr-spool-p))
- (pr-ps-file-using-ghostscript file)
- (or filename (pr-delete-file file)))))
+ (defvar pr--n-up) (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--filename filename))
+ (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print GS mode")
+ (let ((file (pr-ps-file pr--filename)))
+ (when (and (pr-ps-mode pr--n-up file)
+ (not pr-spool-p))
+ (pr-ps-file-using-ghostscript file)
+ (or pr--filename (pr-delete-file file))))))
;;;###autoload
@@ -4218,8 +3783,10 @@ See also `pr-ps-buffer-using-ghostscript'."
See also `pr-ps-buffer-print'."
(interactive (pr-interactive-n-up-file "PS print mode"))
- (pr-set-n-up-and-filename 'n-up 'filename "PS print mode")
- (pr-ps-mode n-up filename))
+ (defvar pr--n-up) (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--filename filename))
+ (pr-set-n-up-and-filename 'pr--n-up 'pr--filename "PS print mode")
+ (pr-ps-mode pr--n-up pr--filename)))
;;;###autoload
@@ -4247,8 +3814,10 @@ prompts for FILE(name)-REGEXP.
See also documentation for `pr-list-directory'."
(interactive (pr-interactive-dir-args "Printify dir"))
- (pr-set-dir-args 'dir 'file-regexp "Printify dir")
- (pr-file-list dir file-regexp 'pr-printify-buffer))
+ (defvar pr--dir) (defvar pr--file-regexp)
+ (let ((pr--dir dir) (pr--file-regexp file-regexp))
+ (pr-set-dir-args 'pr--dir 'pr--file-regexp "Printify dir")
+ (pr-file-list pr--dir pr--file-regexp 'pr-printify-buffer)))
;;;###autoload
@@ -4283,8 +3852,10 @@ prompts for FILE(name)-REGEXP.
See also documentation for `pr-list-directory'."
(interactive (pr-interactive-dir-args "Print dir"))
- (pr-set-dir-args 'dir 'file-regexp "Print dir")
- (pr-file-list dir file-regexp 'pr-txt-buffer))
+ (defvar pr--dir) (defvar pr--file-regexp)
+ (let ((pr--dir dir) (pr--file-regexp file-regexp))
+ (pr-set-dir-args 'pr--dir 'pr--file-regexp "Print dir")
+ (pr-file-list pr--dir pr--file-regexp 'pr-txt-buffer)))
;;;###autoload
@@ -4406,10 +3977,12 @@ image in a file with that name."
(defun pr-ps-file-up-preview (n-up ifilename &optional ofilename)
"Preview PostScript file FILENAME."
(interactive (pr-interactive-n-up-inout "PS preview"))
- (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename
- "PS preview ")))
- (pr-ps-utility-process n-up ifilename outfile)
- (pr-ps-file-preview outfile)))
+ (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename)
+ (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename))
+ (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename
+ "PS preview ")))
+ (pr-ps-utility-process pr--n-up pr--ifilename outfile)
+ (pr-ps-file-preview outfile))))
;;;###autoload
@@ -4417,15 +3990,18 @@ image in a file with that name."
"Print PostScript file FILENAME using ghostscript."
(interactive (list (pr-ps-infile-preprint "Print preview ")))
(and (stringp filename) (file-exists-p filename)
- (let* ((file (pr-expand-file-name filename))
- (tempfile (pr-dosify-file-name (make-temp-file file))))
+ (let* ((file (expand-file-name filename))
+ (tempfile (make-temp-file file)))
;; gs use
(pr-call-process pr-gs-command
(format "-sDEVICE=%s" pr-gs-device)
(format "-r%d" pr-gs-resolution)
(pr-switches-string pr-gs-switches "pr-gs-switches")
- (format "-sOutputFile=\"%s\"" tempfile)
- file
+ (format "-sOutputFile=\"%s\""
+ ;; FIXME: Do we need to dosify here really?
+ (pr-dosify-file-name tempfile))
+ ;; FIXME: Do we need to dosify here really?
+ (pr-dosify-file-name file)
"-c quit")
;; printing
(pr-ps-file-print tempfile)
@@ -4439,7 +4015,7 @@ image in a file with that name."
(interactive (list (pr-ps-infile-preprint "Print ")))
(and (stringp filename) (file-exists-p filename)
;; printing
- (let ((file (pr-expand-file-name filename)))
+ (let ((file (expand-file-name filename)))
(if (string= pr-ps-command "")
;; default action
(let ((ps-spool-buffer (get-buffer-create ps-spool-buffer-name)))
@@ -4448,16 +4024,16 @@ image in a file with that name."
(insert-file-contents-literally file))
(pr-despool-print))
;; use `pr-ps-command' to print
- (apply 'pr-call-process
+ (apply #'pr-call-process
pr-ps-command
(pr-switches-string pr-ps-switches "pr-ps-switches")
(if (string-match "cp" pr-ps-command)
;; for "cp" (cmd in out)
- (list file
+ (list (pr-dosify-file-name file)
(concat pr-ps-printer-switch pr-ps-printer))
;; else, for others (cmd out in)
(list (concat pr-ps-printer-switch pr-ps-printer)
- file)))))))
+ (pr-dosify-file-name file))))))))
;;;###autoload
@@ -4492,14 +4068,16 @@ file name."
(if pr-print-using-ghostscript
"PS print GS"
"PS print")))
- (let ((outfile (pr-ps-utility-args 'n-up 'ifilename 'ofilename
- (if pr-print-using-ghostscript
- "PS print GS "
- "PS print "))))
- (pr-ps-utility-process n-up ifilename outfile)
- (unless ofilename
- (pr-ps-file-ps-print outfile)
- (pr-delete-file outfile))))
+ (defvar pr--n-up) (defvar pr--ifilename) (defvar pr--ofilename)
+ (let ((pr--n-up n-up) (pr--ifilename ifilename) (pr--ofilename ofilename))
+ (let ((outfile (pr-ps-utility-args 'pr--n-up 'pr--ifilename 'pr--ofilename
+ (if pr-print-using-ghostscript
+ "PS print GS "
+ "PS print "))))
+ (pr-ps-utility-process pr--n-up pr--ifilename outfile)
+ (unless pr--ofilename
+ (pr-ps-file-ps-print outfile)
+ (pr-delete-file outfile)))))
;;;###autoload
@@ -5210,9 +4788,9 @@ If menu binding was not done, calls `pr-menu-bind'."
(let ((sym (car elt)))
(vector
(symbol-name sym)
- (list fun (list 'quote sym) nil (list 'quote entry) index)
+ `(,fun ',sym nil ',entry ',index)
:style 'radio
- :selected (list 'eq var-sym (list 'quote sym)))))
+ :selected `(eq ,var-sym ',sym))))
alist)))
@@ -5224,7 +4802,7 @@ If menu binding was not done, calls `pr-menu-bind'."
value))
(setq pr-ps-utility value)
(pr-eval-alist (nthcdr 9 item)))
- (pr-update-mode-line))
+ (force-mode-line-update))
(defun pr-ps-set-printer (value)
@@ -5234,7 +4812,7 @@ If menu binding was not done, calls `pr-menu-bind'."
"Invalid PostScript printer name `%s' for variable `pr-ps-name'"
value))
(setq pr-ps-name value
- pr-ps-command (pr-dosify-file-name (nth 0 ps))
+ pr-ps-command (nth 0 ps)
pr-ps-switches (nth 1 ps)
pr-ps-printer-switch (nth 2 ps)
pr-ps-printer (nth 3 ps))
@@ -5251,7 +4829,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(t "-P")
)))
(pr-eval-alist (nthcdr 4 ps)))
- (pr-update-mode-line))
+ (force-mode-line-update))
(defun pr-txt-set-printer (value)
@@ -5260,7 +4838,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(error "Invalid text printer name `%s' for variable `pr-txt-name'"
value))
(setq pr-txt-name value
- pr-txt-command (pr-dosify-file-name (nth 0 txt))
+ pr-txt-command (nth 0 txt)
pr-txt-switches (nth 1 txt)
pr-txt-printer (nth 2 txt)))
(or (stringp pr-txt-command)
@@ -5269,30 +4847,28 @@ If menu binding was not done, calls `pr-menu-bind'."
(lpr-lp-system "lp")
(t "lpr")
)))
- (pr-update-mode-line))
+ (force-mode-line-update))
(defun pr-eval-alist (alist)
- (mapcar #'(lambda (option)
- (let ((var-sym (car option))
- (value (cdr option)))
- (if (eq var-sym 'inherits-from:)
- (pr-eval-setting-alist value 'global)
- (set var-sym (eval value)))))
- alist))
+ (dolist (option alist)
+ (let ((var-sym (car option))
+ (value (cdr option)))
+ (if (eq var-sym 'inherits-from:)
+ (pr-eval-setting-alist value 'global)
+ (set var-sym (eval value))))))
(defun pr-eval-local-alist (alist)
(let (local-list)
- (mapc #'(lambda (option)
- (let ((var-sym (car option))
- (value (cdr option)))
- (setq local-list
- (if (eq var-sym 'inherits-from:)
- (nconc (pr-eval-setting-alist value) local-list)
- (set (make-local-variable var-sym) (eval value))
- (cons var-sym local-list)))))
- alist)
+ (dolist (option alist)
+ (let ((var-sym (car option))
+ (value (cdr option)))
+ (setq local-list
+ (if (eq var-sym 'inherits-from:)
+ (nconc (pr-eval-setting-alist value) local-list)
+ (set (make-local-variable var-sym) (eval value))
+ (cons var-sym local-list)))))
local-list))
@@ -5338,7 +4914,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-kill-local-variable (local-var-list)
- (mapcar 'kill-local-variable local-var-list))
+ (mapcar #'kill-local-variable local-var-list))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -5526,10 +5102,6 @@ If menu binding was not done, calls `pr-menu-bind'."
(delete-file file)))
-(defun pr-expand-file-name (filename)
- (pr-dosify-file-name (expand-file-name filename)))
-
-
(defun pr-ps-outfile-preprint (&optional mess)
(let* ((prompt (format "%soutput PostScript file name: " (or mess "")))
(res (read-file-name prompt default-directory "" nil)))
@@ -5549,7 +5121,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(format "File %s; PostScript file: " prompt)
(file-name-directory res) nil nil
(file-name-nondirectory res))))
- (pr-expand-file-name res)))
+ (expand-file-name res)))
(defun pr-ps-infile-preprint (&optional mess)
@@ -5569,7 +5141,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(format "File %s; PostScript file: " prompt)
(file-name-directory res) nil nil
(file-name-nondirectory res))))
- (pr-expand-file-name res)))
+ (expand-file-name res)))
(defun pr-ps-utility-args (n-up-sym infile-sym outfile-sym prompt)
@@ -5582,13 +5154,10 @@ If menu binding was not done, calls `pr-menu-bind'."
(set infile-sym (pr-ps-infile-preprint prompt)))
(or (symbol-value infile-sym)
(error "%s: input PostScript file name is missing" prompt))
- (set infile-sym (pr-dosify-file-name (symbol-value infile-sym)))
;; output file
(and (eq (symbol-value outfile-sym) t)
(set outfile-sym (and current-prefix-arg
(pr-ps-outfile-preprint prompt))))
- (and (symbol-value outfile-sym)
- (set outfile-sym (pr-dosify-file-name (symbol-value outfile-sym))))
(pr-ps-file (symbol-value outfile-sym)))
@@ -5608,9 +5177,9 @@ If menu binding was not done, calls `pr-menu-bind'."
(and pr-file-landscape (nth 4 item))
(and pr-file-duplex (nth 5 item))
(and pr-file-tumble (nth 6 item))
- (pr-expand-file-name infile)
+ (pr-dosify-file-name (expand-file-name infile))
(nth 7 item)
- (pr-expand-file-name outfile)))))
+ (pr-dosify-file-name (expand-file-name outfile))))))
(defun pr-remove-nil-from-list (lst)
@@ -5640,7 +5209,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(with-file-modes pr-file-modes
(setq status
(condition-case data
- (apply 'call-process cmd nil buffer nil args)
+ (apply #'call-process cmd nil buffer nil args)
((quit error)
(error-message-string data)))))
;; *Printing Command Output* == show exit status
@@ -5666,7 +5235,7 @@ If menu binding was not done, calls `pr-menu-bind'."
;; If SWITCHES is nil, return nil.
;; Otherwise, return the list of string in a string.
(and switches
- (mapconcat 'identity (pr-switches switches mess) " ")))
+ (mapconcat #'identity (pr-switches switches mess) " ")))
(defun pr-switches (switches mess)
@@ -5677,36 +5246,42 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-ps-preview (kind n-up filename mess)
- (pr-set-n-up-and-filename 'n-up 'filename mess)
- (let ((file (pr-ps-file filename)))
- (pr-text2ps kind n-up file)
- (or pr-spool-p (pr-ps-file-preview file))))
+ (defvar pr--n-up) (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--filename filename))
+ (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess)
+ (let ((file (pr-ps-file pr--filename)))
+ (pr-text2ps kind pr--n-up file)
+ (or pr-spool-p (pr-ps-file-preview file)))))
(defun pr-ps-using-ghostscript (kind n-up filename mess)
- (pr-set-n-up-and-filename 'n-up 'filename mess)
- (let ((file (pr-ps-file filename)))
- (pr-text2ps kind n-up file)
- (unless (or pr-spool-p filename)
- (pr-ps-file-using-ghostscript file)
- (pr-delete-file file))))
+ (defvar pr--n-up) (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--filename filename))
+ (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess)
+ (let ((file (pr-ps-file pr--filename)))
+ (pr-text2ps kind pr--n-up file)
+ (unless (or pr-spool-p pr--filename)
+ (pr-ps-file-using-ghostscript file)
+ (pr-delete-file file)))))
(defun pr-ps-print (kind n-up filename mess)
- (pr-set-n-up-and-filename 'n-up 'filename mess)
- (let ((file (pr-ps-file filename)))
- (pr-text2ps kind n-up file)
- (unless (or pr-spool-p filename)
- (pr-ps-file-print file)
- (pr-delete-file file))))
+ (defvar pr--n-up) (defvar pr--filename)
+ (let ((pr--n-up n-up) (pr--filename filename))
+ (pr-set-n-up-and-filename 'pr--n-up 'pr--filename mess)
+ (let ((file (pr-ps-file pr--filename)))
+ (pr-text2ps kind pr--n-up file)
+ (unless (or pr-spool-p pr--filename)
+ (pr-ps-file-print file)
+ (pr-delete-file file)))))
(defun pr-ps-file (&optional filename)
- (pr-dosify-file-name (or filename
- (make-temp-file
- (convert-standard-filename
- (expand-file-name pr-ps-temp-file pr-temp-dir))
- nil ".ps"))))
+ (or filename
+ (make-temp-file
+ (convert-standard-filename
+ (expand-file-name pr-ps-temp-file pr-temp-dir))
+ nil ".ps")))
(defun pr-interactive-n-up (mess)
@@ -5714,7 +5289,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(save-match-data
(let* ((fmt-prompt "%s[%s] N-up printing (default 1): ")
(prompt "")
- (str (pr-read-string (format fmt-prompt prompt mess) "1" nil "1"))
+ (str (read-string (format fmt-prompt prompt mess) nil nil "1"))
int)
(while (if (string-match "^\\s *[0-9]+$" str)
(setq int (string-to-number str)
@@ -5724,7 +5299,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(setq prompt "Invalid integer syntax; "))
(ding)
(setq str
- (pr-read-string (format fmt-prompt prompt mess) str nil "1")))
+ (read-string (format fmt-prompt prompt mess) str nil "1")))
int)))
@@ -5749,7 +5324,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-interactive-regexp (mess)
- (pr-read-string (format "[%s] File regexp to print: " mess) "" nil ""))
+ (read-string (format "[%s] File regexp to print: " mess) nil nil ""))
(defun pr-interactive-dir-args (mess)
@@ -5796,9 +5371,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(and (not pr-spool-p)
(eq (symbol-value filename-sym) t)
(set filename-sym (and current-prefix-arg
- (ps-print-preprint current-prefix-arg))))
- (and (symbol-value filename-sym)
- (set filename-sym (pr-dosify-file-name (symbol-value filename-sym)))))
+ (ps-print-preprint current-prefix-arg)))))
(defun pr-set-n-up-and-filename (n-up-sym filename-sym mess)
@@ -5875,7 +5448,7 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-ps-file-list (n-up dir file-regexp filename)
- (pr-delete-file-if-exists (setq filename (pr-expand-file-name filename)))
+ (pr-delete-file-if-exists (setq filename (expand-file-name filename)))
(let ((pr-spool-p t))
(pr-file-list dir file-regexp
#'(lambda ()
@@ -5941,15 +5514,14 @@ If Emacs is running on Windows 95/98/NT/2000, tries to
find COMMAND,
COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(if (string= command "")
command
- (pr-dosify-file-name
- (or (pr-find-command command)
- (pr-path-command (cond (pr-cygwin-system 'cygwin)
- (lpr-windows-system 'windows)
- (t 'unix))
- (file-name-nondirectory command)
- nil)
- (error "Command not found: %s"
- (file-name-nondirectory command))))))
+ (or (pr-find-command command)
+ (pr-path-command (cond (pr-cygwin-system 'cygwin)
+ (lpr-windows-system 'windows)
+ (t 'unix))
+ (file-name-nondirectory command)
+ nil)
+ (error "Command not found: %s"
+ (file-name-nondirectory command)))))
(defun pr-path-command (symbol command sym-list)
@@ -6004,12 +5576,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; Printing Interface (inspired by ps-print-interface.el)
-(eval-when-compile
- (require 'cus-edit)
- (require 'wid-edit)
- (require 'widget))
-
-
(defvar pr-i-window-configuration nil)
(defvar pr-i-buffer nil)
@@ -6027,20 +5593,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defvar pr-i-ps-send 'printer)
-(defvar pr-interface-map nil
- "Keymap for pr-interface.")
-
-(unless pr-interface-map
+(defvar pr-interface-map
(let ((map (make-sparse-keymap)))
- (cond ((featurep 'xemacs) ; XEmacs
- (pr-set-keymap-parents map (list widget-keymap))
- (pr-set-keymap-name map 'pr-interface-map))
- (t ; GNU Emacs
- (pr-set-keymap-parents map widget-keymap)))
+ (set-keymap-parent map widget-keymap)
(define-key map "q" 'pr-interface-quit)
(define-key map "?" 'pr-interface-help)
- (setq pr-interface-map map)))
-
+ map)
+ "Keymap for pr-interface.")
(defmacro pr-interface-save (&rest body)
`(with-current-buffer pr-i-buffer
@@ -6111,15 +5670,13 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(setq found (string-match (car ignore) name)
ignore (cdr ignore)))
(or found
- (setq choices
- (cons (list 'quote
- (list 'choice-item
- :format "%[%t%]"
- name))
- choices)))))
+ (push (list 'choice-item
+ :format "%[%t%]"
+ name)
+ choices))))
(nreverse choices))
" Buffer : " nil
- '(progn
+ (lambda ()
(pr-interface-save
(setq pr-i-region (ps-mark-active-p)
pr-i-mode (pr-mode-alist-p)))
@@ -6345,11 +5902,10 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-italic "\n\nSelect Pages : " 2 14)
(pr-insert-menu "Page Parity" 'ps-even-or-odd-pages
(mapcar #'(lambda (alist)
- (list 'quote
- (list 'choice-item
- :format "%[%t%]"
- :tag (cdr alist)
- :value (car alist))))
+ (list 'choice-item
+ :format "%[%t%]"
+ :tag (cdr alist)
+ :value (car alist)))
pr-even-or-odd-alist)))
@@ -6605,8 +6161,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defun pr-insert-toggle (var-sym label)
(widget-create 'checkbox
- :notify `(lambda (&rest _ignore)
- (setq ,var-sym (not ,var-sym)))
+ :notify (lambda (&rest _ignore)
+ (set var-sym (not (symbol-value var-sym))))
(symbol-value var-sym))
(widget-insert label))
@@ -6619,32 +6175,32 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(widget-insert separator)))
-(defun pr-insert-menu (tag var-sym choices &optional before after &rest body)
+(defun pr-insert-menu (tag var-sym choices &optional before after body)
(and before (widget-insert before))
- (eval `(widget-create 'menu-choice
- :tag ,tag
- :format "%v"
- :inline t
- :value ,var-sym
- :notify (lambda (widget &rest _ignore)
- (setq ,var-sym (widget-value widget))
- ,@body)
- :void '(choice-item :format "%[%t%]"
- :tag "Can not display value!")
- ,@choices))
- (and after (widget-insert after)))
+ (apply #'widget-create 'menu-choice
+ :tag tag
+ :format "%v"
+ :inline t
+ :value (symbol-value var-sym)
+ :notify (lambda (widget &rest _ignore)
+ (set var-sym (widget-value widget))
+ (when body (funcall body)))
+ :void '(choice-item :format "%[%t%]"
+ :tag "Can not display value!")
+ choices)
+ (and after (widget-insert after)))
(defun pr-insert-radio-button (var-sym sym)
(widget-insert "\n")
(let ((wid-list (get var-sym 'pr-widget-list))
- (wid (eval `(widget-create
- 'radio-button
- :format " %[%v%]"
- :value (eq ,var-sym (quote ,sym))
- :notify (lambda (&rest _ignore)
- (setq ,var-sym (quote ,sym))
- (pr-update-radio-button (quote ,var-sym)))))))
+ (wid (widget-create
+ 'radio-button
+ :format " %[%v%]"
+ :value (eq (symbol-value var-sym) sym)
+ :notify (lambda (&rest _ignore)
+ (set var-sym sym)
+ (pr-update-radio-button var-sym)))))
(put var-sym 'pr-widget-list (cons (cons wid sym) wid-list))))
@@ -6666,20 +6222,18 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defun pr-choice-alist (alist)
- (let ((max (apply 'max (mapcar #'(lambda (alist)
- (length (symbol-name (car alist))))
- alist))))
+ (let ((max (apply #'max (mapcar #'(lambda (alist)
+ (length (symbol-name (car alist))))
+ alist))))
(mapcar #'(lambda (alist)
(let* ((sym (car alist))
(name (symbol-name sym)))
- (list
- 'quote
- (list
- 'choice-item
- :format "%[%t%]"
- :tag (concat name
- (make-string (- max (length name)) ?_))
- :value sym))))
+ (list
+ 'choice-item
+ :format "%[%t%]"
+ :tag (concat name
+ (make-string (- max (length name)) ?_))
+ :value sym)))
alist)))
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 6c85ff9..a8b002b 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -78,7 +78,7 @@
"goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start"))
(UNIX
'("bash" "cat" "cp" "fgrep" "grep" "ls" "sed" "sh" "mv" "rm")))
- `(("\\_<\\(call\\|goto\\)\\_>[ \t]+%?\\([A-Za-z0-9-_\\:.]+\\)%?"
+ `(("\\_<\\(call\\|goto\\)\\_>[ \t]+%?\\([A-Za-z0-9_\\:.-]+\\)%?"
(2 font-lock-constant-face t))
("^:[^:].*"
. 'bat-label-face)
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 8baf748..813ecbe 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -1,4 +1,4 @@
-;; bug-reference.el --- buttonize bug references
+;; bug-reference.el --- buttonize bug references -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
@@ -69,7 +69,7 @@ so that it is considered safe, see `enable-local-variables'.")
(get s 'bug-reference-url-format)))))
(defcustom bug-reference-bug-regexp
- "\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR
[a-z-+]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR
[a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
:type 'string
@@ -91,7 +91,7 @@ The second subexpression should match the bug reference
(usually a number)."
(bug-reference-set-overlay-properties)
(defun bug-reference-unfontify (start end)
- "Remove bug reference overlays from region."
+ "Remove bug reference overlays from the region between START and END."
(dolist (o (overlays-in start end))
(when (eq (overlay-get o 'category) 'bug-reference)
(delete-overlay o))))
@@ -99,7 +99,7 @@ The second subexpression should match the bug reference
(usually a number)."
(defvar bug-reference-prog-mode)
(defun bug-reference-fontify (start end)
- "Apply bug reference overlays to region."
+ "Apply bug reference overlays to the region between START and END."
(save-excursion
(let ((beg-line (progn (goto-char start) (line-beginning-position)))
(end-line (progn (goto-char end) (line-end-position))))
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 97272ca..87ddf3a 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -212,6 +212,13 @@ This variant works around bugs in `eval-when-compile' in
various
`(cl-delete-duplicates ,cl-seq ,@cl-keys)
`(delete-duplicates ,cl-seq ,@cl-keys))))
+(defmacro c-font-lock-flush (beg end)
+ "Declare the region BEG...END's fontification as out-of-date.
+On XEmacs and older Emacsen, this refontifies that region immediately."
+ (if (fboundp 'font-lock-flush)
+ `(font-lock-flush ,beg ,end)
+ `(font-lock-fontify-region ,beg ,end)))
+
(defmacro c-point (position &optional point)
"Return the value of certain commonly referenced POSITIONs relative to POINT.
The current point is used if POINT isn't specified. POSITION can be
@@ -258,10 +265,12 @@ to it is returned. This function does not modify the
point or the mark."
((eq position 'eoll)
`(save-excursion
,@(if point `((goto-char ,point)))
- (while (progn
- (end-of-line)
- (prog1 (eq (logand 1 (skip-chars-backward "\\\\")) 1)))
- (beginning-of-line 2))
+ (while (and
+ (not (eobp))
+ (progn
+ (end-of-line)
+ (prog1 (eq (logand 1 (skip-chars-backward "\\\\")) 1))))
+ (forward-line))
(end-of-line)
(point)))
@@ -1214,7 +1223,7 @@ Leave point just after the character, and set the match
data on
this character, and return point. If the search fails, return
nil; point is then left undefined."
`(let ((char-skip (concat "^" (char-to-string ,char)))
- (-limit- ,limit)
+ (-limit- (or ,limit (point-max)))
(-value- ,value))
(while
(and
@@ -1226,15 +1235,39 @@ nil; point is then left undefined."
(search-forward-regexp ".") ; to set the match-data.
(point))))
+(defmacro c-search-forward-char-property-without-value-on-char
+ (property value char &optional limit)
+ "Search forward for a character CHAR without text property PROPERTY having
+a value CHAR.
+LIMIT bounds the search. The value comparison is done with `equal'.
+PROPERTY must be a constant.
+
+Leave point just after the character, and set the match data on
+this character, and return point. If the search fails, return
+nil; point is then left undefined."
+ `(let ((char-skip (concat "^" (char-to-string ,char)))
+ (-limit- (or ,limit (point-max)))
+ (-value- ,value))
+ (while
+ (and
+ (progn (skip-chars-forward char-skip -limit-)
+ (< (point) -limit-))
+ (equal (c-get-char-property (point) ,property) -value-))
+ (forward-char))
+ (when (< (point) -limit-)
+ (search-forward-regexp ".") ; to set the match-data.
+ (point))))
+
(defun c-clear-char-property-with-value-on-char-function (from to property
value char)
"Remove all text-properties PROPERTY with value VALUE on
characters with value CHAR from the region [FROM, TO), as tested
by `equal'. These properties are assumed to be over individual
characters, having been put there by c-put-char-property. POINT
-remains unchanged."
+remains unchanged. Return the position of the first removed
+property, or nil."
(let ((place from)
- )
+ first)
(while ; loop round occurrences of (PROPERTY VALUE)
(progn
(while ; loop round changes in PROPERTY till we find VALUE
@@ -1243,28 +1276,34 @@ remains unchanged."
(not (equal (get-text-property place property) value)))
(setq place (c-next-single-property-change place property nil to)))
(< place to))
- (if (eq (char-after place) char)
- (remove-text-properties place (1+ place) (cons property nil)))
+ (when (eq (char-after place) char)
+ (remove-text-properties place (1+ place) (cons property nil))
+ (or first (setq first place)))
;; Do we have to do anything with stickiness here?
- (setq place (1+ place)))))
+ (setq place (1+ place)))
+ first))
(defmacro c-clear-char-property-with-value-on-char (from to property value
char)
"Remove all text-properties PROPERTY with value VALUE on
characters with value CHAR from the region [FROM, TO), as tested
by `equal'. These properties are assumed to be over individual
characters, having been put there by c-put-char-property. POINT
-remains unchanged."
+remains unchanged. Return the position of the first removed
+property, or nil."
(if c-use-extents
;; XEmacs
`(let ((-property- ,property)
- (-char- ,char))
+ (-char- ,char)
+ (first (1+ (point-max))))
(map-extents (lambda (ext val)
- (if (and (equal (extent-property ext -property-) val)
- (eq (char-after
- (extent-start-position ext))
- -char-))
- (delete-extent ext)))
- nil ,from ,to ,value nil -property-))
+ (when (and (equal (extent-property ext -property-) val)
+ (eq (char-after
+ (extent-start-position ext))
+ -char-))
+ (setq first (min first (extent-start-position ext)))
+ (delete-extent ext)))
+ nil ,from ,to ,value nil -property-)
+ (and (<= first (point-max)) first))
;; GNU Emacs
`(c-clear-char-property-with-value-on-char-function ,from ,to ,property
,value ,char)))
@@ -1316,6 +1355,7 @@ with value CHAR in the region [FROM to)."
;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
; '(progn
(def-edebug-spec cc-eval-when-compile (&rest def-form))
+(def-edebug-spec c-font-lock-flush t)
(def-edebug-spec c--mapcan t)
(def-edebug-spec c--set-difference (form form &rest [symbolp form]))
(def-edebug-spec c--intersection (form form &rest [symbolp form]))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index cc3753a..f0b44d2 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -5646,8 +5646,12 @@ comment at the start of cc-engine.el for more info."
;; Pseudo match inside a comment or string literal. Skip out
;; of comments and string literals.
(while (progn
- (goto-char (c-next-single-property-change
- (point) 'face nil cfd-limit))
+ (unless
+ (and (match-end 1)
+ (c-got-face-at (1- (point)) c-literal-faces)
+ (not (c-got-face-at (point) c-literal-faces)))
+ (goto-char (c-next-single-property-change
+ (point) 'face nil cfd-limit)))
(and (< (point) cfd-limit)
(c-got-face-at (point) c-literal-faces))))
t) ; Continue the loop over pseudo matches.
@@ -6350,9 +6354,8 @@ comment at the start of cc-engine.el for more info."
;; Set by c-common-init in cc-mode.el.
(defvar c-new-BEG)
(defvar c-new-END)
-;; Set by c-after-change in cc-mode.el.
-(defvar c-old-BEG)
-(defvar c-old-END)
+;; Set by c-before-change-check-raw-strings.
+(defvar c-old-END-literality)
(defun c-before-change-check-<>-operators (beg end)
;; Unmark certain pairs of "< .... >" which are currently marked as
@@ -6484,9 +6487,9 @@ comment at the start of cc-engine.el for more info."
;; 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, double quote or left/right paren. <contents>
-;; can include anything which isn't the terminating )<id>", including new
-;; lines, "s, parentheses, etc.
+;; spaces, control characters, or left/right paren. <contents> can include
+;; anything which isn't the terminating )<id>", including new lines, "s,
+;; parentheses, etc.
;;
;; CC Mode handles C++ raw strings by the use of `syntax-table' text
;; properties as follows:
@@ -6496,16 +6499,18 @@ comment at the start of cc-engine.el for more info."
;; contents is given the property value "punctuation" (`(1)') to prevent it
;; interacting with the "s in the delimiters.
;;
-;; The font locking routine `c-font-lock-c++-raw-strings' (in cc-fonts.el)
+;; 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.
;;
;; (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)').
+;; 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.
;;
-;; `c-font-lock-c++-raw-strings' puts c-font-lock-warning-face on the entire
+;; `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.
@@ -6522,10 +6527,14 @@ comment at the start of cc-engine.el for more info."
;; 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 rest of
-;; the macro (if any) after the "(" gets font-lock-string-face, but the rest
-;; of the file is fontified normally.
+;; 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)
(defun c-raw-string-pos ()
;; Get POINT's relationship to any containing raw string.
@@ -6542,7 +6551,7 @@ comment at the start of cc-engine.el for more info."
;; characters.) If the raw string is not terminated, E\) and E\" are set to
;; nil.
;;
- ;; Note: this routine is dependant upon the correct syntax-table text
+ ;; Note: this function is dependant upon the correct syntax-table text
;; properties being set.
(let ((state (c-state-semi-pp-to-literal (point)))
open-quote-pos open-paren-pos close-paren-pos close-quote-pos id)
@@ -6555,8 +6564,20 @@ comment at the start of cc-engine.el for more info."
(search-backward "\"" (max (- (point) 17) (point-min)) t)))
((and (eq (cadr state) 'string)
(goto-char (nth 2 state))
- (or (eq (char-after) ?\")
- (search-backward "\"" (max (- (point) 17) (point-min)) t))
+ (cond
+ ((eq (char-after) ?\"))
+ ((eq (char-after) ?\()
+ (let ((here (point)))
+ (goto-char (max (- (point) 18) (point-min)))
+ (while
+ (and
+ (search-forward-regexp
+ "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)("
+ (1+ here) 'limit)
+ (< (point) here)))
+ (and (eq (point) (1+ here))
+ (match-beginning 1)
+ (goto-char (1- (match-beginning 1)))))))
(not (bobp)))))
(eq (char-before) ?R)
(looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)("))
@@ -6579,6 +6600,21 @@ comment at the start of cc-engine.el for more info."
(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
@@ -6587,29 +6623,55 @@ comment at the start of cc-engine.el for more info."
;; 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.
+ ;; 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)))
+ (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-semi-nonlit-pos-cache first))
(cond
((null open-paren-prop)
- ;; A terminated raw string
+ ;; 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-semi-nonlit-pos-cache first))
+ ;; Clear any random `syntax-table' text properties from the contents.
(let* ((closing-paren (match-beginning 0))
- (first-punctuation
- (save-match-data
- (goto-char (1+ open-paren))
- (and (c-search-forward-char-property 'syntax-table '(1)
- closing-paren)
- (1- (point)))))
- )
- (when first-punctuation
- (c-clear-char-property-with-value
- first-punctuation (match-beginning 0) 'syntax-table '(1))
- (c-truncate-semi-nonlit-pos-cache first-punctuation)
- ))))
+ (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-semi-nonlit-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-semi-nonlit-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
@@ -6623,13 +6685,8 @@ comment at the start of cc-engine.el for more info."
(c-clear-char-property open-quote 'syntax-table)
(c-truncate-semi-nonlit-pos-cache open-quote)
(c-clear-char-property open-paren 'syntax-table)
- (let ((after-string-fence-pos
- (save-excursion
- (goto-char (1+ open-paren))
- (c-search-forward-char-property 'syntax-table '(15) bound))))
- (when after-string-fence-pos
- (c-clear-char-property (1- after-string-fence-pos) '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
@@ -6669,37 +6726,89 @@ comment at the start of cc-engine.el for more info."
(defun c-before-change-check-raw-strings (beg end)
;; This function clears `syntax-table' text properties from C++ raw strings
- ;; in the region (c-new-BEG c-new-END). BEG and END are the standard
- ;; arguments supplied to any before-change function.
+ ;; 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'.
+ (goto-char end)
+ ;; 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))
(c-save-buffer-state
- ((beg-rs (progn (goto-char beg) (c-raw-string-pos)))
- (beg-plus (if (null beg-rs)
- beg
- (max beg
- (1+ (or (nth 4 beg-rs) (nth 2 beg-rs))))))
- (end-rs (progn (goto-char end) (c-raw-string-pos))) ; FIXME!!!
+ (;; (beg-rs (progn (goto-char beg) (c-raw-string-pos)))
+ ;; (end-rs (progn (goto-char end) (c-raw-string-pos)))
+ ; FIXME!!!
; Optimize this so that we don't call
; `c-raw-string-pos' twice when once
; will do. (2016-06-02).
- (end-minus (if (null end-rs)
- end
- (min end (cadr end-rs))))
- )
- (when beg-rs
- (setq c-new-BEG (min c-new-BEG (1- (cadr beg-rs)))))
- (c-depropertize-raw-strings-in-region c-new-BEG beg-plus)
-
- (when end-rs
- (setq c-new-END (max c-new-END
- (1+ (or (nth 4 end-rs)
- (nth 2 end-rs))))))
- (c-depropertize-raw-strings-in-region end-minus c-new-END)))
+ (term-del (c-raw-string-in-end-delim beg end))
+ 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
+ ;; 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)))
+ (c-depropertize-raw-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
+ (< 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)
+ (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))))
+ ((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))
+ (< 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)
+ (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-semi-nonlit-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
@@ -6709,117 +6818,264 @@ comment at the start of cc-engine.el for more info."
;; 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.
- ;;
- ;; 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.
- (if (search-forward (concat ")" id "\"") bound t)
- (let ((end-string (match-beginning 0))
- (after-quote (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-semi-nonlit-pos-cache (point))
- (forward-char))
- (goto-char after-quote))
- (c-put-char-property open-quote 'syntax-table '(1)) ;
punctuation
- (c-truncate-semi-nonlit-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-semi-nonlit-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-semi-nonlit-pos-cache (1+ (match-beginning 5))))
- (c-put-char-property open-paren 'syntax-table '(1)))
- (goto-char bound))))
-
-(defun c-after-change-re-mark-raw-strings (_beg _end _old-len)
- ;; This function applies `syntax-table' text properties to C++ raw strings
- ;; beginning in the region (c-new-BEG c-new-END). BEG, END, and OLD-LEN are
- ;; the standard arguments supplied to any after-change function.
+ ;; 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-semi-nonlit-pos-cache (point))
+ (forward-char))
+ (goto-char after-quote)
+ t)
+ (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation
+ (c-truncate-semi-nonlit-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-semi-nonlit-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-semi-nonlit-pos-cache (1+ (match-beginning 5))))
+ ;; (c-put-char-property open-paren 'syntax-table '(1))
+ )
+ (goto-char bound))
+ nil)
+ ;; Ensure the opening delimiter will get refontified.
+ (c-font-lock-flush (1- open-quote) (1+ open-paren))))
+
+(defun c-after-change-unmark-raw-strings (beg end _old-len)
+ ;; This function removes `syntax-table' text properties from any raw 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
+ ;; after-change-function.
;;
;; Point is undefined on both entry and exit, and the return value has no
;; significance.
;;
- ;; This function is called as an after-change function solely due to its
+ ;; This functions is called as an after-change function by virtue of its
;; membership of the C++ value of `c-before-font-lock-functions'.
- (c-save-buffer-state ()
- ;; If the region (c-new-BEG c-new-END) has expanded, remove
- ;; `syntax-table' text-properties from the new piece(s).
- (when (< c-new-BEG c-old-BEG)
- (let ((beg-rs (progn (goto-char c-old-BEG) (c-raw-string-pos))))
- (c-depropertize-raw-strings-in-region
- c-new-BEG
- (if beg-rs
- (1+ (or (nth 4 beg-rs) (nth 2 beg-rs)))
- c-old-BEG))))
- (when (> c-new-END c-old-END)
- (let ((end-rs (progn (goto-char c-old-END) (c-raw-string-pos))))
- (c-depropertize-raw-strings-in-region
- (if end-rs
- (cadr end-rs)
- c-old-END)
- c-new-END)))
+ ;; (when (< beg end)
+ (c-save-buffer-state (found eoll state id found-beg found-end)
+ ;; 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 "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)("
+ eoll t))
+ (setq state (c-state-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-semi-nonlit-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)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)("
+ c-new-END 'bound))
+ (<= (match-end 0) beg)))
+ (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 "R\"[^ ()\\\n\r\t]\\{0,16\\}(")
+ (c-clear-char-property (1+ (point)) 'syntax-table)
+ (c-truncate-semi-nonlit-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 terminated an existing raw string by inserting or removing
+ ;; text?
+ (when (eq c-old-END-literality 'string)
+ (setq state (c-state-semi-pp-to-literal beg))
+ (cond
+ ;; Possibly terminating a(n un)terminated raw string.
+ ((eq (nth 3 (car state)) t)
+ (goto-char (nth 8 (car state)))
+ (when
+ (and (eq (char-after) ?\()
+ (search-backward-regexp
+ "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)\\=" (- (point) 18) t))
+ (setq id (match-string-no-properties 1)
+ found-beg (match-beginning 0)
+ found-end (1+ (match-end 0)))))
+ ;; Possibly terminating an already terminated raw string.
+ ((eq (nth 3 (car state)) ?\")
+ (goto-char (nth 8 (car state)))
+ (when
+ (and (eq (char-before) ?R)
+ (looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)("))
+ (setq id (match-string-no-properties 1)
+ found-beg (1- (point))
+ found-end (match-end 0)))))
+ (when id
+ (goto-char (max (- beg 18) (point-min)))
+ (when (search-forward (concat ")" id "\"") (+ end 1 (length id)) t)
+ ;; Has an earlier close delimiter just been inserted into an
+ ;; already terminated raw string?
+ (if (and (eq (nth 3 (car state)) ?\")
+ (search-forward (concat ")" id "\"") nil t))
+ (setq found-end (point)))
+ (setq c-new-BEG (min c-new-BEG found-beg)
+ c-new-END (max c-new-END found-end))
+ (c-clear-char-properties found-beg found-end 'syntax-table)
+ (c-truncate-semi-nonlit-pos-cache found-beg))))
+
+ ;; 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)
+ (c-end-of-macro)
+ (c-depropertize-raw-strings-in-region found-beg (point))))))
- (goto-char c-new-BEG)
- (while (and (< (point) c-new-END)
- (re-search-forward
- (concat "\\(" ; 1
- c-anchored-cpp-prefix ; 2
- "\\)\\|\\(" ; 3
- "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" ; 4
- "\\)")
- c-new-END 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.
+(defun c-maybe-re-mark-raw-string ()
+ ;; When this function is called, point is immediately after a ". If this "
+ ;; is the characteristic " of of a raw string delimiter, apply the pertinent
+ ;; `syntax-table' text properties to the entire raw string (when properly
+ ;; terminated) or just the delimiter (otherwise).
+ ;;
+ ;; If the " is in any way part of a raw string, return non-nil. Otherwise
+ ;; return nil.
+ (let ((here (point))
+ in-macro macro-end id Rquote found)
+ (cond
+ ((and
+ (eq (char-before (1- (point))) ?R)
+ (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)("))
+ (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))
+ )))
+ (if (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.
+ (goto-char (or macro-end (point-max))))
+ t)
+ ((save-excursion
+ (and
+ (search-backward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\"\\=" nil t)
+ (setq id (match-string-no-properties 1))
+ (let* ((quoted-id (regexp-quote id))
+ (quoted-id-depth (regexp-opt-depth quoted-id)))
+ (while
+ (and
+ ;; Search back for an opening delimiter with identifier `id'.
+ ;; A closing delimiter with `id' "blocks" our search.
+ (search-backward-regexp ; This could be slow.
+ (concat "\\(R\"" quoted-id "(\\)"
+ "\\|"
+ "\\()" quoted-id "\"\\)")
+ nil t)
+ (setq found t)
+ (if (eq (c-in-literal) 'string)
+ (match-beginning 1)
+ (match-beginning (+ 2 quoted-id-depth)))))
+ (and found
+ (null (c-in-literal))
+ (match-beginning 1)))
+ (setq Rquote (point))))
+ (save-excursion
+ (goto-char Rquote)
+ (setq in-macro (c-beginning-of-macro))
+ (setq macro-end (when in-macro
+ (c-end-of-macro)
+ (point))))
+ (if (or (not in-macro)
+ (<= here macro-end))
+ (progn
(c-propertize-raw-string-opener
- (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
- "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" eom t))
- (c-propertize-raw-string-opener
- (match-string-no-properties 1) ; id
- (1+ (match-beginning 0)) ; open quote
- (match-end 1) ; open paren
- eom)))))))) ; bound
+ id (1+ (point)) (match-end 1) macro-end)
+ (goto-char here)
+ t)
+ (goto-char here)
+ nil))
+
+ (t
+ ;; If the " is in another part of a raw string (whether as part of the
+ ;; identifier, or in the string itself) the `syntax-table' text
+ ;; properties on the raw string will be current. So, we can use...
+ (c-raw-string-pos)))))
;; Handling of small scale constructs like types and names.
@@ -10697,7 +10953,8 @@ comment at the start of cc-engine.el for more info."
(eq (char-after) ?\())
(setq braceassignp 'c++-noassign
in-paren 'in-paren))
- ((looking-at c-pre-id-bracelist-key))
+ ((looking-at c-pre-id-bracelist-key)
+ (setq braceassignp nil))
((looking-at c-return-key))
((and (looking-at c-symbol-start)
(not (looking-at c-keywords-regexp)))
@@ -10739,6 +10996,8 @@ comment at the start of cc-engine.el for more info."
(setq pos (point))
(cond
+ ((not braceassignp)
+ nil)
((and after-type-id-pos
(goto-char after-type-id-pos)
(setq res (c-back-over-member-initializers))
@@ -10813,14 +11072,20 @@ comment at the start of cc-engine.el for more info."
))))
nil)
(t t))))))
- (when (and (eq braceassignp 'dontknow)
- (/= (c-backward-token-2 1 t lim) 0))
- (if (save-excursion
- (and c-has-compound-literals
- (eq (c-backward-token-2 1 nil lim) 0)
- (eq (char-after) ?\()))
- (setq braceassignp t)
- (setq braceassignp nil))))
+ (when (eq braceassignp 'dontknow)
+ (cond ((and
+ (not (eq (char-after) ?,))
+ (save-excursion
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?})))
+ (setq braceassignp nil))
+ ((/= (c-backward-token-2 1 t lim) 0)
+ (if (save-excursion
+ (and c-has-compound-literals
+ (eq (c-backward-token-2 1 nil lim) 0)
+ (eq (char-after) ?\()))
+ (setq braceassignp t)
+ (setq braceassignp nil))))))
(cond
(braceassignp
@@ -10852,9 +11117,14 @@ comment at the start of cc-engine.el for more info."
(and (consp res)
(eq (car res) after-type-id-pos))))))
(cons bufpos (or in-paren inexpr-brace-list)))
- ((eq (char-after) ?\;)
- ;; Brace lists can't contain a semicolon, so we're done.
- ;; (setq containing-sexp nil)
+ ((or (eq (char-after) ?\;)
+ ;; Brace lists can't contain a semicolon, so we're done.
+ (save-excursion
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?}))
+ ;; They also can't contain a bare }, which is probably the end
+ ;; of a function.
+ )
nil)
((and (setq macro-start (point))
(c-forward-to-cpp-define-body)
@@ -12464,6 +12734,13 @@ comment at the start of cc-engine.el for more info."
(if (eq (char-after) ?<)
(zerop (c-forward-token-2 1 t indent-point))
t)
+ (progn
+ (while
+ (and
+ (< (point) indent-point)
+ (looking-at c-class-id-suffix-ws-ids-key)
+ (zerop (c-forward-token-2 1 nil indent-point))))
+ t)
(eq (char-after) ?:))))
(goto-char placeholder)
(c-add-syntax 'inher-cont (c-point 'boi)))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 0b41eff..e7a3748 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1674,25 +1674,36 @@ casts and declarations are fontified. Used on level 2
and higher."
(goto-char string-start)
(and (eq (char-before) ?R)
(looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")
- (match-string-no-properties 1))))))
+ (match-string-no-properties 1)))))
+ (content-start (and raw-id (point))))
+ ;; 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
- (if (search-forward-regexp (concat ")\\(" (regexp-quote raw-id)
"\\)\"")
- limit 'limit)
- (c-put-font-lock-face (match-beginning 1) (point) 'default))
+ (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
- (or (and (eobp)
- (eq (c-get-char-property (1- (point)) 'face)
- 'font-lock-warning-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))))
+ ;; 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
@@ -1703,8 +1714,9 @@ casts and declarations are fontified. Used on level 2
and higher."
(equal paren-prop '(15))
(not (c-search-forward-char-property 'syntax-table
'(15) limit)))
(goto-char limit)))
- (c-put-font-lock-face (match-beginning 1) (match-end 2)
'default)
- (setq raw-id (match-string-no-properties 2)))))))))
+ (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)
(defun c-font-lock-c++-lambda-captures (limit)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 7cc8029..50f8b84 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -497,25 +497,25 @@ parameters \(point-min) and \(point-max).")
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
t '(c-depropertize-new-text
- c-after-change-re-mark-unbalanced-strings
+ c-after-change-mark-abnormal-strings
c-change-expand-fl-region)
(c objc) '(c-depropertize-new-text
c-parse-quotes-after-change
- c-after-change-re-mark-unbalanced-strings
+ c-after-change-mark-abnormal-strings
c-extend-font-lock-region-for-macros
c-neutralize-syntax-in-CPP
c-change-expand-fl-region)
c++ '(c-depropertize-new-text
+ c-after-change-unmark-raw-strings
c-parse-quotes-after-change
- c-after-change-re-mark-unbalanced-strings
+ c-after-change-mark-abnormal-strings
c-extend-font-lock-region-for-macros
- c-after-change-re-mark-raw-strings
c-neutralize-syntax-in-CPP
c-restore-<>-properties
c-change-expand-fl-region)
java '(c-depropertize-new-text
c-parse-quotes-after-change
- c-after-change-re-mark-unbalanced-strings
+ c-after-change-mark-abnormal-strings
c-restore-<>-properties
c-change-expand-fl-region)
awk '(c-depropertize-new-text
@@ -599,13 +599,21 @@ EOL terminated statements."
(c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields))
(c-lang-defconst c-single-quotes-quote-strings
- "Whether the language uses single quotes for multi-char strings."
+ "Whether the language uses single quotes for multi-char strings.
+
+Note that to set up a language to use this, additionally:
+\(i) the syntax of \"'\" must be \"string quote\" (7);
+\(ii) the language's value of `c-has-quoted-numbers' must be nil;
+\(iii) the language's value of `c-get-state-before-change-functions' may not
+ contain `c-parse-quotes-before-change';
+\(iv) the language's value of `c-before-font-lock-functions' may not contain
+ `c-parse-quotes-after-change'."
t nil)
(c-lang-defvar c-single-quotes-quote-strings
(c-lang-const c-single-quotes-quote-strings))
(c-lang-defconst c-string-delims
- "A list of characters which can delimit arbitrary length strings"
+;; A list of characters which can delimit arbitrary length strings.
t (if (c-lang-const c-single-quotes-quote-strings)
'(?\" ?\')
'(?\")))
@@ -2041,6 +2049,19 @@ effect in the declaration, but are syntactically like
whitespace."
(c-lang-defvar c-type-decl-suffix-ws-ids-key
(c-lang-const c-type-decl-suffix-ws-ids-key))
+(c-lang-defconst c-class-id-suffix-ws-ids-kwds
+ "\"Identifiers\" that when immediately following the identifier
+of a class declaration have semantic effect in the declaration,
+but are syntactically like whitespace."
+ t nil
+ c++ '("final"))
+
+(c-lang-defconst c-class-id-suffix-ws-ids-key
+ ;; An adorned regexp matching `c-class-id-suffix-ws-ids-kwds'.
+ t (c-make-keywords-re t (c-lang-const c-class-id-suffix-ws-ids-kwds)))
+(c-lang-defvar c-class-id-suffix-ws-ids-key
+ (c-lang-const c-class-id-suffix-ws-ids-key))
+
(c-lang-defconst c-class-decl-kwds
"Keywords introducing declarations where the following block (if any)
contains another declaration level that should be considered a class.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 8343978..49268c4 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -678,14 +678,12 @@ that requires a literal mode spec at compile time."
(make-variable-buffer-local 'c-new-BEG)
(defvar c-new-END 0)
(make-variable-buffer-local 'c-new-END)
-;; The following two variables record the values of `c-new-BEG' and
-;; `c-new-END' just after `c-new-END' has been adjusted for the length of text
-;; inserted or removed. They may be read by any after-change function (but
-;; should not be altered by one).
-(defvar c-old-BEG 0)
-(make-variable-buffer-local 'c-old-BEG)
-(defvar c-old-END 0)
-(make-variable-buffer-local 'c-old-END)
+
+;; Buffer local variable which notes the value of calling `c-in-literal' just
+;; before a change. It is one of 'string, 'c, 'c++ (for the two sorts of
+;; comments), or nil.
+(defvar c-old-END-literality nil)
+(make-variable-buffer-local 'c-old-END-literality)
(defun c-common-init (&optional mode)
"Common initialization for all CC Mode modes.
@@ -900,7 +898,8 @@ Note that the style variables are always made local to the
buffer."
(defun c-depropertize-CPP (beg end)
;; Remove the punctuation syntax-table text property from the CPP parts of
- ;; (c-new-BEG c-new-END).
+ ;; (c-new-BEG c-new-END), and remove all syntax-table properties from any
+ ;; raw strings within these CPP parts.
;;
;; This function is in the C/C++/ObjC values of
;; `c-get-state-before-change-functions' and is called exclusively as a
@@ -912,6 +911,7 @@ 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)
+ (save-excursion (c-depropertize-raw-strings-in-region m-beg (point)))
(c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
(while (and (< (point) end)
@@ -920,14 +920,16 @@ 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))
- (if (and ss-found (> (point) end))
- (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
+ (when (and ss-found (> (point) end))
+ (save-excursion (c-depropertize-raw-strings-in-region m-beg (point)))
+ (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
(while (and (< (point) c-new-END)
(search-forward-regexp c-anchored-cpp-prefix c-new-END 'bound))
(goto-char (match-beginning 1))
(setq m-beg (point))
(c-end-of-macro)
+ (save-excursion (c-depropertize-raw-strings-in-region m-beg (point)))
(c-clear-char-property-with-value
m-beg (point) 'syntax-table '(1)))))
@@ -1210,11 +1212,15 @@ Note that the style variables are always made local to
the buffer."
(while
(and
(c-syntactic-re-search-forward
- "\"\\|\\s|" (point-max) t t)
+ (if c-single-quotes-quote-strings
+ "[\"']\\|\\s|"
+ "\"\\|\\s|")
+ (point-max) t t)
(progn
(c-clear-char-property (1- (point)) 'syntax-table)
- (not (eq (char-before) ?\")))))
- (eq (char-before) ?\"))
+ (c-truncate-semi-nonlit-pos-cache (1- (point)))
+ (not (memq (char-before) c-string-delims)))))
+ (memq (char-before) c-string-delims))
(progn
(c-pps-to-string-delim (point-max))
(< (point) (point-max))))))
@@ -1226,7 +1232,9 @@ Note that the style variables are always made local to
the buffer."
(eq beg-literal-type 'string))))
;; Deal with deletion of backslashes before "s.
(goto-char end)
- (if (and (looking-at "\\\\*\"")
+ (if (and (looking-at (if c-single-quotes-quote-strings
+ "\\\\*[\"']"
+ "\\\\*\""))
(eq (logand (skip-chars-backward "\\\\" beg) 1) 1))
(setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
(if (eq beg-literal-type 'string)
@@ -1247,27 +1255,38 @@ Note that the style variables are always made local to
the buffer."
(forward-char)
(backward-sexp)
(c-clear-char-property eoll-1 'syntax-table)
- (c-clear-char-property (point) 'syntax-table))
+ (c-clear-char-property (point) 'syntax-table)
+ (c-truncate-semi-nonlit-pos-cache (point)))
;; Opening " at EOB.
(c-clear-char-property (1- (point)) 'syntax-table))
- (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
- ;; Opening " on last line of text (without EOL).
- (c-clear-char-property (point) 'syntax-table))))
+ (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 (.
+ ;; Opening " on last line of text (without EOL).
+ (c-clear-char-property (point) 'syntax-table)
+ (c-truncate-semi-nonlit-pos-cache (point)))))
(t (goto-char end) ; point-max
- (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
- (c-clear-char-property (point) 'syntax-table))))
+ (when
+ (and
+ (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
+ (memq (char-after) c-string-delims))
+ (c-clear-char-property (point) 'syntax-table)
+ (c-truncate-semi-nonlit-pos-cache (point)))))
(unless (and c-multiline-string-start-char
(not (c-characterp c-multiline-string-start-char)))
- (when (eq end-literal-type 'string)
- (c-clear-char-property (1- (cdr end-limits)) 'syntax-table))
+ (when (and (eq end-literal-type 'string)
+ (not (eq (char-before (cdr end-limits)) ?\()))
+ (c-clear-char-property (1- (cdr end-limits)) 'syntax-table)
+ (c-truncate-semi-nonlit-pos-cache (1- (cdr end-limits))))
- (when (eq beg-literal-type 'string)
+ (when (and (eq beg-literal-type 'string)
+ (memq (char-after (car beg-limits)) c-string-delims))
(setq c-new-BEG (min c-new-BEG (car beg-limits)))
- (c-clear-char-property (car beg-limits) 'syntax-table)))))
+ (c-clear-char-property (car beg-limits) 'syntax-table)
+ (c-truncate-semi-nonlit-pos-cache (car beg-limits))))))
-(defun c-after-change-re-mark-unbalanced-strings (beg end _old-len)
+(defun c-after-change-mark-abnormal-strings (beg end _old-len)
;; Mark any unbalanced strings in the region (c-new-BEG c-new-END) with
;; string fence syntax-table text properties.
;;
@@ -1318,7 +1337,8 @@ Note that the style variables are always made local to
the buffer."
(min (1+ (point)) (point-max)))))
((and (null beg-literal-type)
(goto-char beg)
- (eq (char-before) c-multiline-string-start-char)
+ (and (not (bobp))
+ (eq (char-before) c-multiline-string-start-char))
(memq (char-after) c-string-delims))
(cons (point)
(progn
@@ -1343,22 +1363,24 @@ Note that the style variables are always made local to
the buffer."
(while (progn
(setq s (parse-partial-sexp (point) c-new-END nil
nil s 'syntax-table))
- (and (< (point) c-new-END)
- (or (not (nth 3 s))
- (not (memq (char-before) c-string-delims))))))
+ (and (< (point) c-new-END)
+ (or (not (nth 3 s))
+ (not (memq (char-before) c-string-delims))))))
;; We're at the start of a string.
(memq (char-before) c-string-delims)))
- (if (c-unescaped-nls-in-string-p (1- (point)))
- (looking-at "\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\"]\\)*")
- (looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
- (cond
- ((memq (char-after (match-end 0)) '(?\n ?\r))
- (c-put-char-property (1- (point)) 'syntax-table '(15))
- (c-put-char-property (match-end 0) 'syntax-table '(15)))
- ((or (eq (match-end 0) (point-max))
- (eq (char-after (match-end 0)) ?\\)) ; \ at EOB
- (c-put-char-property (1- (point)) 'syntax-table '(15))))
- (goto-char (min (1+ (match-end 0)) (point-max)))
+ (unless (and (c-major-mode-is 'c++-mode)
+ (c-maybe-re-mark-raw-string))
+ (if (c-unescaped-nls-in-string-p (1- (point)))
+ (looking-at "\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\"]\\)*")
+ (looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
+ (cond
+ ((memq (char-after (match-end 0)) '(?\n ?\r))
+ (c-put-char-property (1- (point)) 'syntax-table '(15))
+ (c-put-char-property (match-end 0) 'syntax-table '(15)))
+ ((or (eq (match-end 0) (point-max))
+ (eq (char-after (match-end 0)) ?\\)) ; \ at EOB
+ (c-put-char-property (1- (point)) 'syntax-table '(15))))
+ (goto-char (min (1+ (match-end 0)) (point-max))))
(setq s nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1475,7 +1497,7 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
;;
;; This function is called exclusively as a before-change function via the
;; variable `c-get-state-before-change-functions'.
- (c-save-buffer-state ()
+ (c-save-buffer-state (case-fold-search)
(goto-char c-new-BEG)
;; We need to scan for 's from the BO (logical) line.
(beginning-of-line)
@@ -1491,13 +1513,13 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
((c-quoted-number-head-before-point)
(if (>= (point) c-new-BEG)
(setq c-new-BEG (match-beginning 0))))
- ((looking-at "\\([^'\\]\\|\\\\.\\)'")
+ ((looking-at
+ "\\([^'\\]\\|\\\\\\([0-7]\\{1,3\\}\\|[xuU][0-9a-fA-F]+\\|.\\)\\)'")
(goto-char (match-end 0))
(if (> (match-end 0) c-new-BEG)
(setq c-new-BEG (1- (match-beginning 0)))))
- ((or (>= (point) (1- c-new-BEG))
- (and (eq (point) (- c-new-BEG 2))
- (eq (char-after) ?\\)))
+ ((save-excursion
+ (not (search-forward "'" c-new-BEG t)))
(setq c-new-BEG (1- (point))))
(t nil)))
@@ -1517,19 +1539,26 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(goto-char (match-end 0))
(if (> (match-end 0) c-new-END)
(setq c-new-END (match-end 0))))
- ((looking-at "\\([^'\\]\\|\\\\.\\)'")
+ ((looking-at
+ "\\([^'\\]\\|\\\\\\([0-7]\\{1,3\\}\\|[xuU][0-9a-fA-F]+\\|.\\)\\)'")
(goto-char (match-end 0))
(if (> (match-end 0) c-new-END)
(setq c-new-END (match-end 0))))
+ ((equal (c-get-char-property (1- (point)) 'syntax-table) '(1))
+ (when (c-search-forward-char-property-with-value-on-char
+ 'syntax-table '(1) ?\' (c-point 'eoll))
+ (setq c-new-END (max (point) c-new-END))))
(t nil)))
;; Having reached c-new-END, handle any 's after it whose context may be
- ;; changed by the current buffer change.
+ ;; changed by the current buffer change. The idea is to catch
+ ;; monstrosities like ',',',',',' changing "polarity".
(goto-char c-new-END)
(cond
((c-quoted-number-tail-after-point)
(setq c-new-END (match-end 0)))
((looking-at
- "\\(\\\\.\\|.\\)?\\('\\([^'\\]\\|\\\\.\\)\\)*'")
+ "\\(\\\\\\([0-7]\\{1,3\\}\\|[xuU][0-9a-fA-F]+\\|.\\)\\|.\\)?\
+\\('\\([^'\\]\\|\\\\\\([0-7]\\{1,3\\}\\|[xuU][0-9a-fA-F]+\\|.\\)\\)\\)*'")
(setq c-new-END (match-end 0))))
;; Remove the '(1) syntax-table property from any "'"s within (c-new-BEG
@@ -1558,7 +1587,7 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
;;
;; This function is called exclusively as an after-change function via the
;; variable `c-before-font-lock-functions'.
- (c-save-buffer-state (num-beg num-end)
+ (c-save-buffer-state (num-beg num-end case-fold-search)
;; Apply the needed syntax-table and c-digit-separator text properties to
;; quotes.
(save-restriction
@@ -1580,7 +1609,9 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(c-put-char-properties-on-char num-beg num-end
'c-digit-separator t ?')
(goto-char num-end))
- ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted
expression.
+ ((looking-at
+ "\\([^\\']\\|\\\\\\([0-7]\\{1,3\\}\\|[xuU][0-9a-fA-F]+\\|.\\)\
+\\)'") ; balanced quoted expression.
(goto-char (match-end 0)))
(t
(c-invalidate-state-cache (1- (point)))
@@ -1721,7 +1752,6 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
;; (c-new-BEG c-new-END) will be the region to fontify. It may become
;; larger than (beg end).
(setq c-new-END (- (+ c-new-END (- end beg)) old-len))
- (setq c-old-BEG c-new-BEG c-old-END c-new-END)
(unless (c-called-from-text-property-change-p)
(setq c-just-done-before-change nil)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 3650b05..1a0d9bd 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -77,7 +77,7 @@ If this is buffer-local in the destination buffer, Emacs obeys
that value, otherwise it uses the value in the *compilation*
buffer. This enables a major-mode to specify its own value.")
-(defvar compilation-parse-errors-filename-function nil
+(defvar compilation-parse-errors-filename-function #'identity
"Function to call to post-process filenames while parsing error messages.
It takes one arg FILENAME which is the name of a file as found
in the compilation output, and should return a transformed file name
@@ -86,18 +86,18 @@ or a buffer, the one which was compiled.")
;; match data.
;;;###autoload
-(defvar compilation-process-setup-function nil
+(defvar compilation-process-setup-function #'ignore
"Function to call to customize the compilation process.
This function is called immediately before the compilation process is
started. It can be used to set any variables or functions that are used
while processing the output of the compilation process.")
;;;###autoload
-(defvar compilation-buffer-name-function nil
+(defvar compilation-buffer-name-function #'compilation--default-buffer-name
"Function to compute the name of a compilation buffer.
The function receives one argument, the name of the major mode of the
compilation buffer. It should return a string.
-If nil, compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
+By default, it returns `(concat \"*\" (downcase name-of-mode) \"*\")'.")
;;;###autoload
(defvar compilation-finish-functions nil
@@ -558,6 +558,10 @@ of lines. COLUMN can also be of the form (COLUMN .
END-COLUMN)
meaning a range of columns starting on LINE and ending on
END-LINE, if that matched.
+LINE, END-LINE, COL, and END-COL can also be functions of no argument
+that return the corresponding line or column number. They can assume REGEXP
+has just been matched, and should correspondingly preserve this match data.
+
TYPE is 2 or nil for a real error or 1 for warning or 0 for info.
TYPE can also be of the form (WARNING . INFO). In that case this
will be equivalent to 1 if the WARNING'th subexpression matched
@@ -717,8 +721,9 @@ This only affects platforms that support asynchronous
processes (see
Then every error line will have a debug text property with the matcher that
fit this line and the match data. Use `describe-text-properties'.")
-(defvar compilation-exit-message-function nil "\
-If non-nil, called when a compilation process dies to return a status message.
+(defvar compilation-exit-message-function
+ (lambda (_process-status exit-status msg) (cons msg exit-status))
+ "If non-nil, called when a compilation process dies to return a status
message.
This should be a function of three arguments: process status, exit status,
and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
write into the compilation buffer, and to put in its mode line.")
@@ -1105,23 +1110,27 @@ POS and RES.")
(setq file '("*unknown*")))))
;; All of these fields are optional, get them only if we have an index, and
;; it matched some part of the message.
- (and line
- (setq line (match-string-no-properties line))
- (setq line (string-to-number line)))
- (and end-line
- (setq end-line (match-string-no-properties end-line))
- (setq end-line (string-to-number end-line)))
- (if col
- (if (functionp col)
- (setq col (funcall col))
- (and
- (setq col (match-string-no-properties col))
- (setq col (string-to-number col)))))
- (if (and end-col (functionp end-col))
- (setq end-col (funcall end-col))
- (if (and end-col (setq end-col (match-string-no-properties end-col)))
- (setq end-col (- (string-to-number end-col) -1))
- (if end-line (setq end-col -1))))
+ (setq line
+ (if (functionp line) (funcall line)
+ (and line
+ (setq line (match-string-no-properties line))
+ (string-to-number line))))
+ (setq end-line
+ (if (functionp end-line) (funcall end-line)
+ (and end-line
+ (setq end-line (match-string-no-properties end-line))
+ (string-to-number end-line))))
+ (setq col
+ (if (functionp col) (funcall col)
+ (and col
+ (setq col (match-string-no-properties col))
+ (string-to-number col))))
+ (setq end-col
+ (or (if (functionp end-col) (funcall end-col)
+ (and end-col
+ (setq end-col (match-string-no-properties end-col))
+ (- (string-to-number end-col) -1)))
+ (and end-line -1)))
(if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
@@ -1222,12 +1231,12 @@ FMTS is a list of format specs for transforming the
file name.
(setq loc (compilation-assq line (compilation--file-struct->loc-tree
file-struct)))
(setq end-loc
- (if end-line
+ (if end-line
(compilation-assq
end-col (compilation-assq
end-line (compilation--file-struct->loc-tree
file-struct)))
- (if end-col ; use same line element
+ (if end-col ; use same line element
(compilation-assq end-col loc))))
(setq loc (compilation-assq col loc))
;; If they are new, make the loc(s) reference the file they point to.
@@ -1370,92 +1379,70 @@ to `compilation-error-regexp-alist' if RULES is nil."
(if (consp line) (setq end-line (cdr line) line (car line)))
(if (consp col) (setq end-col (cdr col) col (car col)))
- (if (functionp line)
- ;; The old compile.el had here an undocumented hook that
- ;; allowed `line' to be a function that computed the actual
- ;; error location. Let's do our best.
- (progn
- (goto-char start)
- (while (re-search-forward pat end t)
- (save-match-data
- (when compilation-debug
- (font-lock-append-text-property
- (match-beginning 0) (match-end 0)
- 'compilation-debug (vector 'functionp item)))
- (add-text-properties
- (match-beginning 0) (match-end 0)
- (compilation--compat-error-properties
- (funcall line (cons (match-string file)
- (cons default-directory
- (nthcdr 4 item)))
- (if col (match-string col))))))
- (compilation--put-prop
- file 'font-lock-face compilation-error-face)))
+ (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
+ (error "HYPERLINK should be an integer: %s" (nth 5 item)))
- (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
- (error "HYPERLINK should be an integer: %s" (nth 5 item)))
+ (goto-char start)
+ (while (re-search-forward pat end t)
+ (when (setq props (compilation-error-properties
+ file line end-line col end-col (or type 2) fmt))
- (goto-char start)
- (while (re-search-forward pat end t)
- (when (setq props (compilation-error-properties
- file line end-line col end-col (or type 2) fmt))
-
- (when (integerp file)
- (let ((this-type (if (consp type)
- (compilation-type type)
- (or type 2))))
- (compilation--note-type this-type)
-
- (compilation--put-prop
- file 'font-lock-face
- (symbol-value (aref [compilation-info-face
- compilation-warning-face
- compilation-error-face]
- this-type)))))
-
- (compilation--put-prop
- line 'font-lock-face compilation-line-face)
- (compilation--put-prop
- end-line 'font-lock-face compilation-line-face)
-
- (compilation--put-prop
- col 'font-lock-face compilation-column-face)
- (compilation--put-prop
- end-col 'font-lock-face compilation-column-face)
-
- ;; Obey HIGHLIGHT.
- (dolist (extra-item (nthcdr 6 item))
- (let ((mn (pop extra-item)))
- (when (match-beginning mn)
- (let ((face (eval (car extra-item))))
- (cond
- ((null face))
- ((or (symbolp face) (stringp face))
- (put-text-property
- (match-beginning mn) (match-end mn)
- 'font-lock-face face))
- ((and (listp face)
- (eq (car face) 'face)
- (or (symbolp (cadr face))
- (stringp (cadr face))))
- (compilation--put-prop mn 'font-lock-face (cadr face))
- (add-text-properties
- (match-beginning mn) (match-end mn)
- (nthcdr 2 face)))
- (t
- (error "Don't know how to handle face %S"
- face)))))))
- (let ((mn (or (nth 5 item) 0)))
- (when compilation-debug
- (font-lock-append-text-property
- (match-beginning 0) (match-end 0)
- 'compilation-debug (vector 'std item props)))
- (add-text-properties
- (match-beginning mn) (match-end mn)
- (cddr props))
+ (when (integerp file)
+ (let ((this-type (if (consp type)
+ (compilation-type type)
+ (or type 2))))
+ (compilation--note-type this-type)
+
+ (compilation--put-prop
+ file 'font-lock-face
+ (symbol-value (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ this-type)))))
+
+ (compilation--put-prop
+ line 'font-lock-face compilation-line-face)
+ (compilation--put-prop
+ end-line 'font-lock-face compilation-line-face)
+
+ (compilation--put-prop
+ col 'font-lock-face compilation-column-face)
+ (compilation--put-prop
+ end-col 'font-lock-face compilation-column-face)
+
+ ;; Obey HIGHLIGHT.
+ (dolist (extra-item (nthcdr 6 item))
+ (let ((mn (pop extra-item)))
+ (when (match-beginning mn)
+ (let ((face (eval (car extra-item))))
+ (cond
+ ((null face))
+ ((or (symbolp face) (stringp face))
+ (put-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face face))
+ ((and (listp face)
+ (eq (car face) 'face)
+ (or (symbolp (cadr face))
+ (stringp (cadr face))))
+ (compilation--put-prop mn 'font-lock-face (cadr face))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (nthcdr 2 face)))
+ (t
+ (error "Don't know how to handle face %S"
+ face)))))))
+ (let ((mn (or (nth 5 item) 0)))
+ (when compilation-debug
(font-lock-append-text-property
- (match-beginning mn) (match-end mn)
- 'font-lock-face (cadr props)))))))))
+ (match-beginning 0) (match-end 0)
+ 'compilation-debug (vector 'std item props)))
+ (add-text-properties
+ (match-beginning mn) (match-end mn)
+ (cddr props))
+ (font-lock-append-text-property
+ (match-beginning mn) (match-end mn)
+ 'font-lock-face (cadr props))))))))
(defvar compilation--parsed -1)
(make-variable-buffer-local 'compilation--parsed)
@@ -1576,19 +1563,22 @@ point on its location in the *compilation* buffer."
:version "20.3")
-(defun compilation-buffer-name (name-of-mode mode-command name-function)
+(defun compilation-buffer-name (name-of-mode _mode-command name-function)
"Return the name of a compilation buffer to use.
If NAME-FUNCTION is non-nil, call it with one argument NAME-OF-MODE
to determine the buffer name.
Likewise if `compilation-buffer-name-function' is non-nil.
-If current buffer has the major mode MODE-COMMAND,
+If current buffer has the NAME-OF-MODE major mode,
return the name of the current buffer, so that it gets reused.
Otherwise, construct a buffer name from NAME-OF-MODE."
- (cond (name-function
- (funcall name-function name-of-mode))
- (compilation-buffer-name-function
- (funcall compilation-buffer-name-function name-of-mode))
- ((eq mode-command major-mode)
+ (funcall (or name-function
+ compilation-buffer-name-function
+ #'compilation--default-buffer-name)
+ name-of-mode))
+
+(defun compilation--default-buffer-name (name-of-mode)
+ (cond ((or (eq major-mode (intern-soft name-of-mode))
+ (eq major-mode (intern-soft (concat name-of-mode "-mode"))))
(buffer-name))
(t
(concat "*" (downcase name-of-mode) "*"))))
@@ -2066,8 +2056,7 @@ by replacing the first word, e.g.,
`compilation-scroll-output' from
(if (boundp 'byte-compile-bound-variables)
(memq (cdr v) byte-compile-bound-variables)))
`(set (make-local-variable ',(car v)) ,(cdr v))))
- '(compilation-buffer-name-function
- compilation-directory-matcher
+ '(compilation-directory-matcher
compilation-error
compilation-error-regexp-alist
compilation-error-regexp-alist-alist
@@ -2792,7 +2781,8 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; If compilation-parse-errors-filename-function is
;; defined, use it to process the filename. The result might be a
;; buffer.
- (when compilation-parse-errors-filename-function
+ (unless (memq compilation-parse-errors-filename-function
+ '(nil identity))
(save-match-data
(setq filename
(funcall compilation-parse-errors-filename-function
@@ -2837,29 +2827,6 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if
given."
(defvar compilation-error-list nil)
(defvar compilation-old-error-list nil)
-(defun compilation--compat-error-properties (err)
- "Map old-style error ERR to new-style message."
- ;; Old-style structure is (MARKER (FILE DIR) LINE COL) or
- ;; (MARKER . MARKER).
- (let ((dst (cdr err)))
- (if (markerp dst)
- `(compilation-message ,(compilation--make-message
- (cons nil (compilation--make-cdrloc
- nil nil dst))
- 2 nil)
- help-echo "mouse-2: visit the source location"
- keymap compilation-button-map
- mouse-face highlight)
- ;; Too difficult to do it by hand: dispatch to the normal code.
- (let* ((file (pop dst))
- (line (pop dst))
- (col (pop dst))
- (filename (pop file))
- (dirname (pop file))
- (fmt (pop file)))
- (compilation-internal-error-properties
- (cons filename dirname) line nil col nil 2 fmt)))))
-
(defun compilation--compat-parse-errors (limit)
(when compilation-parse-errors-function
;; FIXME: We should remove the rest of the compilation keywords
diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el
index 524521d..248c95a 100644
--- a/lisp/progmodes/flymake-cc.el
+++ b/lisp/progmodes/flymake-cc.el
@@ -58,7 +58,9 @@ SOURCE."
(cl-loop
while
(search-forward-regexp
- "^\\(In file included from
\\)?<stdin>:\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?:\n?\\(.*\\): \\(.*\\)$"
+ (concat
+ "^\\(In file included from \\)?<stdin>:\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)"
+ "?:[\n ]?\\(error\\|warning\\|note\\): \\(.*\\)$")
nil t)
for msg = (match-string 5)
for (beg . end) = (flymake-diag-region
@@ -78,7 +80,11 @@ SOURCE."
(defun flymake-cc-use-special-make-target ()
"Command for checking a file via a CHK_SOURCES Make target."
(unless (executable-find "make") (error "Make not found"))
- '("make" "check-syntax" "CHK_SOURCES=-x c -"))
+ `("make"
+ "check-syntax"
+ ,(format "CHK_SOURCES=-x %s -c -"
+ (cond ((derived-mode-p 'c++-mode) "c++")
+ (t "c")))))
(defvar-local flymake-cc--proc nil "Internal variable for `flymake-gcc'")
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index a5427dd..8c7a58f 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -459,7 +459,7 @@ abbreviated part can also be toggled with
;; remove match from grep-regexp-alist before fontifying
("^Grep[/a-zA-Z]* started.*"
(0 '(face nil compilation-message nil help-echo nil mouse-face nil) t))
- ("^Grep[/a-zA-Z]* finished with \\(?:\\(\\(?:[0-9]+ \\)?matches
found\\)\\|\\(no matches found\\)\\).*"
+ ("^Grep[/a-zA-Z]* finished with \\(?:\\(\\(?:[0-9]+ \\)?match\\(?:es\\)?
found\\)\\|\\(no matches found\\)\\).*"
(0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
(1 compilation-info-face nil t)
(2 compilation-warning-face nil t))
@@ -552,7 +552,10 @@ Set up `compilation-exit-message-function' and run
`grep-setup-hook'."
;; so the buffer is still unmodified if there is no output.
(cond ((and (zerop code) (buffer-modified-p))
(if (> grep-num-matches-found 0)
- (cons (format "finished with %d matches found\n"
grep-num-matches-found)
+ (cons (format (ngettext "finished with %d match found\n"
+ "finished with %d matches found\n"
+ grep-num-matches-found)
+ grep-num-matches-found)
"matched")
'("finished with matches found\n" . "matched")))
((not (buffer-modified-p))
@@ -956,8 +959,16 @@ substitution string. Note dynamic scoping of variables.")
The pattern can include shell wildcards. As whitespace triggers
completion when entering a pattern, including it requires
quoting, e.g. `\\[quoted-insert]<space>'."
- (let* ((bn (or (buffer-file-name)
- (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))
+ (let* ((grep-read-files-function (get major-mode 'grep-read-files))
+ (file-name-at-point
+ (run-hook-with-args-until-success 'file-name-at-point-functions))
+ (bn (if grep-read-files-function
+ (funcall grep-read-files-function)
+ (or (if (and (stringp file-name-at-point)
+ (not (file-directory-p file-name-at-point)))
+ file-name-at-point)
+ (buffer-file-name)
+ (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))))
(fn (and bn
(stringp bn)
(file-name-nondirectory bn)))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 92f5205..4306f5d 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -678,7 +678,7 @@ The option \"--fullname\" must be included in this value."
;; gud-marker-acc until we receive the rest of it. Since we
;; know the full marker regexp above failed, it's pretty simple to
;; test for marker starts.
- (if (string-match "\n\\(\032.*\\)?\\'" gud-marker-acc)
+ (if (string-match "\\(\n\\)?\\(\032.*\\)?\\'" gud-marker-acc)
(progn
;; Everything before the potential marker start can be output.
(setq output (concat output (substring gud-marker-acc
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index bded09d..6f56ce0 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -6454,10 +6454,10 @@ ARROW: Location of the arrow"
((string-match "\\`[ \t]*\\(pro\\|function\\)\\>"
match-string)
nil)
- ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'"
+ ((string-match "OBJ_NEW([ \t]*['\"][a-zA-Z0-9$_]*\\'"
match-string)
(setq cw 'class))
- ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'"
+ ((string-match "\\<inherits\\s-+[a-zA-Z0-9$_]*\\'"
match-string)
(setq cw 'class))
((and func
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 4d91da7..a0adaa8 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -50,7 +50,6 @@
(require 'imenu)
(require 'moz nil t)
(require 'json)
-(require 'sgml-mode)
(require 'prog-mode)
(eval-when-compile
@@ -66,7 +65,7 @@
;;; Constants
-(defconst js--name-start-re "[a-zA-Z_$]"
+(defconst js--name-start-re (concat "[[:alpha:]_$]")
"Regexp matching the start of a JavaScript identifier, without grouping.")
(defconst js--stmt-delim-chars "^;{}?:")
@@ -572,6 +571,119 @@ then the \".\"s will be lined up:
:safe 'booleanp
:group 'js)
+(defcustom js-jsx-detect-syntax t
+ "When non-nil, automatically detect whether JavaScript uses JSX.
+`js-jsx-syntax' (which see) may be made buffer-local and set to
+t. The detection strategy can be customized by adding elements
+to `js-jsx-regexps', which see."
+ :version "27.1"
+ :type 'boolean
+ :safe 'booleanp
+ :group 'js)
+
+(defcustom js-jsx-syntax nil
+ "When non-nil, parse JavaScript with consideration for JSX syntax.
+
+This enables proper font-locking and indentation of code using
+Facebook’s “JSX” syntax extension for JavaScript, for use with
+Facebook’s “React” library. Font-locking is like sgml-mode.
+Indentation is also like sgml-mode, although some indentation
+behavior may differ slightly to align more closely with the
+conventions of the React developer community.
+
+When `js-mode' is already enabled, you should call
+`js-jsx-enable' to set this variable.
+
+It is set to be buffer-local (and t) when in `js-jsx-mode'."
+ :version "27.1"
+ :type 'boolean
+ :safe 'booleanp
+ :group 'js)
+
+(defcustom js-jsx-align->-with-< t
+ "When non-nil, “>” will be indented to the opening “<” in JSX.
+
+When this is enabled, JSX indentation looks like this:
+
+ <element
+ attr=\"\"
+ >
+ </element>
+ <input
+ />
+
+When this is disabled, JSX indentation looks like this:
+
+ <element
+ attr=\"\"
+ >
+ </element>
+ <input
+ />"
+ :version "27.1"
+ :type 'boolean
+ :safe 'booleanp
+ :group 'js)
+
+(defcustom js-jsx-indent-level nil
+ "When non-nil, indent JSX by this value, instead of like JS.
+
+Let `js-indent-level' be 4. When this variable is also set to
+nil, JSX indentation looks like this (consistent):
+
+ return (
+ <element>
+ <element>
+ Hello World!
+ </element>
+ </element>
+ )
+
+Alternatively, when this variable is also set to 2, JSX
+indentation looks like this (different):
+
+ return (
+ <element>
+ <element>
+ Hello World!
+ </element>
+ </element>
+ )"
+ :version "27.1"
+ :type 'integer
+ :safe (lambda (x) (or (null x) (integerp x)))
+ :group 'js)
+;; This is how indentation behaved out-of-the-box until Emacs 27. JSX
+;; indentation was controlled with `sgml-basic-offset', which defaults
+;; to 2, whereas `js-indent-level' defaults to 4. Users who had the
+;; same values configured for both their HTML and JS indentation would
+;; luckily get consistent JSX indentation; most others were probably
+;; unhappy. I’d be surprised if anyone actually wants different
+;; indentation levels, but just in case, here’s a way back to that.
+
+(defcustom js-jsx-attribute-offset 0
+ "Specifies a delta for JSXAttribute indentation.
+
+Let `js-indent-level' be 2. When this variable is also set to 0,
+JSXAttribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>
+
+Alternatively, when this variable is also set to 2, JSXAttribute
+indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>
+
+This variable is like `sgml-attribute-offset'."
+ :version "27.1"
+ :type 'integer
+ :safe 'integerp
+ :group 'js)
+
;;; KeyMap
(defvar js-mode-map
@@ -1485,6 +1597,102 @@ point of view of font-lock. It applies highlighting
directly with
;; Matcher always "fails"
nil)
+;; It wouldn’t be sufficient to font-lock JSX with mere regexps, since
+;; a JSXElement may be nested inside a JS expression within the
+;; boundaries of a parent JSXOpeningElement, and such a hierarchy
+;; ought to be fontified like JSX, JS, and JSX respectively:
+;;
+;; <div attr={void(<div></div>) && void(0)}></div>
+;;
+;; <div attr={ ← JSX
+;; void( ← JS
+;; <div></div> ← JSX
+;; ) && void(0) ← JS
+;; }></div> ← JSX
+;;
+;; `js-syntax-propertize' unambiguously identifies JSX syntax,
+;; including when it’s nested.
+;;
+;; Using a matcher function for each relevant part, retrieve match
+;; data recorded as syntax properties for fontification.
+
+(defconst js-jsx--font-lock-keywords
+ `((js-jsx--match-tag-name 0 font-lock-function-name-face t)
+ (js-jsx--match-attribute-name 0 font-lock-variable-name-face t)
+ (js-jsx--match-text 0 'default t) ; “Undo” keyword fontification.
+ (js-jsx--match-tag-beg)
+ (js-jsx--match-tag-end)
+ (js-jsx--match-expr))
+ "JSX font lock faces and multiline text properties.")
+
+(defun js-jsx--match-tag-name (limit)
+ "Match JSXBoundaryElement names, until LIMIT."
+ (when js-jsx-syntax
+ (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-name nil
limit))
+ value)
+ (when (and pos (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos 'js-jsx-tag-name))
+ (progn (set-match-data value) t))
+ (js-jsx--match-tag-name limit))))))
+
+(defun js-jsx--match-attribute-name (limit)
+ "Match JSXAttribute names, until LIMIT."
+ (when js-jsx-syntax
+ (let ((pos (next-single-char-property-change (point)
'js-jsx-attribute-name nil limit))
+ value)
+ (when (and pos (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos 'js-jsx-attribute-name))
+ (progn (set-match-data value) t))
+ (js-jsx--match-attribute-name limit))))))
+
+(defun js-jsx--match-text (limit)
+ "Match JSXText, until LIMIT."
+ (when js-jsx-syntax
+ (let ((pos (next-single-char-property-change (point) 'js-jsx-text nil
limit))
+ value)
+ (when (and pos (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos 'js-jsx-text))
+ (progn (set-match-data value)
+ (put-text-property (car value) (cadr value)
'font-lock-multiline t)
+ t))
+ (js-jsx--match-text limit))))))
+
+(defun js-jsx--match-tag-beg (limit)
+ "Match JSXBoundaryElements from start, until LIMIT."
+ (when js-jsx-syntax
+ (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-beg nil
limit))
+ value)
+ (when (and pos (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos 'js-jsx-tag-beg))
+ (progn (put-text-property pos (cdr value)
'font-lock-multiline t) t))
+ (js-jsx--match-tag-beg limit))))))
+
+(defun js-jsx--match-tag-end (limit)
+ "Match JSXBoundaryElements from end, until LIMIT."
+ (when js-jsx-syntax
+ (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-end nil
limit))
+ value)
+ (when (and pos (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos 'js-jsx-tag-end))
+ (progn (put-text-property value pos 'font-lock-multiline t)
t))
+ (js-jsx--match-tag-end limit))))))
+
+(defun js-jsx--match-expr (limit)
+ "Match JSXExpressionContainers, until LIMIT."
+ (when js-jsx-syntax
+ (let ((pos (next-single-char-property-change (point) 'js-jsx-expr nil
limit))
+ value)
+ (when (and pos (> pos (point)))
+ (goto-char pos)
+ (or (and (setq value (get-text-property pos 'js-jsx-expr))
+ (progn (put-text-property pos value 'font-lock-multiline t)
t))
+ (js-jsx--match-expr limit))))))
+
(defconst js--font-lock-keywords-3
`(
;; This goes before keywords-2 so it gets used preferentially
@@ -1596,7 +1804,10 @@ point of view of font-lock. It applies highlighting
directly with
(forward-symbol -1)
(end-of-line))
'(end-of-line)
- '(0 font-lock-variable-name-face))))
+ '(0 font-lock-variable-name-face)))
+
+ ;; jsx (when enabled)
+ ,@js-jsx--font-lock-keywords)
"Level three font lock for `js-mode'.")
(defun js--inside-pitem-p (pitem)
@@ -1722,9 +1933,414 @@ This performs fontification according to
`js--class-styles'."
'syntax-table (string-to-syntax "\"/"))
(goto-char end)))))
+(defconst js--unary-keyword-re
+ (js--regexp-opt-symbol '("await" "delete" "typeof" "void" "yield"))
+ "Regexp matching unary operator keywords.")
+
+(defun js--unary-keyword-p (string)
+ "Check if STRING is a unary operator keyword in JavaScript."
+ (string-match-p js--unary-keyword-re string))
+
+;; Adding `syntax-multiline' text properties to JSX isn’t sufficient
+;; to identify multiline JSX when first typing it. For instance, if
+;; the user is typing a JSXOpeningElement for the first time…
+;;
+;; <div
+;; ^ (point)
+;;
+;; …and the user inserts a line break after the tag name (before the
+;; JSXOpeningElement starting on that line has been unambiguously
+;; identified as such), then the `syntax-propertize' region won’t be
+;; extended backwards to the start of the JSXOpeningElement:
+;;
+;; <div ← This line wasn’t JSX when last edited.
+;; attr=""> ← Despite completing the JSX, the next
+;; ^ `syntax-propertize' region wouldn’t magically
+;; extend back a few lines.
+;;
+;; Therefore, to try and recover from this scenario, parse backward
+;; from “>” to try and find the start of JSXBoundaryElements, and
+;; extend the `syntax-propertize' region there.
+
+(defun js--syntax-propertize-extend-region (start end)
+ "Extend the START-END region for propertization, if necessary.
+For use by `syntax-propertize-extend-region-functions'."
+ (if js-jsx-syntax (js-jsx--syntax-propertize-extend-region start end)))
+
+(defun js-jsx--syntax-propertize-extend-region (start end)
+ "Extend the START-END region for propertization, if necessary.
+If any “>” in the region appears to be the end of a tag starting
+before the start of the region, extend region backwards to the
+start of that tag so parsing may proceed from that point.
+For use by `syntax-propertize-extend-region-functions'."
+ (let (new-start
+ forward-sexp-function ; Use the Lisp version.
+ parse-sexp-lookup-properties) ; Fix backward-sexp error here.
+ (catch 'stop
+ (goto-char start)
+ (while (re-search-forward ">" end t)
+ (catch 'continue
+ ;; Check if this is really a right shift bitwise operator
+ ;; (“>>” or “>>>”).
+ (unless (or (eq (char-before (1- (point))) ?>)
+ (eq (char-after) ?>))
+ (save-excursion
+ (backward-char)
+ (while (progn (if (= (point) (point-min)) (throw 'continue nil))
+ (/= (char-before) ?<))
+ (skip-chars-backward " \t\n")
+ (if (= (point) (point-min)) (throw 'continue nil))
+ (cond
+ ((memq (char-before) '(?\" ?\' ?\` ?\}))
+ (condition-case nil
+ (backward-sexp)
+ (scan-error (throw 'continue nil))))
+ ((memq (char-before) '(?\/ ?\=)) (backward-char))
+ ((looking-back js--dotted-name-re (line-beginning-position) t)
+ (goto-char (match-beginning 0)))
+ (t (throw 'continue nil))))
+ (when (< (point) start)
+ (setq new-start (1- (point)))
+ (throw 'stop nil)))))))
+ (if new-start (cons new-start end))))
+
+;; When applying syntax properties, since `js-syntax-propertize' uses
+;; `syntax-propertize-rules' to parse JSXBoundaryElements iteratively
+;; and statelessly, whenever we exit such an element, we need to
+;; determine the JSX depth. If >0, then we know we to apply syntax
+;; properties to JSXText up until the next JSXBoundaryElement occurs.
+;; But if the JSX depth is 0, then—importantly—we know to NOT parse
+;; the following code as JSXText, rather propertize it as regular JS
+;; as long as warranted.
+;;
+;; Also, when indenting code, we need to know if the code we’re trying
+;; to indent is on the 2nd or later line of multiline JSX, in which
+;; case the code is indented according to XML-like JSX conventions.
+;;
+;; For the aforementioned reasons, we find ourselves needing to
+;; determine whether point is enclosed in JSX or not; and, if so,
+;; where the JSX is. The following functions provide that knowledge.
+
+(defconst js-jsx--tag-start-re
+ (concat "\\(" js--dotted-name-re "\\)\\(?:"
+ ;; Whitespace is only necessary if an attribute implies JSX.
+ "\\(?:\\s-\\|\n\\)*[{/>]"
+ "\\|"
+ "\\(?:\\s-\\|\n\\)+" js--name-start-re
+ "\\)")
+ "Regexp unambiguously matching a JSXOpeningElement.")
+
+(defun js-jsx--matched-tag-type ()
+ "Determine if the last “<” was a JSXBoundaryElement and its type.
+Return `close' for a JSXClosingElement/JSXClosingFragment match,
+return `self-closing' for some self-closing JSXOpeningElements,
+else return `other'."
+ (cond
+ ((= (char-after) ?/) (forward-char) 'close) ;
JSXClosingElement/JSXClosingFragment
+ ((= (char-after) ?>) (forward-char) 'other) ; JSXOpeningFragment
+ ((and (looking-at js-jsx--tag-start-re) ; JSXOpeningElement
+ (not (js--unary-keyword-p (match-string 1))))
+ (goto-char (match-end 0))
+ (if (= (char-before) ?/) 'self-closing 'other))))
+
+(defconst js-jsx--self-closing-re "/\\s-*>"
+ "Regexp matching the end of a self-closing JSXOpeningElement.")
+
+(defun js-jsx--matching-close-tag-pos ()
+ "Return position of the closer of the opener before point.
+Assuming a JSXOpeningElement or a JSXOpeningFragment is
+immediately before point, find a matching JSXClosingElement or
+JSXClosingFragment, skipping over any nested JSXElements to find
+the match. Return nil if a match can’t be found."
+ (let ((tag-stack 1) tag-pos type last-pos pos)
+ (catch 'stop
+ (while (and (re-search-forward "<\\s-*" nil t) (not (eobp)))
+ (when (setq tag-pos (match-beginning 0)
+ type (js-jsx--matched-tag-type))
+ (when last-pos
+ (setq pos (point))
+ (goto-char last-pos)
+ (while (re-search-forward js-jsx--self-closing-re pos 'move)
+ (setq tag-stack (1- tag-stack))))
+ (if (eq type 'close)
+ (progn
+ (setq tag-stack (1- tag-stack))
+ (when (= tag-stack 0)
+ (throw 'stop tag-pos)))
+ ;; JSXOpeningElements that we know are self-closing aren’t
+ ;; added to the stack at all (because point is already
+ ;; past that syntax).
+ (unless (eq type 'self-closing)
+ (setq tag-stack (1+ tag-stack))))
+ (setq last-pos (point)))))))
+
+(defun js-jsx--enclosing-tag-pos ()
+ "Return beginning and end of a JSXElement about point.
+Look backward for a JSXElement that both starts before point and
+also ends at/after point. That may be either a self-closing
+JSXElement or a JSXOpeningElement/JSXClosingElement pair."
+ (let ((start (point)) tag-beg tag-beg-pos tag-end-pos close-tag-pos)
+ (while
+ (and
+ (setq tag-beg (js--backward-text-property 'js-jsx-tag-beg))
+ (progn
+ (setq tag-beg-pos (point)
+ tag-end-pos (cdr tag-beg))
+ (not
+ (or
+ (and (eq (car tag-beg) 'self-closing)
+ (< start tag-end-pos))
+ (and (eq (car tag-beg) 'open)
+ (or (< start tag-end-pos)
+ (progn
+ (unless
+ ;; Try to read a cached close position,
+ ;; but it might not be available yet.
+ (setq close-tag-pos
+ (get-text-property (point)
'js-jsx-close-tag-pos))
+ (save-excursion
+ (goto-char tag-end-pos)
+ (setq close-tag-pos
(js-jsx--matching-close-tag-pos)))
+ (when close-tag-pos
+ ;; Cache the close position to make future
+ ;; searches faster.
+ (put-text-property
+ (point) (1+ (point))
+ 'js-jsx-close-tag-pos close-tag-pos)))
+ ;; The JSXOpeningElement may be unclosed, else
+ ;; the closure must occur at/after the start
+ ;; point (otherwise, a miscellaneous previous
+ ;; JSXOpeningElement has been found, so keep
+ ;; looking backwards for an enclosing one).
+ (or (not close-tag-pos) (<= start
close-tag-pos)))))))))
+ ;; Don’t return the last tag pos, as it wasn’t enclosing.
+ (setq tag-beg nil close-tag-pos nil))
+ (and tag-beg (list tag-beg-pos tag-end-pos close-tag-pos))))
+
+(defun js-jsx--at-enclosing-tag-child-p ()
+ "Return t if point is at an enclosing tag’s child."
+ (let ((pos (save-excursion (js-jsx--enclosing-tag-pos))))
+ (and pos (>= (point) (nth 1 pos)))))
+
+;; We implement `syntax-propertize-function' logic fully parsing JSX
+;; in order to provide very accurate JSX indentation, even in the most
+;; complex cases (e.g. to indent JSX within a JS expression within a
+;; JSXAttribute…), as over the years users have requested this. Since
+;; we find so much information during this parse, we later use some of
+;; the useful bits for font-locking, too.
+;;
+;; Some extra effort is devoted to ensuring that no code which could
+;; possibly be valid JS is ever misinterpreted as partial JSX, since
+;; that would be regressive.
+;;
+;; We first parse trying to find the minimum number of components
+;; necessary to unambiguously identify a JSXBoundaryElement, even if
+;; it is a partial one. If a complete one is parsed, we move on to
+;; parse any JSXText. When that’s terminated, we unwind back to the
+;; `syntax-propertize-rules' loop so the next JSXBoundaryElement can
+;; be parsed, if any, be it an opening or closing one.
+
+(defun js-jsx--put-syntax-table (start end value)
+ "Set syntax-table text property from START to END as VALUE.
+Redundantly set the value to two properties, syntax-table and
+js-jsx-syntax-table. Derivative modes that remove syntax-table
+text properties may recover the value from the second property." ; i.e.
js2-mode
+ (add-text-properties start end (list 'syntax-table value
+ 'js-jsx-syntax-table value)))
+
+(defun js-jsx--text-range (beg end)
+ "Identify JSXText within a “>/{/}/<” pair."
+ (when (> (- end beg) 0)
+ (save-excursion
+ (goto-char beg)
+ (while (and (skip-chars-forward " \t\n" end) (< (point) end))
+ ;; Comments and string quotes don’t serve their usual
+ ;; syntactic roles in JSXText; make them plain punctuation to
+ ;; negate those roles.
+ (when (or (= (char-after) ?/) ; comment
+ (= (syntax-class (syntax-after (point))) 7)) ; string quote
+ (js-jsx--put-syntax-table (point) (1+ (point)) '(1)))
+ (forward-char)))
+ ;; Mark JSXText so it can be font-locked as non-keywords.
+ (put-text-property beg (1+ beg) 'js-jsx-text (list beg end
(current-buffer)))
+ ;; Ensure future propertization beginning from within the
+ ;; JSXText determines JSXText context from earlier lines.
+ (put-text-property beg end 'syntax-multiline t)))
+
+;; In order to respect the end boundary `syntax-propertize-function'
+;; sets, care is taken in the following functions to abort parsing
+;; whenever that boundary is reached.
+
+(defun js-jsx--syntax-propertize-tag-text (end)
+ "Determine if JSXText is before END and propertize it.
+Text within an open/close tag pair may be JSXText. Temporarily
+interrupt JSXText by JSXExpressionContainers, and terminate
+JSXText when another JSXBoundaryElement is encountered. Despite
+terminations, all JSXText will be identified once all the
+JSXBoundaryElements within an outermost JSXElement’s tree have
+been propertized."
+ (let ((text-beg (point))
+ forward-sexp-function) ; Use Lisp version.
+ (catch 'stop
+ (while (re-search-forward "[{<]" end t)
+ (js-jsx--text-range text-beg (1- (point)))
+ (cond
+ ((= (char-before) ?{)
+ (let (expr-beg expr-end)
+ (condition-case nil
+ (save-excursion
+ (backward-char)
+ (setq expr-beg (point))
+ (forward-sexp)
+ (setq expr-end (point)))
+ (scan-error nil))
+ ;; Recursively propertize the JSXExpressionContainer’s
+ ;; (possibly-incomplete) expression.
+ (js-syntax-propertize (1+ expr-beg) (if expr-end (min (1-
expr-end) end) end))
+ ;; Ensure future propertization beginning from within the
+ ;; (possibly-incomplete) expression can determine JSXText
+ ;; context from earlier lines.
+ (put-text-property expr-beg (1+ expr-beg) 'js-jsx-expr (or
expr-end end)) ; font-lock
+ (put-text-property expr-beg (if expr-end (min expr-end end) end)
'syntax-multiline t) ; syntax-propertize
+ ;; Exit the JSXExpressionContainer if that’s possible,
+ ;; else move to the end of the propertized area.
+ (goto-char (if expr-end (min expr-end end) end))))
+ ((= (char-before) ?<)
+ (backward-char) ; Ensure the next tag can be propertized.
+ (throw 'stop nil)))
+ (setq text-beg (point))))))
+
+(defconst js-jsx--attribute-name-re (concat js--name-start-re
+ "\\(?:\\s_\\|\\sw\\|-\\)*")
+ "Like `js--name-re', but matches “-” as well.")
+
+(defun js-jsx--syntax-propertize-tag (end)
+ "Determine if a JSXBoundaryElement is before END and propertize it.
+Disambiguate JSX from inequality operators and arrow functions by
+testing for syntax only valid as JSX."
+ (let ((tag-beg (1- (point))) tag-end (type 'open)
+ name-beg name-match-data expr-attribute-beg unambiguous
+ forward-sexp-function) ; Use Lisp version.
+ (catch 'stop
+ (while (and (< (point) end)
+ (progn (skip-chars-forward " \t\n" end)
+ (< (point) end)))
+ (cond
+ ((= (char-after) ?>)
+ ;; Make the closing “>” a close parenthesis.
+ (js-jsx--put-syntax-table (point) (1+ (point)) '(5))
+ (forward-char)
+ (setq unambiguous t)
+ (throw 'stop nil))
+ ;; Handle a JSXSpreadChild (“<Foo {...bar}”) or a
+ ;; JSXExpressionContainer as a JSXAttribute value
+ ;; (“<Foo bar={…}”). Check this early in case continuing a
+ ;; JSXAttribute parse.
+ ((or (and name-beg (= (char-after) ?{))
+ (setq expr-attribute-beg nil))
+ (setq unambiguous t) ; JSXExpressionContainer post tag name ⇒ JSX
+ (when expr-attribute-beg
+ ;; Remember that this JSXExpressionContainer is part of a
+ ;; JSXAttribute, as that can affect its expression’s
+ ;; indentation.
+ (put-text-property
+ (point) (1+ (point)) 'js-jsx-expr-attribute expr-attribute-beg)
+ (setq expr-attribute-beg nil))
+ (let (expr-end)
+ (condition-case nil
+ (save-excursion
+ (forward-sexp)
+ (setq expr-end (point)))
+ (scan-error nil))
+ (forward-char)
+ (if (>= (point) end) (throw 'stop nil))
+ (skip-chars-forward " \t\n" end)
+ (if (>= (point) end) (throw 'stop nil))
+ (if (= (char-after) ?}) (forward-char) ; Shortcut to bail.
+ ;; Recursively propertize the JSXExpressionContainer’s
+ ;; expression.
+ (js-syntax-propertize (point) (if expr-end (min (1- expr-end)
end) end))
+ ;; Exit the JSXExpressionContainer if that’s possible,
+ ;; else move to the end of the propertized area.
+ (goto-char (if expr-end (min expr-end end) end)))))
+ ((= (char-after) ?/)
+ ;; Assume a tag is an open tag until a slash is found, then
+ ;; figure out what type it actually is.
+ (if (eq type 'open) (setq type (if name-beg 'self-closing 'close)))
+ (forward-char))
+ ((and (not name-beg) (looking-at js--dotted-name-re))
+ ;; Don’t match code like “if (i < await foo)”
+ (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil))
+ ;; Save boundaries for later fontification after
+ ;; unambiguously determining the code is JSX.
+ (setq name-beg (match-beginning 0)
+ name-match-data (match-data))
+ (goto-char (match-end 0)))
+ ((and name-beg (looking-at js-jsx--attribute-name-re))
+ (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX
+ ;; Save JSXAttribute’s name’s match data for font-locking later.
+ (put-text-property (match-beginning 0) (1+ (match-beginning 0))
+ 'js-jsx-attribute-name (match-data))
+ (goto-char (match-end 0))
+ (if (>= (point) end) (throw 'stop nil))
+ (skip-chars-forward " \t\n" end)
+ (if (>= (point) end) (throw 'stop nil))
+ ;; “=” is optional for null-valued JSXAttributes.
+ (when (= (char-after) ?=)
+ (forward-char)
+ (if (>= (point) end) (throw 'stop nil))
+ (skip-chars-forward " \t\n" end)
+ (if (>= (point) end) (throw 'stop nil))
+ ;; Skip over strings (if possible). Any
+ ;; JSXExpressionContainer here will be parsed in the
+ ;; next iteration of the loop.
+ (if (memq (char-after) '(?\" ?\' ?\`))
+ (progn
+ ;; Record the string’s position so derived modes
+ ;; applying syntactic fontification atypically
+ ;; (e.g. js2-mode) can recognize it as part of JSX.
+ (put-text-property (point) (1+ (point)) 'js-jsx-string t)
+ (condition-case nil
+ (forward-sexp)
+ (scan-error (throw 'stop nil))))
+ ;; Save JSXAttribute’s beginning in case we find a
+ ;; JSXExpressionContainer as the JSXAttribute’s value which
+ ;; we should associate with the JSXAttribute.
+ (setq expr-attribute-beg (match-beginning 0)))))
+ ;; There is nothing more to check; this either isn’t JSX, or
+ ;; the tag is incomplete.
+ (t (throw 'stop nil)))))
+ (when unambiguous
+ ;; Save JSXBoundaryElement’s name’s match data for font-locking.
+ (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name
name-match-data))
+ ;; Make the opening “<” an open parenthesis.
+ (js-jsx--put-syntax-table tag-beg (1+ tag-beg) '(4))
+ ;; Prevent “out of range” errors when typing at the end of a buffer.
+ (setq tag-end (if (eobp) (1- (point)) (point)))
+ ;; Mark beginning and end of tag for font-locking.
+ (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type
tag-end))
+ (put-text-property tag-end (1+ tag-end) 'js-jsx-tag-end tag-beg)
+ ;; Use text properties to extend the syntax-propertize region
+ ;; backward to the beginning of the JSXBoundaryElement in the
+ ;; future. Typically the closing angle bracket could suggest
+ ;; extending backward, but that would also involve more rigorous
+ ;; parsing, and the closing angle bracket may not even exist yet
+ ;; if the JSXBoundaryElement is still being typed.
+ (put-text-property tag-beg (1+ tag-end) 'syntax-multiline t))
+ (if (js-jsx--at-enclosing-tag-child-p) (js-jsx--syntax-propertize-tag-text
end))))
+
+(defconst js-jsx--text-properties
+ (list
+ 'js-jsx-tag-beg nil 'js-jsx-tag-end nil 'js-jsx-close-tag-pos nil
+ 'js-jsx-tag-name nil 'js-jsx-attribute-name nil 'js-jsx-string nil
+ 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil
+ 'js-jsx-syntax-table nil)
+ "Plist of text properties added by `js-syntax-propertize'.")
+
(defun js-syntax-propertize (start end)
;; JavaScript allows immediate regular expression objects, written /.../.
(goto-char start)
+ (if js-jsx-syntax (remove-text-properties start end js-jsx--text-properties))
(js-syntax-propertize-regexp end)
(funcall
(syntax-propertize-rules
@@ -1748,7 +2364,8 @@ This performs fontification according to
`js--class-styles'."
(put-text-property (match-beginning 1) (match-end 1)
'syntax-table (string-to-syntax "\"/"))
(js-syntax-propertize-regexp end)))))
- ("\\`\\(#\\)!" (1 "< b")))
+ ("\\`\\(#\\)!" (1 "< b"))
+ ("<" (0 (ignore (if js-jsx-syntax (js-jsx--syntax-propertize-tag end))))))
(point) end))
(defconst js--prettify-symbols-alist
@@ -1774,6 +2391,11 @@ This performs fontification according to
`js--class-styles'."
(js--regexp-opt-symbol '("in" "instanceof")))
"Regexp matching operators that affect indentation of continued
expressions.")
+(defun js-jsx--looking-at-start-tag-p ()
+ "Non-nil if a JSXOpeningElement immediately follows point."
+ (let ((tag-beg (get-text-property (point) 'js-jsx-tag-beg)))
+ (and tag-beg (memq (car tag-beg) '(open self-closing)))))
+
(defun js--looking-at-operator-p ()
"Return non-nil if point is on a JavaScript operator, other than a comma."
(save-match-data
@@ -1796,7 +2418,9 @@ This performs fontification according to
`js--class-styles'."
(js--backward-syntactic-ws)
;; We might misindent some expressions that would
;; return NaN anyway. Shouldn't be a problem.
- (memq (char-before) '(?, ?} ?{))))))))
+ (memq (char-before) '(?, ?} ?{)))))
+ ;; “<” isn’t necessarily an operator in JSX.
+ (not (and js-jsx-syntax (js-jsx--looking-at-start-tag-p))))))
(defun js--find-newline-backward ()
"Move backward to the nearest newline that is not in a block comment."
@@ -1816,6 +2440,10 @@ This performs fontification according to
`js--class-styles'."
(setq result nil)))
result))
+(defun js-jsx--looking-back-at-end-tag-p ()
+ "Non-nil if a JSXClosingElement immediately precedes point."
+ (get-text-property (point) 'js-jsx-tag-end))
+
(defun js--continued-expression-p ()
"Return non-nil if the current line continues an expression."
(save-excursion
@@ -1833,12 +2461,19 @@ This performs fontification according to
`js--class-styles'."
(and (js--find-newline-backward)
(progn
(skip-chars-backward " \t")
- (or (bobp) (backward-char))
- (and (> (point) (point-min))
- (save-excursion (backward-char) (not (looking-at
"[/*]/\\|=>")))
- (js--looking-at-operator-p)
- (and (progn (backward-char)
- (not (looking-at "\\+\\+\\|--\\|/[/*]"))))))))))
+ (and
+ ;; The “>” at the end of any JSXBoundaryElement isn’t
+ ;; part of a continued expression.
+ (not (and js-jsx-syntax (js-jsx--looking-back-at-end-tag-p)))
+ (progn
+ (or (bobp) (backward-char))
+ (and (> (point) (point-min))
+ (save-excursion
+ (backward-char)
+ (not (looking-at "[/*]/\\|=>")))
+ (js--looking-at-operator-p)
+ (and (progn (backward-char)
+ (not (looking-at
"\\+\\+\\|--\\|/[/*]"))))))))))))
(defun js--skip-term-backward ()
"Skip a term before point; return t if a term was skipped."
@@ -2064,23 +2699,182 @@ indentation is aligned to that column."
(when comma-p
(goto-char (1+ declaration-keyword-end))))))))
-(defconst js--line-terminating-arrow-re "\\s-*=>\\s-*\\(/[/*]\\|$\\)"
+(defconst js--line-terminating-arrow-re "=>\\s-*\\(/[/*]\\|$\\)"
"Regexp matching the last \"=>\" (arrow) token on a line.
Whitespace and comments around the arrow are ignored.")
-(defun js--looking-at-broken-arrow-function-p ()
+(defun js--broken-arrow-terminates-line-p ()
"Helper function for `js--proper-indentation'.
-Return t if point is at the start of a (possibly async) arrow
-function and the last non-comment, non-whitespace token of the
-current line is the \"=>\" token."
- (when (looking-at "\\s-*async\\s-*")
- (goto-char (match-end 0)))
- (cond
- ((eq (char-after) ?\()
- (forward-list)
- (looking-at-p js--line-terminating-arrow-re))
- (t (looking-at-p
- (concat js--name-re js--line-terminating-arrow-re)))))
+Return t if the last non-comment, non-whitespace token of the
+current line is the \"=>\" token (of an arrow function)."
+ (let ((from (point)))
+ (end-of-line)
+ (re-search-backward js--line-terminating-arrow-re from t)))
+
+;; When indenting, we want to know if the line is…
+;;
+;; - within a multiline JSXElement, or
+;; - within a string in a JSXBoundaryElement, or
+;; - within JSXText, or
+;; - within a JSXAttribute’s multiline JSXExpressionContainer.
+;;
+;; In these cases, special XML-like indentation rules for JSX apply.
+;; If JS is nested within JSX, then indentation calculations may be
+;; combined, such that JS indentation is “relative” to the JSX’s.
+;;
+;; Therefore, functions below provide such contextual information, and
+;; `js--proper-indentation' may call itself once recursively in order
+;; to finish calculating that “relative” JS+JSX indentation.
+
+(defun js-jsx--context ()
+ "Determine JSX context and move to enclosing JSX."
+ (let ((pos (point))
+ (parse-status (syntax-ppss))
+ (enclosing-tag-pos (js-jsx--enclosing-tag-pos)))
+ (when enclosing-tag-pos
+ (if (< pos (nth 1 enclosing-tag-pos))
+ (if (nth 3 parse-status)
+ (list 'string (nth 8 parse-status))
+ (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos)))
+ (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos))))))
+
+(defun js-jsx--contextual-indentation (line context)
+ "Calculate indentation column for LINE from CONTEXT.
+The column calculation is based off of `sgml-calculate-indent'."
+ (pcase (nth 0 context)
+
+ ('string
+ ;; Go back to previous non-empty line.
+ (while (and (> (point) (nth 1 context))
+ (zerop (forward-line -1))
+ (looking-at "[ \t]*$")))
+ (if (> (point) (nth 1 context))
+ ;; Previous line is inside the string.
+ (current-indentation)
+ (goto-char (nth 1 context))
+ (1+ (current-column))))
+
+ ('tag
+ ;; Special JSX indentation rule: a “dangling” closing angle
+ ;; bracket on its own line is indented at the same level as the
+ ;; opening angle bracket of the JSXElement. Otherwise, indent
+ ;; JSXAttribute space like SGML.
+ (if (and
+ js-jsx-align->-with-<
+ (progn
+ (goto-char (nth 2 context))
+ (and (= line (line-number-at-pos))
+ (looking-back "^\\s-*/?>" (line-beginning-position)))))
+ (progn
+ (goto-char (nth 1 context))
+ (current-column))
+ ;; Indent JSXAttribute space like SGML.
+ (goto-char (nth 1 context))
+ ;; Skip tag name:
+ (skip-chars-forward " \t")
+ (skip-chars-forward "^ \t\n")
+ (skip-chars-forward " \t")
+ (if (not (eolp))
+ (current-column)
+ ;; This is the first attribute: indent.
+ (goto-char (+ (nth 1 context) js-jsx-attribute-offset))
+ (+ (current-column) (or js-jsx-indent-level js-indent-level)))))
+
+ ('text
+ ;; Indent to reflect nesting.
+ (goto-char (nth 1 context))
+ (+ (current-column)
+ ;; The last line isn’t nested, but the rest are.
+ (if (or (not (nth 2 context)) ; Unclosed.
+ (< line (line-number-at-pos (nth 2 context))))
+ (or js-jsx-indent-level js-indent-level)
+ 0)))
+
+ ))
+
+(defun js-jsx--enclosing-curly-pos ()
+ "Return position of enclosing “{” in a “{/}” pair about point."
+ (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos)
+ (while
+ (and
+ (setq paren-pos (car parens))
+ (not (when (= (char-after paren-pos) ?{)
+ (setq curly-pos paren-pos)))
+ (setq parens (cdr parens))))
+ curly-pos))
+
+(defun js-jsx--goto-outermost-enclosing-curly (limit)
+ "Set point to enclosing “{” at or closest after LIMIT."
+ (let (pos)
+ (while
+ (and
+ (setq pos (js-jsx--enclosing-curly-pos))
+ (if (>= pos limit) (goto-char pos))
+ (> pos limit)))))
+
+(defun js-jsx--expr-attribute-pos (start limit)
+ "Look back from START to LIMIT for a JSXAttribute."
+ (save-excursion
+ (goto-char start) ; Skip the first curly.
+ ;; Skip any remaining enclosing curlies until the JSXElement’s
+ ;; beginning position; the last curly ought to be one of a
+ ;; JSXExpressionContainer, which may refer to its JSXAttribute’s
+ ;; beginning position (if it has one).
+ (js-jsx--goto-outermost-enclosing-curly limit)
+ (get-text-property (point) 'js-jsx-expr-attribute)))
+
+(defvar js-jsx--indent-col nil
+ "Baseline column for JS indentation within JSX.")
+
+(defvar js-jsx--indent-attribute-line nil
+ "Line relative to which indentation uses JSX as a baseline.")
+
+(defun js-jsx--expr-indentation (parse-status pos col)
+ "Indent using PARSE-STATUS; relative to POS, use base COL.
+To indent a JSXExpressionContainer’s expression, calculate the JS
+indentation, using JSX indentation as the base column when
+indenting relative to the beginning line of the
+JSXExpressionContainer’s JSXAttribute (if any)."
+ (let* ((js-jsx--indent-col col)
+ (js-jsx--indent-attribute-line
+ (if pos (line-number-at-pos pos))))
+ (js--proper-indentation parse-status)))
+
+(defun js-jsx--indentation (parse-status)
+ "Helper function for `js--proper-indentation'.
+Return the proper indentation of the current line if it is part
+of a JSXElement expression spanning multiple lines; otherwise,
+return nil."
+ (let ((current-line (line-number-at-pos))
+ (curly-pos (js-jsx--enclosing-curly-pos))
+ nth-context context expr-p beg-line col
+ forward-sexp-function) ; Use the Lisp version.
+ ;; Find the immediate context for indentation information, but
+ ;; keep going to determine that point is at the N+1th line of
+ ;; multiline JSX.
+ (save-excursion
+ (while
+ (and
+ (setq nth-context (js-jsx--context))
+ (progn
+ (unless context
+ (setq context nth-context)
+ (setq expr-p (and curly-pos (< (point) curly-pos))))
+ (setq beg-line (line-number-at-pos))
+ (and
+ (= beg-line current-line)
+ (or (not curly-pos) (> (point) curly-pos)))))))
+ ;; When on the second or later line of JSX, indent as JSX,
+ ;; possibly switching back to JS indentation within
+ ;; JSXExpressionContainers, possibly using the JSX as a base
+ ;; column while switching back to JS indentation.
+ (when (and context (> current-line beg-line))
+ (save-excursion
+ (setq col (js-jsx--contextual-indentation current-line context)))
+ (if expr-p
+ (js-jsx--expr-indentation
+ parse-status (js-jsx--expr-attribute-pos curly-pos (nth 1 context))
col)
+ col))))
(defun js--proper-indentation (parse-status)
"Return the proper indentation for the current line."
@@ -2089,6 +2883,8 @@ current line is the \"=>\" token."
(cond ((nth 4 parse-status) ; inside comment
(js--get-c-offset 'c (nth 8 parse-status)))
((nth 3 parse-status) 0) ; inside string
+ ((when (and js-jsx-syntax (not js-jsx--indent-col))
+ (save-excursion (js-jsx--indentation parse-status))))
((eq (char-after) ?#) 0)
((save-excursion (js--beginning-of-macro)) 4)
;; Indent array comprehension continuation lines specially.
@@ -2113,7 +2909,7 @@ current line is the \"=>\" token."
(goto-char (nth 1 parse-status)) ; go to the opening char
(if (or (not js-indent-align-list-continuation)
(looking-at "[({[]\\s-*\\(/[/*]\\|$\\)")
- (save-excursion (forward-char)
(js--looking-at-broken-arrow-function-p)))
+ (save-excursion (forward-char)
(js--broken-arrow-terminates-line-p)))
(progn ; nothing following the opening paren/bracket
(skip-syntax-backward " ")
(when (eq (char-before) ?\)) (backward-list))
@@ -2125,17 +2921,24 @@ current line is the \"=>\" token."
(and switch-keyword-p
in-switch-p)))
(indent
- (cond (same-indent-p
- (current-column))
- (continued-expr-p
- (+ (current-column) (* 2 js-indent-level)
- js-expr-indent-offset))
- (t
- (+ (current-column) js-indent-level
- (pcase (char-after (nth 1 parse-status))
- (?\( js-paren-indent-offset)
- (?\[ js-square-indent-offset)
- (?\{ js-curly-indent-offset)))))))
+ (+
+ (cond
+ ((and js-jsx--indent-attribute-line
+ (eq js-jsx--indent-attribute-line
+ (line-number-at-pos)))
+ js-jsx--indent-col)
+ (t
+ (current-column)))
+ (cond (same-indent-p 0)
+ (continued-expr-p
+ (+ (* 2 js-indent-level)
+ js-expr-indent-offset))
+ (t
+ (+ js-indent-level
+ (pcase (char-after (nth 1 parse-status))
+ (?\( js-paren-indent-offset)
+ (?\[ js-square-indent-offset)
+ (?\{ js-curly-indent-offset))))))))
(if in-switch-p
(+ indent js-switch-indent-offset)
indent)))
@@ -2151,193 +2954,6 @@ current line is the \"=>\" token."
(+ js-indent-level js-expr-indent-offset))
(t (prog-first-column)))))
-;;; JSX Indentation
-
-(defsubst js--jsx-find-before-tag ()
- "Find where JSX starts.
-
-Assume JSX appears in the following instances:
-- Inside parentheses, when returned or as the first argument
- to a function, and after a newline
-- When assigned to variables or object properties, but only
- on a single line
-- As the N+1th argument to a function
-
-This is an optimized version of (re-search-backward \"[(,]\n\"
-nil t), except set point to the end of the match. This logic
-executes up to the number of lines in the file, so it should be
-really fast to reduce that impact."
- (let (pos)
- (while (and (> (point) (point-min))
- (not (progn
- (end-of-line 0)
- (when (or (eq (char-before) 40) ; (
- (eq (char-before) 44)) ; ,
- (setq pos (1- (point))))))))
- pos))
-
-(defconst js--jsx-end-tag-re
- (concat "</" sgml-name-re ">\\|/>")
- "Find the end of a JSX element.")
-
-(defconst js--jsx-after-tag-re "[),]"
- "Find where JSX ends.
-This complements the assumption of where JSX appears from
-`js--jsx-before-tag-re', which see.")
-
-(defun js--jsx-indented-element-p ()
- "Determine if/how the current line should be indented as JSX.
-
-Return `first' for the first JSXElement on its own line.
-Return `nth' for subsequent lines of the first JSXElement.
-Return `expression' for an embedded JS expression.
-Return `after' for anything after the last JSXElement.
-Return nil for non-JSX lines.
-
-Currently, JSX indentation supports the following styles:
-
-- Single-line elements (indented like normal JS):
-
- var element = <div></div>;
-
-- Multi-line elements (enclosed in parentheses):
-
- function () {
- return (
- <div>
- <div></div>
- </div>
- );
- }
-
-- Function arguments:
-
- React.render(
- <div></div>,
- document.querySelector('.root')
- );"
- (let ((current-pos (point))
- (current-line (line-number-at-pos))
- last-pos
- before-tag-pos before-tag-line
- tag-start-pos tag-start-line
- tag-end-pos tag-end-line
- after-tag-line
- parens paren type)
- (save-excursion
- (and
- ;; Determine if we're inside a jsx element
- (progn
- (end-of-line)
- (while (and (not tag-start-pos)
- (setq last-pos (js--jsx-find-before-tag)))
- (while (forward-comment 1))
- (when (= (char-after) 60) ; <
- (setq before-tag-pos last-pos
- tag-start-pos (point)))
- (goto-char last-pos))
- tag-start-pos)
- (progn
- (setq before-tag-line (line-number-at-pos before-tag-pos)
- tag-start-line (line-number-at-pos tag-start-pos))
- (and
- ;; A "before" line which also starts an element begins with js, so
- ;; indent it like js
- (> current-line before-tag-line)
- ;; Only indent the jsx lines like jsx
- (>= current-line tag-start-line)))
- (cond
- ;; Analyze bounds if there are any
- ((progn
- (while (and (not tag-end-pos)
- (setq last-pos (re-search-forward js--jsx-end-tag-re
nil t)))
- (while (forward-comment 1))
- (when (looking-at js--jsx-after-tag-re)
- (setq tag-end-pos last-pos)))
- tag-end-pos)
- (setq tag-end-line (line-number-at-pos tag-end-pos)
- after-tag-line (line-number-at-pos after-tag-line))
- (or (and
- ;; Ensure we're actually within the bounds of the jsx
- (<= current-line tag-end-line)
- ;; An "after" line which does not end an element begins with
- ;; js, so indent it like js
- (<= current-line after-tag-line))
- (and
- ;; Handle another case where there could be e.g. comments after
- ;; the element
- (> current-line tag-end-line)
- (< current-line after-tag-line)
- (setq type 'after))))
- ;; They may not be any bounds (yet)
- (t))
- ;; Check if we're inside an embedded multi-line js expression
- (cond
- ((not type)
- (goto-char current-pos)
- (end-of-line)
- (setq parens (nth 9 (syntax-ppss)))
- (while (and parens (not type))
- (setq paren (car parens))
- (cond
- ((and (>= paren tag-start-pos)
- ;; Curly bracket indicates the start of an embedded
expression
- (= (char-after paren) 123) ; {
- ;; The first line of the expression is indented like sgml
- (> current-line (line-number-at-pos paren))
- ;; Check if within a closing curly bracket (if any)
- ;; (exclusive, as the closing bracket is indented like sgml)
- (cond
- ((progn
- (goto-char paren)
- (ignore-errors (let (forward-sexp-function)
- (forward-sexp))))
- (< current-line (line-number-at-pos)))
- (t)))
- ;; Indicate this guy will be indented specially
- (setq type 'expression))
- (t (setq parens (cdr parens)))))
- t)
- (t))
- (cond
- (type)
- ;; Indent the first jsx thing like js so we can indent future jsx
things
- ;; like sgml relative to the first thing
- ((= current-line tag-start-line) 'first)
- ('nth))))))
-
-(defmacro js--as-sgml (&rest body)
- "Execute BODY as if in sgml-mode."
- `(with-syntax-table sgml-mode-syntax-table
- (let (forward-sexp-function
- parse-sexp-lookup-properties)
- ,@body)))
-
-(defun js--expression-in-sgml-indent-line ()
- "Indent the current line as JavaScript or SGML (whichever is farther)."
- (let* (indent-col
- (savep (point))
- ;; Don't whine about errors/warnings when we're indenting.
- ;; This has to be set before calling parse-partial-sexp below.
- (inhibit-point-motion-hooks t)
- (parse-status (save-excursion
- (syntax-ppss (point-at-bol)))))
- ;; Don't touch multiline strings.
- (unless (nth 3 parse-status)
- (setq indent-col (save-excursion
- (back-to-indentation)
- (if (>= (point) savep) (setq savep nil))
- (js--as-sgml (sgml-calculate-indent))))
- (if (null indent-col)
- 'noindent
- ;; Use whichever indentation column is greater, such that the sgml
- ;; column is effectively a minimum
- (setq indent-col (max (js--proper-indentation parse-status)
- (+ indent-col js-indent-level)))
- (if savep
- (save-excursion (indent-line-to indent-col))
- (indent-line-to indent-col))))))
-
(defun js-indent-line ()
"Indent the current line as JavaScript."
(interactive)
@@ -2349,23 +2965,9 @@ Currently, JSX indentation supports the following styles:
(when (> offset 0) (forward-char offset)))))
(defun js-jsx-indent-line ()
- "Indent the current line as JSX (with SGML offsets).
-i.e., customize JSX element indentation with `sgml-basic-offset',
-`sgml-attribute-offset' et al."
+ "Indent the current line as JavaScript+JSX."
(interactive)
- (let ((indentation-type (js--jsx-indented-element-p)))
- (cond
- ((eq indentation-type 'expression)
- (js--expression-in-sgml-indent-line))
- ((or (eq indentation-type 'first)
- (eq indentation-type 'after))
- ;; Don't treat this first thing as a continued expression (often a "<" or
- ;; ">" causes this misinterpretation)
- (cl-letf (((symbol-function #'js--continued-expression-p) 'ignore))
- (js-indent-line)))
- ((eq indentation-type 'nth)
- (js--as-sgml (sgml-indent-line)))
- (t (js-indent-line)))))
+ (let ((js-jsx-syntax t)) (js-indent-line)))
;;; Filling
@@ -3856,6 +4458,77 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
(when temp-name
(delete-file temp-name))))))
+;;; Syntax extensions
+
+(defvar js-syntactic-mode-name t
+ "If non-nil, print enabled syntaxes in the mode name.")
+
+(defun js--syntactic-mode-name-part ()
+ "Return a string like “[JSX]” when `js-jsx-syntax' is enabled."
+ (if js-syntactic-mode-name
+ (let (syntaxes)
+ (if js-jsx-syntax (push "JSX" syntaxes))
+ (if syntaxes
+ (concat "[" (mapconcat #'identity syntaxes ",") "]")
+ ""))
+ ""))
+
+(defun js-use-syntactic-mode-name ()
+ "Print enabled syntaxes if `js-syntactic-mode-name' is t.
+Modes deriving from `js-mode' should call this to ensure that
+their `mode-name' updates to show enabled syntax extensions."
+ (when (stringp mode-name)
+ (setq mode-name `(,mode-name (:eval (js--syntactic-mode-name-part))))))
+
+(defun js-jsx-enable ()
+ "Enable JSX in the current buffer."
+ (interactive)
+ (setq-local js-jsx-syntax t))
+
+;; To make discovering and using syntax extensions features easier for
+;; users (who might not read the docs), try to safely and
+;; automatically enable syntax extensions based on heuristics.
+
+(defvar js-jsx-regexps
+ (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React")
+ "Regexps for detecting JSX in JavaScript buffers.
+When `js-jsx-detect-syntax' is non-nil and any of these regexps
+match text near the beginning of a JavaScript buffer,
+`js-jsx-syntax' (which see) will be made buffer-local and set to
+t.")
+
+(defun js-jsx--detect-and-enable (&optional arbitrarily)
+ "Detect if JSX is likely to be used, and enable it if so.
+Might make `js-jsx-syntax' buffer-local and set it to t. Matches
+from the beginning of the buffer, unless optional arg ARBITRARILY
+is non-nil. Return t after enabling, nil otherwise."
+ (when (or (and (buffer-file-name)
+ (string-match-p "\\.jsx\\'" (buffer-file-name)))
+ (and js-jsx-detect-syntax
+ (save-excursion
+ (unless arbitrarily
+ (goto-char (point-min)))
+ (catch 'match
+ (mapc
+ (lambda (regexp)
+ (if (re-search-forward regexp 4000 t) (throw 'match
t)))
+ js-jsx-regexps)
+ nil))))
+ (js-jsx-enable)
+ t))
+
+(defun js-jsx--detect-after-change (beg end _len)
+ "Detect if JSX is likely to be used after a change.
+This function is intended for use in `after-change-functions'."
+ (when (<= end 4000)
+ (save-excursion
+ (goto-char beg)
+ (beginning-of-line)
+ (save-restriction
+ (narrow-to-region (point) end)
+ (when (js-jsx--detect-and-enable 'arbitrarily)
+ (remove-hook 'after-change-functions #'js-jsx--detect-after-change
t))))))
+
;;; Main Function
;;;###autoload
@@ -3871,6 +4544,10 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
'(font-lock-syntactic-face-function
. js-font-lock-syntactic-face-function)))
(setq-local syntax-propertize-function #'js-syntax-propertize)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'syntax-propertize-multiline 'append 'local)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'js--syntax-propertize-extend-region 'append 'local)
(setq-local prettify-symbols-alist js--prettify-symbols-alist)
(setq-local parse-sexp-ignore-comments t)
@@ -3878,6 +4555,7 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
;; Comments
(setq-local comment-start "// ")
+ (setq-local comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
(setq-local comment-end "")
(setq-local fill-paragraph-function #'js-fill-paragraph)
(setq-local normal-auto-fill-function #'js-do-auto-fill)
@@ -3888,6 +4566,11 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
;; Frameworks
(js--update-quick-match-re)
+ ;; Syntax extensions
+ (unless (js-jsx--detect-and-enable)
+ (add-hook 'after-change-functions #'js-jsx--detect-after-change nil t))
+ (js-use-syntactic-mode-name)
+
;; Imenu
(setq imenu-case-fold-search nil)
(setq imenu-create-index-function #'js--imenu-create-index)
@@ -3898,8 +4581,7 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
c-paragraph-separate "$"
c-block-comment-prefix "* "
c-line-comment-starter "//"
- c-comment-start-regexp "/[*/]\\|\\s!"
- comment-start-skip "\\(//+\\|/\\*+\\)\\s *")
+ c-comment-start-regexp "/[*/]\\|\\s!")
(setq-local comment-line-break-function #'c-indent-new-comment-line)
(setq-local c-block-comment-start-regexp "/\\*")
(setq-local comment-multi-line t)
@@ -3932,19 +4614,33 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
;;(syntax-propertize (point-max))
)
-;;;###autoload
-(define-derived-mode js-jsx-mode js-mode "JSX"
- "Major mode for editing JSX.
-
-To customize the indentation for this mode, set the SGML offset
-variables (`sgml-basic-offset', `sgml-attribute-offset' et al.)
-locally, like so:
+;; Since we made JSX support available and automatically-enabled in
+;; the base `js-mode' (for ease of use), now `js-jsx-mode' simply
+;; serves as one other interface to unconditionally enable JSX in
+;; buffers, mostly for backwards-compatibility.
+;;
+;; Since it is probably more common for packages to integrate with
+;; `js-mode' than with `js-jsx-mode', it is therefore probably
+;; slightly better for users to use one of the many other methods for
+;; enabling JSX syntax. But using `js-jsx-mode' can’t be that bad
+;; either, so we won’t bother users with an obsoletion warning.
- (defun set-jsx-indentation ()
- (setq-local sgml-basic-offset js-indent-level))
- (add-hook \\='js-jsx-mode-hook #\\='set-jsx-indentation)"
+;;;###autoload
+(define-derived-mode js-jsx-mode js-mode "JavaScript"
+ "Major mode for editing JavaScript+JSX.
+
+Simply makes `js-jsx-syntax' buffer-local and sets it to t.
+
+`js-mode' may detect and enable support for JSX automatically if
+it appears to be used in a JavaScript file. You could also
+customize `js-jsx-regexps' to improve that detection; or, you
+could set `js-jsx-syntax' to t in your init file, or in a
+.dir-locals.el file, or using file variables; or, you could call
+`js-jsx-enable' in `js-mode-hook'. You may be better served by
+one of the aforementioned options instead of using this mode."
:group 'js
- (setq-local indent-line-function #'js-jsx-indent-line))
+ (js-jsx-enable)
+ (js-use-syntactic-mode-name))
;;;###autoload (defalias 'javascript-mode 'js-mode)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 5d0d03d..b05f9a3 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -675,7 +675,7 @@ Which one will be chosen depends on the value of
(defconst python-syntax-propertize-function
(syntax-propertize-rules
- ((python-rx string-delimiter)
+ ((rx (or "\"\"\"" "'''"))
(0 (ignore (python-syntax-stringify))))))
(define-obsolete-variable-alias 'python--prettify-symbols-alist
@@ -701,35 +701,27 @@ is used to limit the scan."
(defun python-syntax-stringify ()
"Put `syntax-table' property correctly on single/triple quotes."
- (let* ((num-quotes (length (match-string-no-properties 1)))
- (ppss (prog2
- (backward-char num-quotes)
- (syntax-ppss)
- (forward-char num-quotes)))
- (string-start (and (not (nth 4 ppss)) (nth 8 ppss)))
- (quote-starting-pos (- (point) num-quotes))
- (quote-ending-pos (point))
- (num-closing-quotes
- (and string-start
- (python-syntax-count-quotes
- (char-before) string-start quote-starting-pos))))
- (cond ((and string-start (= num-closing-quotes 0))
- ;; This set of quotes doesn't match the string starting
- ;; kind. Do nothing.
+ (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss)))
+ (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss)))
+ (quote-starting-pos (- (point) 3))
+ (quote-ending-pos (point)))
+ (cond ((or (nth 4 ppss) ;Inside a comment
+ (and string-start
+ ;; Inside of a string quoted with different triple quotes.
+ (not (eql (char-after string-start)
+ (char-after quote-starting-pos)))))
+ ;; Do nothing.
nil)
- ((not string-start)
+ ((nth 5 ppss)
+ ;; The first quote is escaped, so it's not part of a triple quote!
+ (goto-char (1+ quote-starting-pos)))
+ ((null string-start)
;; This set of quotes delimit the start of a string.
(put-text-property quote-starting-pos (1+ quote-starting-pos)
'syntax-table (string-to-syntax "|")))
- ((= num-quotes num-closing-quotes)
+ (t
;; This set of quotes delimit the end of a string.
(put-text-property (1- quote-ending-pos) quote-ending-pos
- 'syntax-table (string-to-syntax "|")))
- ((> num-quotes num-closing-quotes)
- ;; This may only happen whenever a triple quote is closing
- ;; a single quoted string. Add string delimiter syntax to
- ;; all three quotes.
- (put-text-property quote-starting-pos quote-ending-pos
'syntax-table (string-to-syntax "|"))))))
(defvar python-mode-syntax-table
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index dd3a6fa..853a350 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -2905,8 +2905,7 @@ STRING This is ignored for the purposes of
calculating
(setq align-point (point))))
(or (bobp)
(forward-char -1))
- ;; FIXME: This charset looks too much like a regexp. --Stef
- (skip-chars-forward "[a-z0-9]*?")
+ (skip-chars-forward "*0-9?[]a-z")
)
((string-match "[])}]" x)
(setq x (sh-safe-forward-sexp -1))
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6d91d84..4ab174d 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -3105,7 +3105,7 @@ displayed."
(defun sql-end-of-statement (arg)
"Move to the end of the current SQL statement."
(interactive "p")
- (let ((term (sql-get-product-feature sql-product :terminator))
+ (let ((term (or (sql-get-product-feature sql-product :terminator) ";"))
(re-search (if (> 0 arg) 're-search-backward 're-search-forward))
(here (point))
(n 0))
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 9e241c7..e75e584 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -121,7 +121,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2019-03-05-39b4dac-vpo-GNU"
+(defconst verilog-mode-version "2019-04-02-5d62d3f-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -1285,6 +1285,13 @@ See the \\[verilog-faq] for examples on using this."
:type '(choice (const nil) regexp))
(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp)
+(defcustom verilog-auto-reg-input-assigned-ignore-regexp nil
+ "If non-nil, when creating AUTOINPUTREG, ignore signals matching this
regexp."
+ :version "27.1"
+ :group 'verilog-mode-auto
+ :type '(choice (const nil) regexp))
+(put 'verilog-auto-reg-input-assigned-ignore-regexp 'safe-local-variable
'stringp)
+
(defcustom verilog-auto-inout-ignore-regexp nil
"If non-nil, when creating AUTOINOUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
@@ -2053,7 +2060,7 @@ find the errors."
"`resetall" "`timescale" "`unconnected_drive" "`undef" "`undefineall"
;; compiler directives not covered by IEEE 1800
"`case" "`default" "`endfor" "`endprotect" "`endswitch" "`endwhile"
"`for"
- "`format" "`if" "`let" "`protect" "`switch" "`timescale" "`time_scale"
+ "`format" "`if" "`let" "`protect" "`switch" "`time_scale"
"`while"
))
"List of Verilog compiler directives.")
@@ -2144,14 +2151,7 @@ find the errors."
) nil ) ) )
(defconst verilog-vmm-statement-re
- (eval-when-compile
- (verilog-regexp-opt
- '(
-
"`vmm_\\(data\\|env\\|scenario\\|subenv\\|xactor\\)_member_\\(scalar\\|string\\|enum\\|vmm_data\\|channel\\|xactor\\|subenv\\|user_defined\\)\\(_array\\)?"
- ;; "`vmm_xactor_member_enum_array"
- ;; "`vmm_xactor_member_scalar_array"
- ;; "`vmm_xactor_member_scalar"
- ) nil )))
+
"`vmm_\\(data\\|env\\|scenario\\|subenv\\|xactor\\)_member_\\(scalar\\|string\\|enum\\|vmm_data\\|channel\\|xactor\\|subenv\\|user_defined\\)\\(_array\\)?")
(defconst verilog-ovm-statement-re
(eval-when-compile
@@ -2414,9 +2414,7 @@ find the errors."
'(
;; blocking assignment_operator
"=" "+=" "-=" "*=" "/=" "%=" "&=" "|=" "^=" "<<=" ">>=" "<<<=" ">>>="
- ;; non blocking assignment operator
- "<="
- ;; comparison
+ ;; comparison (also nonblocking assignment "<=")
"==" "!=" "===" "!==" "<=" ">=" "==?" "!=?" "<->"
;; event_trigger
"->" "->>"
@@ -2763,12 +2761,12 @@ find the errors."
(defconst verilog-declaration-re-2-no-macro
(concat "\\s-*" verilog-declaration-re
"\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\("
verilog-delay-re "\\)"
- "\\)?"))
+ "\\)"))
(defconst verilog-declaration-re-2-macro
(concat "\\s-*" verilog-declaration-re
"\\s-*\\(\\(" verilog-optional-signed-range-re "\\)\\|\\("
verilog-delay-re "\\)"
"\\|\\(" verilog-macroexp-re "\\)"
- "\\)?"))
+ "\\)"))
(defconst verilog-declaration-re-1-macro
(concat "^" verilog-declaration-re-2-macro))
@@ -2973,9 +2971,10 @@ find the errors."
"\\<\\(`pragma\\)\\>\\s-+.+$"
"\\)\\|\\(?:"
;; `timescale time_unit / time_precision
-
"\\<\\(`timescale\\)\\>\\s-+10\\{0,2\\}\\s-*[munpf]?s\\s-*\\/\\s-*10\\{0,2\\}\\s-*[munpf]?s"
+
"\\<\\(`timescale\\)\\>\\s-+10\\{0,2\\}\\s-*[munpf]?s\\s-*/\\s-*10\\{0,2\\}\\s-*[munpf]?s"
"\\)\\|\\(?:"
- ;; `define and `if can span multiple lines if line ends in '\'. NOTE: `if
is not IEEE 1800-2012
+ ;; `define and `if can span multiple lines if line ends in '\'.
+ ;; NOTE: `if is not IEEE 1800-2012.
;; from http://www.emacswiki.org/emacs/MultilineRegexp
(concat "\\<\\(`define\\|`if\\)\\>" ; directive
"\\s-+" ; separator
@@ -10811,7 +10810,7 @@ Intended for internal use inside a
`verilog-save-font-no-change-functions' block
'verilog-delete-auto-star-all)
;; Remove template comments ... anywhere in case was pasted after AUTOINST
removed
(goto-char (point-min))
- (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)\\([
\tLT0-9]*\\| LHS: .*\\)?$" nil t)
+ (while (re-search-forward "\\s-*// \\(Templated\\|Implicit \\.\\*\\)\\([
\tLT0-9]*\\| LHS: .*\\)$" nil t)
(replace-match ""))
;; Final customize
@@ -11413,7 +11412,7 @@ If PAR-VALUES replace final strings with these
parameter values."
(when tpl-ass
;; Evaluate @"(lispcode)"
(when (string-match "@\".*[^\\]\"" tpl-net)
- (while (string-match "@\"\\(\\([^\\\"]*\\(\\\\.\\)*\\)*\\)\"" tpl-net)
+ (while (string-match "@\"\\(\\([^\\\"]\\|\\\\.\\)*\\)\"" tpl-net)
(setq tpl-net
(concat
(substring tpl-net 0 (match-beginning 0))
@@ -12080,15 +12079,18 @@ Typing \\[verilog-auto] will make this into:
(defun verilog-auto-reg-input ()
"Expand AUTOREGINPUT statements, as part of \\[verilog-auto].
-Make reg statements instantiation inputs that aren't already declared.
-This is useful for making a top level shell for testing the module that is
-to be instantiated.
+Make reg statements instantiation inputs that aren't already
+declared or assigned to. This is useful for making a top level
+shell for testing the module that is to be instantiated.
Limitations:
This ONLY detects inputs of AUTOINSTants (see `verilog-read-sub-decls').
This does NOT work on memories, declare those yourself.
+ Assignments cause the assigned-to variable not to be declared unless
+ the name matches `verilog-auto-reg-input-assigned-ignore-regexp'.
+
An example (see `verilog-auto-inst' for what else is going on here):
module ExampRegInput (o,i);
@@ -12126,7 +12128,9 @@ Typing \\[verilog-auto] will make this into:
(append (verilog-subdecls-get-inputs modsubdecls)
(verilog-subdecls-get-inouts modsubdecls))
(append (verilog-decls-get-signals moddecls)
- (verilog-decls-get-assigns moddecls))))))
+ (verilog-signals-not-matching-regexp
+ (verilog-decls-get-assigns moddecls)
+
verilog-auto-reg-input-assigned-ignore-regexp))))))
(when sig-list
(verilog-forward-or-insert-line)
(verilog-insert-indent "// Beginning of automatic reg inputs (for
undeclared instantiated-module inputs)\n")
@@ -14259,13 +14263,13 @@ and the case items."
(defun verilog-sk-define-signal ()
"Insert a definition of signal under point at top of module."
(interactive "*")
- (let* ((sig-re "[a-zA-Z0-9_]*")
+ (let* ((sig-chars "a-zA-Z0-9_")
(v1 (buffer-substring
(save-excursion
- (skip-chars-backward sig-re)
+ (skip-chars-backward sig-chars)
(point))
(save-excursion
- (skip-chars-forward sig-re)
+ (skip-chars-forward sig-chars)
(point)))))
(if (not (member v1 verilog-keywords))
(save-excursion
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 6974d00..e5e5972 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -448,6 +448,18 @@ If SELECT is non-nil, select the target window."
(defconst xref-buffer-name "*xref*"
"The name of the buffer to show xrefs.")
+(defface xref-file-header '((t :inherit compilation-info))
+ "Face used to highlight file header in the xref buffer."
+ :version "27.1")
+
+(defface xref-line-number '((t :inherit compilation-line-number))
+ "Face for displaying line numbers in the xref buffer."
+ :version "27.1")
+
+(defface xref-match '((t :inherit highlight))
+ "Face used to highlight matches in the xref buffer."
+ :version "27.1")
+
(defmacro xref--with-dedicated-window (&rest body)
`(let* ((xref-w (get-buffer-window xref-buffer-name))
(xref-w-dedicated (window-dedicated-p xref-w)))
@@ -737,18 +749,17 @@ GROUP is a string for decoration purposes and XREF is an
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
do
- (xref--insert-propertized '(face compilation-info) group "\n")
+ (xref--insert-propertized '(face xref-file-header) group "\n")
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
(prefix
(if line
(propertize (format line-format line)
- 'face 'compilation-line-number)
+ 'face 'xref-line-number)
" ")))
(xref--insert-propertized
(list 'xref-item xref
- ;; 'face 'font-lock-keyword-face
'mouse-face 'highlight
'keymap xref--button-map
'help-echo
@@ -797,6 +808,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(defvar xref--read-pattern-history nil)
(defun xref--show-xrefs (xrefs display-action &optional always-show-list)
+ (unless (region-active-p) (push-mark nil t))
(cond
((and (not (cdr xrefs)) (not always-show-list))
(xref-push-marker-stack)
@@ -1158,7 +1170,7 @@ Such as the current syntax table and the applied syntax
properties."
(end-column (- (match-end 0) line-beg))
(loc (xref-make-file-location file line beg-column))
(summary (buffer-substring line-beg line-end)))
- (add-face-text-property beg-column end-column 'highlight
+ (add-face-text-property beg-column end-column 'xref-match
t summary)
(push (xref-make-match summary loc (- end-column beg-column))
matches)))
diff --git a/lisp/replace.el b/lisp/replace.el
index 59ad1a3..9d1b7bf 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -983,7 +983,10 @@ also print the number."
(progn (forward-line 1) (point)))
(setq count (1+ count))))
(set-marker rend nil)
- (when interactive (message "Deleted %d matching lines" count))
+ (when interactive (message (ngettext "Deleted %d matching line"
+ "Deleted %d matching lines"
+ count)
+ count))
count))
(defun how-many (regexp &optional rstart rend interactive)
@@ -1032,9 +1035,10 @@ a previously found match."
(if (= opoint (point))
(forward-char 1)
(setq count (1+ count))))
- (when interactive (message "%d occurrence%s"
- count
- (if (= count 1) "" "s")))
+ (when interactive (message (ngettext "%d occurrence"
+ "%d occurrences"
+ count)
+ count))
count)))
@@ -1617,11 +1621,12 @@ See also `multi-occur'."
(not (eq occur-excluded-properties t))))))
(let* ((bufcount (length active-bufs))
(diff (- (length bufs) bufcount)))
- (message "Searched %d buffer%s%s; %s match%s%s"
- bufcount (if (= bufcount 1) "" "s")
+ (message "Searched %d %s%s; %s %s%s"
+ bufcount
+ (ngettext "buffer" "buffers" bufcount)
(if (zerop diff) "" (format " (%d killed)" diff))
(if (zerop count) "no" (format "%d" count))
- (if (= count 1) "" "es")
+ (ngettext "match" "matches" count)
;; Don't display regexp if with remaining text
;; it is longer than window-width.
(if (> (+ (length (or (get-text-property 0 'isearch-string
regexp)
@@ -1856,14 +1861,15 @@ See also `multi-occur'."
(let ((beg (point))
end)
(insert (propertize
- (format "%d match%s%s%s in buffer: %s%s\n"
- matches (if (= matches 1) "" "es")
+ (format "%d %s%s%s in buffer: %s%s\n"
+ matches
+ (ngettext "match" "matches" matches)
;; Don't display the same number of lines
;; and matches in case of 1 match per line.
(if (= lines matches)
- "" (format " in %d line%s"
+ "" (format " in %d %s"
lines
- (if (= lines 1) "" "s")))
+ (ngettext "line" "lines"
lines)))
;; Don't display regexp for multi-buffer.
(if (> (length buffers) 1)
"" (occur-regexp-descr regexp))
@@ -1889,13 +1895,15 @@ See also `multi-occur'."
(goto-char (point-min))
(let ((beg (point))
end)
- (insert (format "%d match%s%s total%s:\n"
- global-matches (if (= global-matches 1) "" "es")
+ (insert (format "%d %s%s total%s:\n"
+ global-matches
+ (ngettext "match" "matches" global-matches)
;; Don't display the same number of lines
;; and matches in case of 1 match per line.
(if (= global-lines global-matches)
- "" (format " in %d line%s"
- global-lines (if (= global-lines 1) ""
"s")))
+ "" (format " in %d %s"
+ global-lines
+ (ngettext "line" "lines"
global-lines)))
(occur-regexp-descr regexp)))
(setq end (point))
(when title-face
@@ -2635,22 +2643,24 @@ characters."
(setq def (lookup-key map key))
;; Restore the match data while we process the command.
(cond ((eq def 'help)
- (with-output-to-temp-buffer "*Help*"
- (princ
- (concat "Query replacing "
- (if backward "backward " "")
- (if delimited-flag
- (or (and (symbolp delimited-flag)
- (get delimited-flag
- 'isearch-message-prefix))
- "word ") "")
- (if regexp-flag "regexp " "")
- from-string " with "
- next-replacement ".\n\n"
- (substitute-command-keys
- query-replace-help)))
- (with-current-buffer standard-output
- (help-mode))))
+ (let ((display-buffer-overriding-action
+ '(nil (inhibit-same-window . t))))
+ (with-output-to-temp-buffer "*Help*"
+ (princ
+ (concat "Query replacing "
+ (if backward "backward " "")
+ (if delimited-flag
+ (or (and (symbolp delimited-flag)
+ (get delimited-flag
+
'isearch-message-prefix))
+ "word ") "")
+ (if regexp-flag "regexp " "")
+ from-string " with "
+ next-replacement ".\n\n"
+ (substitute-command-keys
+ query-replace-help)))
+ (with-current-buffer standard-output
+ (help-mode)))))
((eq def 'exit)
(setq keep-going nil)
(setq done t))
@@ -2730,10 +2740,10 @@ characters."
(1+ num-replacements))))))
(when (and (eq def 'undo-all)
(null (zerop num-replacements)))
- (message "Undid %d %s" num-replacements
- (if (= num-replacements 1)
- "replacement"
- "replacements"))
+ (message (ngettext "Undid %d replacement"
+ "Undid %d replacements"
+ num-replacements)
+ num-replacements)
(ding 'no-terminate)
(sit-for 1)))
(setq replaced nil last-was-undo t
last-was-act-and-show nil)))
@@ -2859,9 +2869,10 @@ characters."
last-was-act-and-show nil))))))
(replace-dehighlight))
(or unread-command-events
- (message "Replaced %d occurrence%s%s"
+ (message (ngettext "Replaced %d occurrence%s"
+ "Replaced %d occurrences%s"
+ replace-count)
replace-count
- (if (= replace-count 1) "" "s")
(if (> (+ skip-read-only-count
skip-filtered-count
skip-invisible-count)
diff --git a/lisp/shell.el b/lisp/shell.el
index 264981b..5357027 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -721,9 +721,9 @@ Otherwise, one argument `-i' is passed to the shell.
(current-buffer)))
(with-current-buffer buffer
- (when (file-remote-p default-directory)
- ;; On remote hosts, the local `shell-file-name' might be useless.
- (with-connection-local-variables
+ (with-connection-local-variables
+ ;; On remote hosts, the local `shell-file-name' might be useless.
+ (when (file-remote-p default-directory)
(if (and (called-interactively-p 'any)
(null explicit-shell-file-name)
(null (getenv "ESHELL")))
@@ -732,26 +732,26 @@ Otherwise, one argument `-i' is passed to the shell.
(expand-file-name
(read-file-name
"Remote shell path: " default-directory shell-file-name
- t shell-file-name))))))))
-
- ;; The buffer's window must be correctly set when we call comint
- ;; (so that comint sets the COLUMNS env var properly).
- (pop-to-buffer buffer)
- ;; Rain or shine, BUFFER must be current by now.
- (unless (comint-check-proc buffer)
- (let* ((prog (or explicit-shell-file-name
- (getenv "ESHELL") shell-file-name))
- (name (file-name-nondirectory prog))
- (startfile (concat "~/.emacs_" name))
- (xargs-name (intern-soft (concat "explicit-" name "-args"))))
- (unless (file-exists-p startfile)
- (setq startfile (concat user-emacs-directory "init_" name ".sh")))
- (apply #'make-comint-in-buffer "shell" buffer prog
- (if (file-exists-p startfile) startfile)
- (if (and xargs-name (boundp xargs-name))
- (symbol-value xargs-name)
- '("-i")))
- (shell-mode)))
+ t shell-file-name))))))
+
+ ;; The buffer's window must be correctly set when we call comint
+ ;; (so that comint sets the COLUMNS env var properly).
+ (pop-to-buffer buffer)
+ ;; Rain or shine, BUFFER must be current by now.
+ (unless (comint-check-proc buffer)
+ (let* ((prog (or explicit-shell-file-name
+ (getenv "ESHELL") shell-file-name))
+ (name (file-name-nondirectory prog))
+ (startfile (concat "~/.emacs_" name))
+ (xargs-name (intern-soft (concat "explicit-" name "-args"))))
+ (unless (file-exists-p startfile)
+ (setq startfile (concat user-emacs-directory "init_" name ".sh")))
+ (apply #'make-comint-in-buffer "shell" buffer prog
+ (if (file-exists-p startfile) startfile)
+ (if (and xargs-name (boundp xargs-name))
+ (symbol-value xargs-name)
+ '("-i")))
+ (shell-mode)))))
buffer)
;;; Directory tracking
diff --git a/lisp/simple.el b/lisp/simple.el
index f76f31a..160c433 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -110,6 +110,15 @@ If non-nil, the value is passed directly to `recenter'."
:type 'hook
:group 'next-error)
+(defcustom next-error-verbose t
+ "If non-nil, `next-error' always outputs the current error buffer.
+If nil, the message is output only when the error buffer
+changes."
+ :group 'next-error
+ :type 'boolean
+ :safe #'booleanp
+ :version "27.1")
+
(defvar next-error-highlight-timer nil)
(defvar next-error-overlay-arrow-position nil)
@@ -312,21 +321,27 @@ To control which errors are matched, customize the
variable
;; We know here that next-error-function is a valid symbol we can funcall
(with-current-buffer buffer
(funcall next-error-function (prefix-numeric-value arg) reset)
- (next-error-found buffer (current-buffer))
- (message "%s locus from %s"
- (cond (reset "First")
- ((eq (prefix-numeric-value arg) 0) "Current")
- ((< (prefix-numeric-value arg) 0) "Previous")
- (t "Next"))
- next-error-last-buffer)))))
+ (let ((prev next-error-last-buffer))
+ (next-error-found buffer (current-buffer))
+ (when (or next-error-verbose
+ (not (eq prev next-error-last-buffer)))
+ (message "%s locus from %s"
+ (cond (reset "First")
+ ((eq (prefix-numeric-value arg) 0) "Current")
+ ((< (prefix-numeric-value arg) 0) "Previous")
+ (t "Next"))
+ next-error-last-buffer)))))))
(defun next-error-internal ()
"Visit the source code corresponding to the `next-error' message at point."
(let ((buffer (current-buffer)))
;; We know here that next-error-function is a valid symbol we can funcall
(funcall next-error-function 0 nil)
- (next-error-found buffer (current-buffer))
- (message "Current locus from %s" next-error-last-buffer)))
+ (let ((prev next-error-last-buffer))
+ (next-error-found buffer (current-buffer))
+ (when (or next-error-verbose
+ (not (eq prev next-error-last-buffer)))
+ (message "Current locus from %s" next-error-last-buffer)))))
(defun next-error-found (&optional from-buffer to-buffer)
"Function to call when the next locus is found and displayed.
@@ -598,30 +613,38 @@ When called from Lisp code, ARG may be a prefix string to
copy."
If there is a fill prefix, delete it from the beginning of this
line.
With prefix ARG, join the current line to the following line.
-If the region is active, join all the lines in the region. (The
-region is ignored if prefix argument is given.)"
- (interactive "*P\nr")
- (if arg (forward-line 1)
- (if (use-region-p)
- (goto-char end)))
- (beginning-of-line)
- (while (eq (preceding-char) ?\n)
- (progn
- (delete-region (point) (1- (point)))
- ;; If the second line started with the fill prefix,
+When BEG and END are non-nil, join all lines in the region they
+define. Interactively, BEG and END are, respectively, the start
+and end of the region if it is active, else nil. (The region is
+ignored if prefix ARG is given.)"
+ (interactive
+ (progn (barf-if-buffer-read-only)
+ (cons current-prefix-arg
+ (and (use-region-p)
+ (list (region-beginning) (region-end))))))
+ ;; Consistently deactivate mark even when no text is changed.
+ (setq deactivate-mark t)
+ (if (and beg (not arg))
+ ;; Region is active. Go to END, but only if region spans
+ ;; multiple lines.
+ (and (goto-char beg)
+ (> end (line-end-position))
+ (goto-char end))
+ ;; Region is inactive. Set a loop sentinel
+ ;; (subtracting 1 in order to compare less than BOB).
+ (setq beg (1- (line-beginning-position (and arg 2))))
+ (when arg (forward-line)))
+ (let ((prefix (and (> (length fill-prefix) 0)
+ (regexp-quote fill-prefix))))
+ (while (and (> (line-beginning-position) beg)
+ (forward-line 0)
+ (= (preceding-char) ?\n))
+ (delete-char -1)
+ ;; If the appended line started with the fill prefix,
;; delete the prefix.
- (if (and fill-prefix
- (<= (+ (point) (length fill-prefix)) (point-max))
- (string= fill-prefix
- (buffer-substring (point)
- (+ (point) (length fill-prefix)))))
- (delete-region (point) (+ (point) (length fill-prefix))))
- (fixup-whitespace)
- (if (and (use-region-p)
- beg
- (not arg)
- (< beg (point-at-bol)))
- (beginning-of-line)))))
+ (if (and prefix (looking-at prefix))
+ (replace-match "" t t))
+ (fixup-whitespace))))
(defalias 'join-line #'delete-indentation) ; easier to find
@@ -3328,6 +3351,16 @@ is output."
:group 'shell
:version "26.1")
+(defcustom shell-command-width nil
+ "Number of display columns available for asynchronous shell command output.
+If nil, use the shell default number (usually 80 columns).
+If a positive integer, tell the shell to use that number of columns for
+command output."
+ :type '(choice (const :tag "Use system limit" nil)
+ (integer :tag "Fixed width" :value 80))
+ :group 'shell
+ :version "27.1")
+
(defcustom shell-command-dont-erase-buffer nil
"If non-nil, output buffer is not erased between shell commands.
Also, a non-nil value sets the point in the output buffer
@@ -3591,8 +3624,13 @@ impose the use of a shell (with its need to quote
arguments)."
(with-current-buffer buffer
(shell-command--save-pos-or-erase)
(setq default-directory directory)
- (setq proc
- (start-process-shell-command "Shell" buffer command))
+ (let ((process-environment
+ (if (natnump shell-command-width)
+ (cons (format "COLUMNS=%d" shell-command-width)
+ process-environment)
+ process-environment)))
+ (setq proc
+ (start-process-shell-command "Shell" buffer command)))
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc #'shell-command-sentinel)
@@ -8198,6 +8236,9 @@ CHOICE - the string to insert in the buffer,
BUFFER - the buffer in which the choice should be inserted,
BASE-POSITION - where to insert the completion.
+Functions should also accept and ignore a potential fourth
+argument, passed for backwards compatibility.
+
If a function in the list returns non-nil, that function is supposed
to have inserted the CHOICE in the BUFFER, and possibly exited
the minibuffer; no further functions will be called.
@@ -8682,7 +8723,7 @@ call `normal-erase-is-backspace-mode' (which see)
instead."
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
(memq window-system '(w32 ns))
- (and (memq window-system '(x))
+ (and (eq window-system 'x)
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
;; If the terminal Emacs is running on has erase char
@@ -8693,6 +8734,8 @@ call `normal-erase-is-backspace-mode' (which see)
instead."
normal-erase-is-backspace)
1 0)))))
+(declare-function display-symbol-keys-p "frame" (&optional display))
+
(define-minor-mode normal-erase-is-backspace-mode
"Toggle the Erase and Delete mode of the Backspace and Delete keys.
@@ -8728,8 +8771,7 @@ See also `normal-erase-is-backspace'."
(let ((enabled (eq 1 (terminal-parameter
nil 'normal-erase-is-backspace))))
- (cond ((or (memq window-system '(x w32 ns pc))
- (memq system-type '(ms-dos windows-nt)))
+ (cond ((display-symbol-keys-p)
(let ((bindings
'(([M-delete] [M-backspace])
([C-M-delete] [C-M-backspace])
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 399ef45..4823e4b 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -2849,7 +2849,7 @@ indicator, then do not add a space."
(progn
(goto-char speedbar-ro-to-do-point)
(while (and (not (input-pending-p))
- (re-search-forward "^\\([0-9]+\\):\\s-*[[<][+-?][]>] "
+ (re-search-forward "^\\([0-9]+\\):\\s-*[[<][+?-][]>] "
nil t))
(setq speedbar-ro-to-do-point (point))
(let ((f (speedbar-line-file)))
@@ -2900,7 +2900,7 @@ to add more types of version control systems."
(progn
(goto-char speedbar-vc-to-do-point)
(while (and (not (input-pending-p))
- (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-?]\\] "
+ (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+?-]\\] "
nil t))
(setq speedbar-vc-to-do-point (point))
(if (speedbar-check-vc-this-line (match-string 1))
diff --git a/lisp/subr.el b/lisp/subr.el
index 6dc53cd..bf3716b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -118,6 +118,33 @@ BODY should be a list of Lisp expressions.
;; depend on backquote.el.
(list 'function (cons 'lambda cdr)))
+(defmacro prog2 (form1 form2 &rest body)
+ "Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
+The value of FORM2 is saved during the evaluation of the
+remaining args, whose values are discarded."
+ (declare (indent 2) (debug t))
+ `(progn ,form1 (prog1 ,form2 ,@body)))
+
+(defmacro setq-default (&rest args)
+ "Set the default value of variable VAR to VALUE.
+VAR, the variable name, is literal (not evaluated);
+VALUE is an expression: it is evaluated and its value returned.
+The default value of a variable is seen in buffers
+that do not have their own values for the variable.
+
+More generally, you can use multiple variables and values, as in
+ (setq-default VAR VALUE VAR VALUE...)
+This sets each VAR's default value to the corresponding VALUE.
+The VALUE for the Nth VAR can refer to the new default values
+of previous VARs.
+
+\(fn [VAR VALUE]...)"
+ (declare (debug setq))
+ (let ((exps nil))
+ (while args
+ (push `(set-default ',(pop args) ,(pop args)) exps))
+ `(progn . ,(nreverse exps))))
+
(defmacro setq-local (var val)
"Set variable VAR to value VAL in current buffer."
;; Can't use backquote here, it's too early in the bootstrap.
@@ -577,6 +604,11 @@ If N is omitted or nil, remove the last element."
(if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
list))))
+;; The function's definition was moved to fns.c,
+;; but it's easier to set properties here.
+(put 'proper-list-p 'pure t)
+(put 'proper-list-p 'side-effect-free 'error-free)
+
(defun delete-dups (list)
"Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it. LIST must be a proper list.
@@ -752,13 +784,35 @@ Elements of ALIST that are not conses are ignored."
alist)
(defun alist-get (key alist &optional default remove testfn)
- "Return the value associated with KEY in ALIST.
+ "Find the first element of ALIST whose `car' equals KEY and return its `cdr'.
If KEY is not found in ALIST, return DEFAULT.
-Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'.
+Equality with KEY is tested by TESTFN, defaulting to `eq'.
+
+You can use `alist-get' in PLACE expressions. This will modify
+an existing association (more precisely, the first one if
+multiple exist), or add a new element to the beginning of ALIST,
+destructively modifying the list stored in ALIST.
+
+Example:
+
+ (setq foo '((a . 0)))
+ (setf (alist-get 'a foo) 1
+ (alist-get 'b foo) 2)
+
+ foo => ((b . 2) (a . 1))
+
-This is a generalized variable suitable for use with `setf'.
When using it to set a value, optional argument REMOVE non-nil
-means to remove KEY from ALIST if the new value is `eql' to DEFAULT."
+means to remove KEY from ALIST if the new value is `eql' to
+DEFAULT (more precisely the first found association will be
+deleted from the alist).
+
+Example:
+
+ (setq foo '((a . 1) (b . 2)))
+ (setf (alist-get 'b foo nil 'remove) nil)
+
+ foo => ((a . 1))"
(ignore remove) ;;Silence byte-compiler.
(let ((x (if (not testfn)
(assq key alist)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index cddcdc0..11a77b5 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -892,7 +892,7 @@ cannot be completed sensibly: `custom-ident',
(,(concat "@" css-ident-re) (0 font-lock-builtin-face))
;; Selectors.
;; Allow plain ":root" as a selector.
- ("^[ \t]*\\(:root\\)\\(?:[\n \t]*\\)*{" (1 'css-selector keep))
+ ("^[ \t]*\\(:root\\)[\n \t]*{" (1 'css-selector keep))
;; FIXME: attribute selectors don't work well because they may contain
;; strings which have already been highlighted as f-l-string-face and
;; thus prevent this highlighting from being applied (actually now that
@@ -915,7 +915,7 @@ cannot be completed sensibly: `custom-ident',
"\\(?:\\(:" (regexp-opt (append css-pseudo-class-ids
css-pseudo-element-ids)
t)
- "\\|\\::" (regexp-opt css-pseudo-element-ids t) "\\)"
+ "\\|::" (regexp-opt css-pseudo-element-ids t) "\\)"
"\\(?:([^)]+)\\)?"
(if (not sassy)
"[^:{}()\n]*"
@@ -1557,7 +1557,7 @@ rgb()/rgba()."
(prev nil))
(dolist (sel selectors)
(cond
- ((seq-contains sel ?&)
+ ((seq-contains-p sel ?&)
(setq sel (replace-regexp-in-string "&" prev sel))
(pop processed))
;; Unless this is the first selector, separate this one and the
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index b303e19..1dbc7bd 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -292,9 +292,9 @@ Examples:
(skip-syntax-backward " ")
(skip-syntax-backward "w_.")
(re-search-forward "\\([[:xdigit:]:]+\\)\\(/-?[0-9]\\{2,3\\}\\)?")
- (kill-new (match-string 0))
(let ((address (match-string 1))
(prefix-length (match-string 2)))
+ (kill-new (match-string 0))
(when prefix-length
(setq prefix-length (string-to-number (substring prefix-length 1)))
(if negate-prefix
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index b4c7f28..4077789 100644
--- a/lisp/textmodes/less-css-mode.el
+++ b/lisp/textmodes/less-css-mode.el
@@ -194,10 +194,10 @@ directory by default."
;; - custom faces.
(defconst less-css-font-lock-keywords
'(;; Variables
- ("@[a-z_-][a-z-_0-9]*" . font-lock-variable-name-face)
+ ("@[a-z_-][a-z_0-9-]*" . font-lock-variable-name-face)
("&" . font-lock-preprocessor-face)
;; Mixins
- ("\\(?:[ \t{;]\\|^\\)\\(\\.[a-z_-][a-z-_0-9]*\\)[ \t]*;" .
+ ("\\(?:[ \t{;]\\|^\\)\\(\\.[a-z_-][a-z_0-9-]*\\)[ \t]*;" .
(1 font-lock-keyword-face))))
(defvar less-css-mode-syntax-table
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index f0e3013..b520849 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -387,7 +387,8 @@ Interactively, ARG is the numeric argument, and defaults to
1."
\\[picture-set-tab-stops] and \\[picture-tab-search].
The syntax for this variable is like the syntax used inside of `[...]'
in a regular expression--but without the `[' and the `]'.
-It is NOT a regular expression, any regexp special characters will be quoted.
+It is NOT a regular expression, and should follow the usual
+rules for the contents of a character alternative.
It defines a set of \"interesting characters\" to look for when setting
\(or searching for) tab stops, initially \"!-~\" (all printing characters).
For example, suppose that you are editing a table which is formatted thus:
@@ -425,7 +426,7 @@ stops computed are displayed in the minibuffer with `:' at
each stop."
(if arg
(setq tabs (or (default-value 'tab-stop-list)
(indent-accumulate-tab-stops (window-width))))
- (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")))
+ (let ((regexp (concat "[ \t]+[" picture-tab-chars "]")))
(beginning-of-line)
(let ((bol (point)))
(end-of-line)
@@ -433,8 +434,8 @@ stops computed are displayed in the minibuffer with `:' at
each stop."
(skip-chars-forward " \t")
(setq tabs (cons (current-column) tabs)))
(if (null tabs)
- (error "No characters in set %s on this line"
- (regexp-quote picture-tab-chars))))))
+ (error "No characters in set [%s] on this line"
+ picture-tab-chars)))))
(setq tab-stop-list tabs)
(let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ )))
(while tabs
@@ -455,12 +456,13 @@ If no such character is found, move to beginning of line."
(progn
(beginning-of-line)
(skip-chars-backward
- (concat "^" (regexp-quote picture-tab-chars))
+ (concat "^" (replace-regexp-in-string
+ "\\\\" "\\\\" picture-tab-chars nil t))
(point-min))
(not (bobp))))
(move-to-column target))
(if (re-search-forward
- (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")
+ (concat "[ \t]+[" picture-tab-chars "]")
(line-end-position)
'move)
(setq target (1- (current-column)))
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 931faad..e676a5d 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -1,4 +1,4 @@
-;;; text-mode.el --- text mode, and its idiosyncratic commands
+;;; text-mode.el --- text mode, and its idiosyncratic commands -*-
lexical-binding: t -*-
;; Copyright (C) 1985, 1992, 1994, 2001-2019 Free Software Foundation,
;; Inc.
@@ -38,8 +38,8 @@
:group 'text)
(defvar text-mode-variant nil
- "Non-nil if this buffer's major mode is a variant of Text mode.
-Use (derived-mode-p \\='text-mode) instead.")
+ "Non-nil if this buffer's major mode is a variant of Text mode.")
+(make-obsolete-variable 'text-mode-variant 'derived-mode-p "27.1")
(defvar text-mode-syntax-table
(let ((st (make-syntax-table)))
@@ -104,10 +104,8 @@ You can thus get the full benefit of adaptive filling
(see the variable `adaptive-fill-mode').
\\{text-mode-map}
Turning on Text mode runs the normal hook `text-mode-hook'."
- (set (make-local-variable 'text-mode-variant) t)
- (set (make-local-variable 'require-final-newline)
- mode-require-final-newline)
- (set (make-local-variable 'indent-line-function) 'indent-relative))
+ (setq-local text-mode-variant t)
+ (setq-local require-final-newline mode-require-final-newline))
(define-derived-mode paragraph-indent-text-mode text-mode "Parindent"
"Major mode for editing text, with leading spaces starting a paragraph.
@@ -131,14 +129,12 @@ Turning on Paragraph-Indent minor mode runs the normal
hook
:initial-value nil
;; Change the definition of a paragraph start.
(let ((ps-re "[ \t\n\f]\\|"))
- (if (eq t (compare-strings ps-re nil nil
- paragraph-start nil (length ps-re)))
+ (if (string-prefix-p ps-re paragraph-start)
(if (not paragraph-indent-minor-mode)
- (set (make-local-variable 'paragraph-start)
- (substring paragraph-start (length ps-re))))
+ (setq-local paragraph-start
+ (substring paragraph-start (length ps-re))))
(if paragraph-indent-minor-mode
- (set (make-local-variable 'paragraph-start)
- (concat ps-re paragraph-start)))))
+ (setq-local paragraph-start (concat ps-re paragraph-start)))))
;; Change the indentation function.
(if paragraph-indent-minor-mode
(add-function :override (local 'indent-line-function)
@@ -154,7 +150,7 @@ Turning on Paragraph-Indent minor mode runs the normal hook
(defun text-mode-hook-identify ()
"Mark that this mode has run `text-mode-hook'.
This is how `toggle-text-mode-auto-fill' knows which buffers to operate on."
- (set (make-local-variable 'text-mode-variant) t))
+ (setq-local text-mode-variant t))
(defun toggle-text-mode-auto-fill ()
"Toggle whether to use Auto Fill in Text mode and related modes.
@@ -163,8 +159,8 @@ both existing buffers and buffers that you subsequently
create."
(interactive)
(let ((enable-mode (not (memq 'turn-on-auto-fill text-mode-hook))))
(if enable-mode
- (add-hook 'text-mode-hook 'turn-on-auto-fill)
- (remove-hook 'text-mode-hook 'turn-on-auto-fill))
+ (add-hook 'text-mode-hook #'turn-on-auto-fill)
+ (remove-hook 'text-mode-hook #'turn-on-auto-fill))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(if (or (derived-mode-p 'text-mode) text-mode-variant)
@@ -214,15 +210,14 @@ The argument NLINES says how many lines to center."
(while (not (eq nlines 0))
(save-excursion
(let ((lm (current-left-margin))
- line-length)
+ space)
(beginning-of-line)
(delete-horizontal-space)
(end-of-line)
(delete-horizontal-space)
- (setq line-length (current-column))
- (if (> (- fill-column lm line-length) 0)
- (indent-line-to
- (+ lm (/ (- fill-column lm line-length) 2))))))
+ (setq space (- fill-column lm (current-column)))
+ (if (> space 0)
+ (indent-line-to (+ lm (/ space 2))))))
(cond ((null nlines)
(setq nlines 0))
((> nlines 0)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 1fbc087..662b666 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -150,15 +150,6 @@ request.")
;; These routines will allow us to implement persistent HTTP
;; connections.
(defsubst url-http-debug (&rest args)
- (if (eq quit-flag t)
- (let ((proc (get-buffer-process (current-buffer))))
- ;; The user hit C-g, honor it! Some things can get in an
- ;; incredibly tight loop (chunked encoding)
- (if proc
- (progn
- (set-process-sentinel proc nil)
- (set-process-filter proc nil)))
- (error "Transfer interrupted!")))
(apply 'url-debug 'http args))
(defun url-http-mark-connection-as-busy (host port proc)
@@ -939,7 +930,8 @@ should be shown to the user."
(goto-char (point-min))
success))
-(declare-function zlib-decompress-region "decompress.c" (start end))
+(declare-function zlib-decompress-region "decompress.c"
+ (start end &optional allow-partial))
(defun url-handle-content-transfer-encoding ()
(let ((encoding (mail-fetch-field "content-encoding")))
@@ -951,7 +943,7 @@ should be shown to the user."
(widen)
(goto-char (point-min))
(when (search-forward "\n\n")
- (zlib-decompress-region (point) (point-max)))))))
+ (zlib-decompress-region (point) (point-max) t))))))
;; Miscellaneous
(defun url-http-activate-callback ()
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index 4969cba..aa44ea7 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -88,7 +88,7 @@
(encoding "8bit")
(data nil))
(save-excursion
- (if (not (string-match "\\([^,]*\\)?," desc))
+ (if (not (string-match "\\([^,]*\\)," desc))
(error "Malformed data URL: %s" desc)
(setq mediatype (match-string 1 desc)
data (url-unhex-string (substring desc (match-end 0))))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 72ff4f1..5b83506 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -61,8 +61,6 @@ If a list, it is a list of the types of messages to be
logged."
;;;###autoload
(defun url-debug (tag &rest args)
- (if (eq quit-flag t)
- (error "Interrupted!"))
(if (or (eq url-debug t)
(numberp url-debug)
(and (listp url-debug) (memq tag url-debug)))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 4020440..1d5a2cf 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -116,7 +116,7 @@ You can always manually refine a hunk with
`diff-refine-hunk'."
"If non-nil, diff hunk font-lock includes source language syntax
highlighting.
This highlighting is the same as added by `font-lock-mode'
when corresponding source files are visited normally.
-Syntax highlighting is added over diff own highlighted changes.
+Syntax highlighting is added over diff-mode's own highlighted changes.
If t, the default, highlight syntax only in Diff buffers created by Diff
commands that compare files or by VC commands that compare revisions.
@@ -126,17 +126,17 @@ For diffs against the working-tree version of a file, the
highlighting is
based on the current file contents. File-based fontification tries to
infer fontification from the compared files.
-If revision-based or file-based method fails, use hunk-based method to get
-fontification from hunk alone if the value is `hunk-also'.
-
-If `hunk-only', fontification is based on hunk alone, without full source.
+If `hunk-only' fontification is based on hunk alone, without full source.
It tries to highlight hunks without enough context that sometimes might result
-in wrong fontification. This is the fastest option, but less reliable."
+in wrong fontification. This is the fastest option, but less reliable.
+
+If `hunk-also', use reliable file-based syntax highlighting when available
+and hunk-based syntax highlighting otherwise as a fallback."
:version "27.1"
:type '(choice (const :tag "Don't highlight syntax" nil)
- (const :tag "Hunk-based also" hunk-also)
(const :tag "Hunk-based only" hunk-only)
- (const :tag "Highlight syntax" t)))
+ (const :tag "Highlight syntax" t)
+ (const :tag "Allow hunk-based fallback" hunk-also)))
(defvar diff-vc-backend nil
"The VC backend that created the current Diff buffer, if any.")
@@ -144,9 +144,8 @@ in wrong fontification. This is the fastest option, but
less reliable."
(defvar diff-vc-revisions nil
"The VC revisions compared in the current Diff buffer, if any.")
-(defvar diff-default-directory nil
+(defvar-local diff-default-directory nil
"The default directory where the current Diff buffer was created.")
-(make-variable-buffer-local 'diff-default-directory)
(defvar diff-outline-regexp
"\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
@@ -533,7 +532,8 @@ See
https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html";)
"^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
;; A `unified' header is ambiguous.
diff-file-header-re))
- ('context "^[^-+#! \\]")
+ ('context (if diff-valid-unified-empty-line
+ "^[^-+#! \n\\]" "^[^-+#! \\]"))
('normal "^[^<>#\\]")
(_ "^[^-+#!<> \\]"))
nil t)
@@ -2116,7 +2116,7 @@ Return new point, if it was moved."
(smerge-refine-regions beg-del beg-add beg-add end-add
nil #'diff-refine-preproc props-r
props-a)))))
('context
- (let* ((middle (save-excursion (re-search-forward "^---")))
+ (let* ((middle (save-excursion (re-search-forward "^---" end)))
(other middle))
(while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
(smerge-refine-regions (match-beginning 0) (match-end 0)
@@ -2212,7 +2212,7 @@ I.e. like `add-change-log-entry-other-window' but applied
to all hunks."
;; `add-change-log-entry-other-window' works better in
;; that case.
(re-search-forward
- (concat "\n[!+-<>]"
+ (concat "\n[!+<>-]"
;; If the hunk is a context hunk with an empty first
;; half, recognize the "--- NNN,MMM ----" line
"\\(-- [0-9]+\\(,[0-9]+\\)? ----\n"
@@ -2411,10 +2411,11 @@ and the position in MAX."
(diff-syntax-fontify-hunk beg end t)
(diff-syntax-fontify-hunk beg end nil)))
-(defvar diff-syntax-fontify-revisions (make-hash-table :test 'equal))
-
(eval-when-compile (require 'subr-x)) ; for string-trim-right
+(defvar-local diff--syntax-file-attributes nil)
+(put 'diff--syntax-file-attributes 'permanent-local t)
+
(defun diff-syntax-fontify-hunk (beg end old)
"Highlight source language syntax in diff hunk between BEG and END.
When OLD is non-nil, highlight the hunk from the old source."
@@ -2422,7 +2423,9 @@ When OLD is non-nil, highlight the hunk from the old
source."
(let* ((hunk (buffer-substring-no-properties beg end))
;; Trim a trailing newline to find hunk in diff-syntax-fontify-props
;; in diffs that have no newline at end of diff file.
- (text (string-trim-right (or (with-demoted-errors (diff-hunk-text
hunk (not old) nil)) "")))
+ (text (string-trim-right
+ (or (with-demoted-errors (diff-hunk-text hunk (not old) nil))
+ "")))
(line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)address@hidden
]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?")
(if old (match-string 1)
(if (match-end 3) (match-string 3) (match-string 1)))))
@@ -2431,83 +2434,111 @@ When OLD is non-nil, highlight the hunk from the old
source."
(list (string-to-number (match-string 1 line))
(string-to-number (match-string 2 line)))
(list (string-to-number line) 1)))) ; One-line diffs
- props)
- (cond
- ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only)))
- (let* ((file (diff-find-file-name old t))
- (revision (and file (if (not old) (nth 1 diff-vc-revisions)
- (or (nth 0 diff-vc-revisions)
- (vc-working-revision file))))))
- (if file
- (if (not revision)
- ;; Get properties from the current working revision
- (when (and (not old) (file-exists-p file) (file-regular-p
file))
- ;; Try to reuse an existing buffer
- (if (get-file-buffer (expand-file-name file))
- (with-current-buffer (get-file-buffer (expand-file-name
file))
- (setq props (diff-syntax-fontify-props nil text
line-nb)))
- ;; Get properties from the file
- (with-temp-buffer
- (insert-file-contents file)
- (setq props (diff-syntax-fontify-props file text
line-nb)))))
- ;; Get properties from a cached revision
- (let* ((buffer-name (format " *diff-syntax:%s.~%s~*"
- (expand-file-name file) revision))
- (buffer (gethash buffer-name
diff-syntax-fontify-revisions)))
- (unless (and buffer (buffer-live-p buffer))
- (let* ((vc-buffer (ignore-errors
+ (props
+ (or
+ (when (and diff-vc-backend
+ (not (eq diff-font-lock-syntax 'hunk-only)))
+ (let* ((file (diff-find-file-name old t))
+ (revision (and file (if (not old) (nth 1 diff-vc-revisions)
+ (or (nth 0 diff-vc-revisions)
+ (vc-working-revision file))))))
+ (when file
+ (if (not revision)
+ ;; Get properties from the current working revision
+ (when (and (not old) (file-readable-p file)
+ (file-regular-p file))
+ (let ((buf (get-file-buffer (expand-file-name file))))
+ ;; Try to reuse an existing buffer
+ (if buf
+ (with-current-buffer buf
+ (diff-syntax-fontify-props nil text line-nb))
+ ;; Get properties from the file.
+ (with-current-buffer (get-buffer-create
+ " *diff-syntax-file*")
+ (let ((attrs (file-attributes file)))
+ (if (equal diff--syntax-file-attributes attrs)
+ ;; Same file as last-time, unmodified.
+ ;; Reuse buffer as-is.
+ (setq file nil)
+ (insert-file-contents file)
+ (setq diff--syntax-file-attributes attrs)))
+ (diff-syntax-fontify-props file text line-nb)))))
+ ;; Get properties from a cached revision
+ (let* ((buffer-name (format " *diff-syntax:%s.~%s~*"
+ (expand-file-name file)
+ revision))
+ (buffer (get-buffer buffer-name)))
+ (if buffer
+ ;; Don't re-initialize the buffer (which would throw
+ ;; away the previous fontification work).
+ (setq file nil)
+ (setq buffer (ignore-errors
(vc-find-revision-no-save
(expand-file-name file) revision
diff-vc-backend
(get-buffer-create buffer-name)))))
- (when vc-buffer
- (setq buffer vc-buffer)
- (puthash buffer-name buffer
diff-syntax-fontify-revisions))))
- (when buffer
- (with-current-buffer buffer
- (setq props (diff-syntax-fontify-props file text
line-nb))))))
- ;; If file is unavailable, get properties from the hunk alone
- (setq file (car (diff-hunk-file-names old)))
- (with-temp-buffer
- (insert text)
- (setq props (diff-syntax-fontify-props file text line-nb t))))))
- ((and diff-default-directory (not (eq diff-font-lock-syntax 'hunk-only)))
- (let ((file (car (diff-hunk-file-names old))))
- (if (and file (file-exists-p file) (file-regular-p file))
- ;; Try to get full text from the file
- (with-temp-buffer
- (insert-file-contents file)
- (setq props (diff-syntax-fontify-props file text line-nb)))
- ;; Otherwise, get properties from the hunk alone
- (with-temp-buffer
- (insert text)
- (setq props (diff-syntax-fontify-props file text line-nb t))))))
- ((memq diff-font-lock-syntax '(hunk-also hunk-only))
- (let ((file (car (diff-hunk-file-names old))))
- (with-temp-buffer
- (insert text)
- (setq props (diff-syntax-fontify-props file text line-nb t))))))
+ (when buffer
+ (with-current-buffer buffer
+ (diff-syntax-fontify-props file text line-nb))))))))
+ (let ((file (car (diff-hunk-file-names old))))
+ (cond
+ ((and file diff-default-directory
+ (not (eq diff-font-lock-syntax 'hunk-only))
+ (not diff-vc-backend)
+ (file-readable-p file) (file-regular-p file))
+ ;; Try to get full text from the file.
+ (with-temp-buffer
+ (insert-file-contents file)
+ (diff-syntax-fontify-props file text line-nb)))
+ ;; Otherwise, get properties from the hunk alone
+ ((memq diff-font-lock-syntax '(hunk-also hunk-only))
+ (with-temp-buffer
+ (insert text)
+ (diff-syntax-fontify-props file text line-nb t))))))))
;; Put properties over the hunk text
(goto-char beg)
(when (and props (eq (diff-hunk-style) 'unified))
(while (< (progn (forward-line 1) (point)) end)
- (when (or (and (not old) (not (looking-at-p "[-<]")))
- (and old (not (looking-at-p "[+>]"))))
- (unless (looking-at-p "\\\\") ; skip "\ No newline at end of file"
- (if (and old (not (looking-at-p "[-<]")))
- ;; Fontify context lines only from new source,
- ;; don't refontify context lines from old source.
- (pop props)
- (let ((line-props (pop props))
- (bol (1+ (point))))
- (dolist (prop line-props)
- (let ((ol (make-overlay (+ bol (nth 0 prop))
- (+ bol (nth 1 prop))
- nil 'front-advance nil)))
- (overlay-put ol 'diff-mode 'syntax)
- (overlay-put ol 'evaporate t)
- (overlay-put ol 'face (nth 2 prop))))))))))))
+ ;; Skip the "\ No newline at end of file" lines as well as the lines
+ ;; corresponding to the "other" version.
+ (unless (looking-at-p (if old "[+>\\]" "[-<\\]"))
+ (if (and old (not (looking-at-p "[-<]")))
+ ;; Fontify context lines only from new source,
+ ;; don't refontify context lines from old source.
+ (pop props)
+ (let ((line-props (pop props))
+ (bol (1+ (point))))
+ (dolist (prop line-props)
+ ;; Ideally, we'd want to use text-properties as in:
+ ;;
+ ;; (add-face-text-property
+ ;; (+ bol (nth 0 prop)) (+ bol (nth 1 prop))
+ ;; (nth 2 prop) 'append)
+ ;;
+ ;; rather than overlays here, but they'd get removed by later
+ ;; font-locking.
+ ;; This is because we also apply faces outside of the
+ ;; beg...end chunk currently font-locked and when font-lock
+ ;; later comes to handle the rest of the hunk that we already
+ ;; handled we don't (want to) redo it (we work at
+ ;; hunk-granularity rather than font-lock's own chunk
+ ;; granularity).
+ ;; I see two ways to fix this:
+ ;; - don't immediately apply the props that fall outside of
+ ;; font-lock's chunk but stash them somewhere (e.g. in
another
+ ;; text property) and only later when font-lock comes back
+ ;; move them to `face'.
+ ;; - change the code so work at font-lock's chunk granularity
+ ;; (this seems doable without too much extra overhead,
+ ;; contrary to the refine highlighting, which inherently
+ ;; works at a different granularity).
+ (let ((ol (make-overlay (+ bol (nth 0 prop))
+ (+ bol (nth 1 prop))
+ nil 'front-advance nil)))
+ (overlay-put ol 'diff-mode 'syntax)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'face (nth 2 prop)))))))))))
(defun diff-syntax-fontify-props (file text line-nb &optional hunk-only)
"Get font-lock properties from the source code.
@@ -2515,21 +2546,23 @@ FILE is the name of the source file. If non-nil, it
requests initialization
of the mode according to FILE.
TEXT is the literal source text from hunk.
LINE-NB is a pair of numbers: start line number and the number of
-lines in the hunk. NO-INIT means no initialization is needed to set major
-mode. When HUNK-ONLY is non-nil, then don't verify the existence of the
+lines in the hunk.
+When HUNK-ONLY is non-nil, then don't verify the existence of the
hunk text in the source file. Otherwise, don't highlight the hunk if the
hunk text is not found in the source file."
(when file
;; When initialization is requested, we should be in a brand new
;; temp buffer.
- (cl-assert (eq t buffer-undo-list))
- (cl-assert (not font-lock-mode))
(cl-assert (null buffer-file-name))
(let ((enable-local-variables :safe) ;; to find `mode:'
(buffer-file-name file))
(set-auto-mode)
- (when (and (memq 'generic-mode-find-file-hook find-file-hook)
- (fboundp 'generic-mode-find-file-hook))
+ ;; FIXME: Is this really worth the trouble?
+ (when (and (fboundp 'generic-mode-find-file-hook)
+ (memq #'generic-mode-find-file-hook
+ ;; There's no point checking the buffer-local value,
+ ;; we're in a fresh new buffer.
+ (default-value 'find-file-hook)))
(generic-mode-find-file-hook))))
(let ((font-lock-defaults (or font-lock-defaults '(nil t)))
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 8bd1bbd..ba5a1a3 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -350,7 +350,7 @@ The first subexpression is the actual text of the field.")
(defun log-edit-goto-eoh () ;FIXME: Almost rfc822-goto-eoh!
(goto-char (point-min))
(when (re-search-forward
- "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-:]\\)" nil 'move)
+ "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-]\\)" nil 'move)
(goto-char (match-beginning 0))))
(defun log-edit--match-first-line (limit)
@@ -754,7 +754,9 @@ regardless of user name or time."
(log-edit-insert-changelog-entries (log-edit-files)))))
(log-edit-set-common-indentation)
;; Add an Author: field if appropriate.
- (when author (log-edit-add-field "Author" (car author)))
+ (when author
+ (log-edit-add-field "Author" (car author))
+ (log-edit-add-field "Summary" ""))
;; Add a Fixes: field if applicable.
(when (consp log-edit-rewrite-fixes)
(rfc822-goto-eoh)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 3bbd0ed..626e190 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1087,7 +1087,7 @@ CVS/Entries should only be accessed through this
function."
;; an uppercase or lowercase letter and can contain uppercase and
;; lowercase letters, digits, `-', and `_'.
(and (string-match "^[a-zA-Z]" tag)
- (not (string-match "[^a-z0-9A-Z-_]" tag))))
+ (not (string-match "[^a-z0-9A-Z_-]" tag))))
(defun vc-cvs-valid-revision-number-p (tag)
"Return non-nil if TAG is a valid revision number."
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 0f8c9c8..a921ff1 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -101,6 +101,7 @@
(eval-when-compile
(require 'cl-lib)
+ (require 'subr-x) ; for string-trim-right
(require 'vc)
(require 'vc-dir))
@@ -1017,7 +1018,8 @@ This prompts for a branch to merge from."
If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
\(This requires at least Git version 1.5.6, for the --graph option.)
If START-REVISION is non-nil, it is the newest revision to show.
-If LIMIT is non-nil, show no more than this many entries."
+If LIMIT is a number, show no more than this many entries.
+If LIMIT is a revision string, use it as an end-revision."
(let ((coding-system-for-read
(or coding-system-for-read vc-git-log-output-coding-system)))
;; `vc-do-command' creates the buffer, but we need it before running
@@ -1045,8 +1047,14 @@ If LIMIT is non-nil, show no more than this many
entries."
,(format "--pretty=tformat:%s"
(car vc-git-root-log-format))
"--abbrev-commit"))
- (when limit (list "-n" (format "%s" limit)))
- (when start-revision (list start-revision))
+ (when (numberp limit)
+ (list "-n" (format "%s" limit)))
+ (when start-revision
+ (if (and limit (not (numberp limit)))
+ (list (concat start-revision ".." (if (equal limit "")
+ "HEAD"
+ limit)))
+ (list start-revision)))
'("--")))))))
(defun vc-git-log-outgoing (buffer remote-location)
@@ -1077,6 +1085,10 @@ If LIMIT is non-nil, show no more than this many
entries."
"@{upstream}"
remote-location))))
+(defun vc-git-mergebase (rev1 &optional rev2)
+ (unless rev2 (setq rev2 "HEAD"))
+ (string-trim-right (vc-git--run-command-string nil "merge-base" rev1 rev2)))
+
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
@@ -1093,7 +1105,7 @@ If LIMIT is non-nil, show no more than this many entries."
(cadr vc-git-root-log-format)
"^commit *\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
- (when (memq vc-log-view-type '(short log-outgoing log-incoming))
+ (when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
'vc-git-expanded-log-entry))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 2052ace..07b3d86 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -890,6 +890,8 @@ In the latter case, VC mode is deactivated for this buffer."
(define-key map "L" 'vc-print-root-log)
(define-key map "I" 'vc-log-incoming)
(define-key map "O" 'vc-log-outgoing)
+ (define-key map "ML" 'vc-log-mergebase)
+ (define-key map "MD" 'vc-diff-mergebase)
(define-key map "m" 'vc-merge)
(define-key map "r" 'vc-retrieve-tag)
(define-key map "s" 'vc-create-tag)
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 618f03e..3c50c8f 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -759,7 +759,7 @@ Set file properties accordingly. If FILENAME is non-nil,
return its status."
;; an uppercase or lowercase letter and can contain uppercase and
;; lowercase letters, digits, `-', and `_'.
(and (string-match "^[a-zA-Z]" tag)
- (not (string-match "[^a-z0-9A-Z-_]" tag))))
+ (not (string-match "[^a-z0-9A-Z_-]" tag))))
(defun vc-svn-valid-revision-number-p (tag)
"Return non-nil if TAG is a valid revision number."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 0a638ec..b992a8e 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -429,6 +429,10 @@
;; - region-history-mode ()
;;
;; Major mode to use for the output of `region-history'.
+;;
+;; - mergebase (rev1 &optional rev2)
+;;
+;; Return the common ancestor between REV1 and REV2 revisions.
;; TAG SYSTEM
;;
@@ -1802,7 +1806,12 @@ Return t if the buffer had changes, nil otherwise."
;;;###autoload
(defun vc-version-diff (_files rev1 rev2)
- "Report diffs between REV1 and REV2 revisions of the fileset."
+ "Report diffs between revisions REV1 and REV2 in the repository history.
+This compares two revisions of the current fileset.
+If REV1 is nil, it defaults to the current revision, i.e. revision
+of the last commit.
+If REV2 is nil, it defaults to the work tree, i.e. the current
+state of each file in the fileset."
(interactive (vc-diff-build-argument-list-internal))
;; All that was just so we could do argument completion!
(when (and (not rev1) rev2)
@@ -1854,14 +1863,47 @@ saving the buffer."
(vc-diff-internal t (vc-deduce-fileset t) nil nil
(called-interactively-p 'interactive))))
+;;;###autoload
+(defun vc-diff-mergebase (_files rev1 rev2)
+ "Report diffs between the merge base of REV1 and REV2 revisions.
+The merge base is a common ancestor between REV1 and REV2 revisions."
+ (interactive
+ (vc-diff-build-argument-list-internal
+ (or (ignore-errors (vc-deduce-fileset t))
+ (let ((backend (or (vc-deduce-backend) (vc-responsible-backend
default-directory))))
+ (list backend (list (vc-call-backend backend 'root
default-directory)))))))
+ (when (and (not rev1) rev2)
+ (error "Not a valid revision range"))
+ (let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
+ rootdir)
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
+ (let ((default-directory rootdir)
+ (rev1 (vc-call-backend backend 'mergebase rev1 rev2)))
+ (vc-diff-internal
+ t (list backend (list rootdir)) rev1 rev2
+ (called-interactively-p 'interactive)))))
+
(declare-function ediff-load-version-control "ediff" (&optional silent))
(declare-function ediff-vc-internal "ediff-vers"
(rev1 rev2 &optional startup-hooks))
;;;###autoload
(defun vc-version-ediff (files rev1 rev2)
- "Show differences between revisions of the fileset in the
-repository history using ediff."
+ "Show differences between REV1 and REV2 of FILES using ediff.
+This compares two revisions of the files in FILES. Currently,
+only a single file's revisions can be compared, i.e. FILES can
+specify only one file name.
+If REV1 is nil, it defaults to the current revision, i.e. revision
+of the last commit.
+If REV2 is nil, it defaults to the work tree, i.e. the current
+state of each file in FILES."
(interactive (vc-diff-build-argument-list-internal))
;; All that was just so we could do argument completion!
(when (and (not rev1) rev2)
@@ -2485,6 +2527,28 @@ When called interactively with a prefix argument, prompt
for REMOTE-LOCATION."
"*vc-outgoing*" 'log-outgoing)))
;;;###autoload
+(defun vc-log-mergebase (_files rev1 rev2)
+ "Show a log of changes between the merge base of REV1 and REV2 revisions.
+The merge base is a common ancestor between REV1 and REV2 revisions."
+ (interactive
+ (vc-diff-build-argument-list-internal
+ (or (ignore-errors (vc-deduce-fileset t))
+ (let ((backend (or (vc-deduce-backend) (vc-responsible-backend
default-directory))))
+ (list backend (list (vc-call-backend backend 'root
default-directory)))))))
+ (let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
+ rootdir)
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-log: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (unless backend
+ (error "Directory is not version controlled")))
+ (setq default-directory rootdir)
+ (setq rev1 (vc-call-backend backend 'mergebase rev1 rev2))
+ (vc-print-log-internal backend (list rootdir) rev1 t (or rev2 ""))))
+
+;;;###autoload
(defun vc-region-history (from to)
"Show the history of the region between FROM and TO.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 52c0b5b..b9f98cd 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1163,8 +1163,9 @@ When not inside a field, signal an error."
(defun widget-at (&optional pos)
"The button or field at POS (default, point)."
- (or (get-char-property (or pos (point)) 'button)
- (widget-field-at pos)))
+ (let ((widget (or (get-char-property (or pos (point)) 'button)
+ (widget-field-at pos))))
+ (and (widgetp widget) widget)))
;;;###autoload
(defun widget-setup ()
diff --git a/lisp/window.el b/lisp/window.el
index b769be0..b4f5ac5 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -9314,6 +9314,8 @@ is active. This function is run by
`mouse-autoselect-window-timer'."
;; autoselection.
(mouse-autoselect-window-start mouse-position window)))))
+(declare-function display-multi-frame-p "frame" (&optional display))
+
(defun handle-select-window (event)
"Handle select-window events."
(interactive "^e")
@@ -9351,7 +9353,7 @@ is active. This function is run by
`mouse-autoselect-window-timer'."
;; we might get two windows with an active cursor.
(select-window window)
(cond
- ((or (not (memq (window-system frame) '(x w32 ns)))
+ ((or (not (display-multi-frame-p))
(not focus-follows-mouse)
;; Focus FRAME if it's either a child frame or an ancestor
;; of the frame switched from.
diff --git a/lisp/woman.el b/lisp/woman.el
index a351f78..39d9b80 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -3511,7 +3511,7 @@ The expression may be an argument in quotes."
(let ((value (if (looking-at "[+-]") 0 (woman-parse-numeric-value)))
op)
(while (cond
- ((looking-at "[+-/*%]") ; arithmetic operators
+ ((looking-at "[+/*%-]") ; arithmetic operators
(forward-char)
(setq op (intern-soft (match-string 0)))
(setq value (funcall op value (woman-parse-numeric-value))))
diff --git a/lisp/xml.el b/lisp/xml.el
index 076291b..b5b923f 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -176,11 +176,11 @@ See also `xml-get-attribute-or-nil'."
;; [4] NameStartChar
;; See the definition of word syntax in `xml-syntax-table'.
-(defconst xml-name-start-char-re (concat "[[:word:]:_]"))
+(defconst xml-name-start-char-re "[[:word:]:_]")
;; [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7
;; | [#x0300-#x036F] | [#x203F-#x2040]
-(defconst xml-name-char-re (concat "[-0-9.[:word:]:_·̀-ͯ‿-⁀]"))
+(defconst xml-name-char-re "[[:word:]:_.0-9\u00B7\u0300-\u036F\u203F\u2040-]")
;; [5] Name ::= NameStartChar (NameChar)*
(defconst xml-name-re (concat xml-name-start-char-re xml-name-char-re "*"))
@@ -718,10 +718,10 @@ This follows the rule [28] in the XML specifications."
(cond ((looking-at "PUBLIC\\s-+")
(goto-char (match-end 0))
(unless (or (re-search-forward
-
"\\=\"\\([[:space:][:alnum:]-'()+,./:=?;address@hidden)\""
+
"\\=\"\\([[:space:][:alnum:]'()+,./:=?;address@hidden)\""
nil t)
(re-search-forward
- "\\='\\([[:space:][:alnum:]-()+,./:=?;address@hidden)'"
+ "\\='\\([[:space:][:alnum:]()+,./:=?;address@hidden)'"
nil t))
(error "XML: Missing Public ID"))
(let ((pubid (match-string-no-properties 1)))
diff --git a/m4/fdopendir.m4 b/m4/fdopendir.m4
index 0490551..b2b3b03 100644
--- a/m4/fdopendir.m4
+++ b/m4/fdopendir.m4
@@ -1,4 +1,4 @@
-# serial 10
+# serial 11
# See if we need to provide fdopendir.
dnl Copyright (C) 2009-2019 Free Software Foundation, Inc.
@@ -45,10 +45,12 @@ DIR *fdopendir (int);
[gl_cv_func_fdopendir_works=yes],
[gl_cv_func_fdopendir_works=no],
[case "$host_os" in
- # Guess yes on glibc systems.
- *-gnu*) gl_cv_func_fdopendir_works="guessing yes" ;;
- # If we don't know, assume the worst.
- *) gl_cv_func_fdopendir_works="guessing no" ;;
+ # Guess yes on glibc systems.
+ *-gnu*) gl_cv_func_fdopendir_works="guessing yes" ;;
+ # Guess yes on musl systems.
+ *-musl*) gl_cv_func_fdopendir_works="guessing yes" ;;
+ # If we don't know, assume the worst.
+ *) gl_cv_func_fdopendir_works="guessing no" ;;
esac
])])
case "$gl_cv_func_fdopendir_works" in
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
index 2ce986e..c93447b 100644
--- a/m4/getgroups.m4
+++ b/m4/getgroups.m4
@@ -1,4 +1,4 @@
-# serial 21
+# serial 22
dnl From Jim Meyering.
dnl A wrapper around AC_FUNC_GETGROUPS.
@@ -42,6 +42,8 @@ AC_DEFUN([AC_FUNC_GETGROUPS],
[case "$host_os" in # ((
# Guess yes on glibc systems.
*-gnu* | gnu*) ac_cv_func_getgroups_works="guessing yes" ;;
+ # Guess yes on musl systems.
+ *-musl*) ac_cv_func_getgroups_works="guessing yes" ;;
# If we don't know, assume the worst.
*) ac_cv_func_getgroups_works="guessing no" ;;
esac
@@ -95,6 +97,8 @@ AC_DEFUN([gl_FUNC_GETGROUPS],
[case "$host_os" in
# Guess yes on glibc systems.
*-gnu* | gnu*) gl_cv_func_getgroups_works="guessing yes" ;;
+ # Guess yes on musl systems.
+ *-musl*) gl_cv_func_getgroups_works="guessing yes" ;;
# If we don't know, assume the worst.
*) gl_cv_func_getgroups_works="guessing no" ;;
esac
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
index d29b4bf..5e2ef6f 100644
--- a/m4/gettimeofday.m4
+++ b/m4/gettimeofday.m4
@@ -1,4 +1,4 @@
-# serial 25
+# serial 26
# Copyright (C) 2001-2003, 2005, 2007, 2009-2019 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -105,6 +105,8 @@ AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER],
case "$host_os" in
# Guess all is fine on glibc systems.
*-gnu* | gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # Guess all is fine on musl systems.
+ *-musl*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
# Guess no on native Windows.
mingw*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
# If we don't know, assume the worst.
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 7c0e3e8..57b94ed 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 41
+# gnulib-common.m4 serial 44
dnl Copyright (C) 2007-2019 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -17,10 +17,13 @@ AC_DEFUN([gl_COMMON_BODY], [
AH_VERBATIM([_Noreturn],
[/* The _Noreturn keyword of C11. */
#ifndef _Noreturn
-# if 201103 <= (defined __cplusplus ? __cplusplus : 0)
+# if (defined __cplusplus \
+ && ((201103 <= __cplusplus && !(__GNUC__ == 4 && __GNUC_MINOR__ == 7)) \
+ || (defined _MSC_VER && 1900 <= _MSC_VER)))
# define _Noreturn [[noreturn]]
-# elif (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__))
+# elif ((!defined __cplusplus || defined __clang__) \
+ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
+ || 4 < __GNUC__ + (7 <= __GNUC_MINOR__)))
/* _Noreturn works as-is. */
# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
@@ -85,6 +88,33 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _GL_ATTRIBUTE_MALLOC /* empty */
#endif
])
+ AH_VERBATIM([async_safe],
+[/* The _GL_ASYNC_SAFE marker should be attached to functions that are
+ signal handlers (for signals other than SIGABRT, SIGPIPE) or can be
+ invoked from such signal handlers. Such functions have some restrictions:
+ * All functions that it calls should be marked _GL_ASYNC_SAFE as well,
+ or should be listed as async-signal-safe in POSIX
+
<http://pubs.opengroup.org/onlinepubs/9699919799/functions/V2_chap02.html#tag_15_04>
+ section 2.4.3. Note that malloc(), sprintf(), and fwrite(), in
+ particular, are NOT async-signal-safe.
+ * All memory locations (variables and struct fields) that these functions
+ access must be marked 'volatile'. This holds for both read and write
+ accesses. Otherwise the compiler might optimize away stores to and
+ reads from such locations that occur in the program, depending on its
+ data flow analysis. For example, when the program contains a loop
+ that is intended to inspect a variable set from within a signal handler
+ while (!signal_occurred)
+ ;
+ the compiler is allowed to transform this into an endless loop if the
+ variable 'signal_occurred' is not declared 'volatile'.
+ Additionally, recall that:
+ * A signal handler should not modify errno (except if it is a handler
+ for a fatal signal and ends by raising the same signal again, thus
+ provoking the termination of the process). If it invokes a function
+ that may clobber errno, it needs to save and restore the value of
+ errno. */
+#define _GL_ASYNC_SAFE
+])
dnl Preparation for running test programs:
dnl Tell glibc to write diagnostics from -D_FORTIFY_SOURCE=2 to stderr, not
dnl to /dev/tty, so they can be redirected to log files. Such diagnostics
diff --git a/m4/putenv.m4 b/m4/putenv.m4
index f8960f6..342ba26 100644
--- a/m4/putenv.m4
+++ b/m4/putenv.m4
@@ -1,4 +1,4 @@
-# putenv.m4 serial 22
+# putenv.m4 serial 23
dnl Copyright (C) 2002-2019 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -36,6 +36,8 @@ AC_DEFUN([gl_FUNC_PUTENV],
[case "$host_os" in
# Guess yes on glibc systems.
*-gnu* | gnu*) gl_cv_func_svid_putenv="guessing yes" ;;
+ # Guess yes on musl systems.
+ *-musl*) gl_cv_func_svid_putenv="guessing yes" ;;
# Guess no on native Windows.
mingw*) gl_cv_func_svid_putenv="guessing no" ;;
# If we don't know, assume the worst.
diff --git a/m4/utimes.m4 b/m4/utimes.m4
index 7209b6d..5806d8f 100644
--- a/m4/utimes.m4
+++ b/m4/utimes.m4
@@ -1,5 +1,5 @@
# Detect some bugs in glibc's implementation of utimes.
-# serial 5
+# serial 6
dnl Copyright (C) 2003-2005, 2009-2019 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
@@ -143,9 +143,11 @@ main ()
[gl_cv_func_working_utimes=yes],
[gl_cv_func_working_utimes=no],
[case "$host_os" in
- # Guess no on native Windows.
- mingw*) gl_cv_func_working_utimes="guessing no" ;;
- *) gl_cv_func_working_utimes="guessing no" ;;
+ # Guess yes on musl systems.
+ *-musl*) gl_cv_func_working_utimes="guessing yes" ;;
+ # Guess no on native Windows.
+ mingw*) gl_cv_func_working_utimes="guessing no" ;;
+ *) gl_cv_func_working_utimes="guessing no" ;;
esac
])
])
diff --git a/make-dist b/make-dist
index 4e18d77..821895a 100755
--- a/make-dist
+++ b/make-dist
@@ -366,7 +366,7 @@ possibly_non_vc_files="
$top_level_ChangeLog
MANIFEST aclocal.m4 configure
admin/charsets/jisx2131-filter
- src/config.in src/dmpstruct.h src/emacs-module.h
+ src/config.in src/emacs-module.h
src/fingerprint.c
"$(
find admin doc etc lisp \
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
index 4eda9f4..08e2e51 100644
--- a/nextstep/Makefile.in
+++ b/nextstep/Makefile.in
@@ -44,7 +44,7 @@ ns_check_file = @ns_appdir@/@ns_check_file@
.PHONY: all
-all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_appbindir}/emacs.pdmp
+all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_appbindir}/Emacs.pdmp
${ns_check_file} ${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc}
rm -rf ${ns_appdir}
@@ -63,7 +63,7 @@ ${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file}
../src/emacs${EXEEXT}
${MKDIR_P} ${ns_appbindir}
cp -f ../src/emacs${EXEEXT} $@
-${ns_appbindir}/emacs.pdmp: ${ns_appdir} ${ns_check_file}
../src/emacs${EXEEXT}.pdmp
+${ns_appbindir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file}
../src/emacs${EXEEXT}.pdmp
${MKDIR_P} ${ns_appbindir}
cp -f ../src/emacs${EXEEXT}.pdmp $@
@@ -85,7 +85,7 @@ links: ../src/emacs${EXEEXT}
ln -s $(top_srcdir_abs)/info ${ns_appdir}/Contents/Resources
${MKDIR_P} ${ns_appbindir}
ln -s $(abs_top_builddir)/src/emacs${EXEEXT} ${ns_appbindir}/Emacs
- ln -s $(abs_top_builddir)/src/emacs${EXEEXT}.pdmp ${ns_appbindir}/
+ ln -s $(abs_top_builddir)/src/emacs${EXEEXT}.pdmp
${ns_appbindir}/Emacs.pdmp
ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/bin
ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/libexec
${MKDIR_P} ${ns_appdir}/Contents/Resources/etc
diff --git a/src/.gdbinit b/src/.gdbinit
index 7553f07..b8b3031 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1219,24 +1219,12 @@ show environment TERM
# terminate_due_to_signal when an assertion failure is non-fatal.
break terminate_due_to_signal
-# x_error_quitter is defined only on X. But window-system is set up
-# only at run time, during Emacs startup, so we need to defer setting
-# the breakpoint. init_sys_modes is the first function called on
-# every platform after init_display, where window-system is set.
-tbreak init_sys_modes
-commands
- silent
- xsymname globals.f_Vinitial_window_system
- xgetptr $symname
- set $tem = (struct Lisp_String *) $ptr
- set $tem = (char *) $tem->u.s.data
- # If we are running in synchronous mode, we want a chance to look
- # around before Emacs exits. Perhaps we should put the break
- # somewhere else instead...
- if $tem[0] == 'x' && $tem[1] == '\0'
- break x_error_quitter
- end
- continue
+# x_error_quitter is defined only if defined_HAVE_X_WINDOWS.
+# If we are running in synchronous mode, we want a chance to look
+# around before Emacs exits. Perhaps we should put the break
+# somewhere else instead...
+if defined_HAVE_X_WINDOWS
+ break x_error_quitter
end
diff --git a/src/Makefile.in b/src/Makefile.in
index ee27db0..2348c8d 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -331,6 +331,7 @@ BUILD_DETAILS = @BUILD_DETAILS@
UNEXEC_OBJ = @UNEXEC_OBJ@
address@hidden@
+CHECK_STRUCTS = @CHECK_STRUCTS@
# 'make' verbosity.
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
@@ -458,10 +459,12 @@ all: emacs$(EXEEXT) $(pdmp) $(OTHER_FILES)
dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \
$(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h
+ifeq ($(CHECK_STRUCTS),true)
pdumper.o: dmpstruct.h
+endif
dmpstruct.h: $(srcdir)/dmpstruct.awk
dmpstruct.h: $(libsrc)/make-fingerprint$(EXEEXT) $(dmpstruct_headers)
- POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \
+ $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \
$(dmpstruct_headers) > $@
AUTO_DEPEND = @AUTO_DEPEND@
@@ -541,7 +544,7 @@ ${lispintdir}/cp51932.el ${lispintdir}/eucjp-ms.el: FORCE
charsets = ${top_srcdir}/admin/charsets/charsets.stamp
${charsets}: FORCE
- ${MAKE} -C ../admin/charsets all
+ $(MAKE) -C ../admin/charsets all
charscript = ${lispintdir}/charscript.el
${charscript}: FORCE
@@ -592,8 +595,9 @@ $(etc)/DOC: lisp.mk $(libsrc)/make-docfile$(EXEEXT) $(obj)
$(lisp)
$(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \
$(shortlisp)
-$(libsrc)/make-docfile$(EXEEXT): $(lib)/libgnu.a
- $(MAKE) -C $(libsrc) make-docfile$(EXEEXT)
+$(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \
+ $(lib)/libgnu.a
+ $(MAKE) -C $(dir $@) $(notdir $@)
buildobj.h: Makefile
$(AM_V_GEN)for i in $(ALLOBJS); do \
@@ -621,30 +625,21 @@ $(ALLOBJS): globals.h
LIBEGNU_ARCHIVE = $(lib)/lib$(if $(HYBRID_MALLOC),e)gnu.a
$(LIBEGNU_ARCHIVE): $(config_h)
- $(MAKE) -C $(lib) all
-
-EMACS_DEPS_PRE=$(LIBXMENU) $(ALLOBJS)
-EMACS_DEPS_POST=$(LIBEGNU_ARCHIVE) $(EMACSRES) ${charsets} ${charscript}
-BUILD_EMACS_PRE=$(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \
- -o $@ $(ALLOBJS)
-BUILD_EMACS_POST=$(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES)
-
-## We hash this file to generate the build fingerprint
-temacs.in$(EXEEXT): $(EMACS_DEPS_PRE) fingerprint-dummy.o $(EMACS_DEPS_POST)
- $(BUILD_EMACS_PRE) fingerprint-dummy.o $(BUILD_EMACS_POST)
+ $(MAKE) -C $(dir $@) all
-$(libsrc)/make-fingerprint$(EXEEXT): $(libsrc)/make-fingerprint.c
$(lib)/libgnu.a
- $(MAKE) -C $(libsrc) make-fingerprint$(EXEEXT)
-
-fingerprint.c: temacs.in$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT)
- $(libsrc)/make-fingerprint$(EXEEXT) temacs.in$(EXEEXT) > fingerprint.c
+FINGERPRINTED = $(LIBXMENU) $(ALLOBJS) $(LIBEGNU_ARCHIVE) $(EMACSRES)
+fingerprint.c: $(FINGERPRINTED) $(libsrc)/make-fingerprint$(EXEEXT)
+ $(AM_V_GEN)$(libsrc)/make-fingerprint$(EXEEXT) $(FINGERPRINTED)
>address@hidden
+ $(AM_V_at)mv address@hidden $@
## We have to create $(etc) here because init_cmdargs tests its
## existence when setting Vinstallation_directory (FIXME?).
## This goes on to affect various things, and the emacs binary fails
## to start if Vinstallation_directory has the wrong value.
-temacs$(EXEEXT): $(EMACS_DEPS_PRE) fingerprint.o $(EMACS_DEPS_POST)
- $(BUILD_EMACS_PRE) fingerprint.o $(BUILD_EMACS_POST)
+temacs$(EXEEXT): fingerprint.o $(charsets) $(charscript)
+ $(AM_V_CCLD)$(CC) -o $@ $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \
+ $(ALLOBJS) fingerprint.o \
+ $(LIBEGNU_ARCHIVE) $(W32_RES_LINK) $(LIBES)
$(MKDIR_P) $(etc)
ifeq ($(DUMPING),unexec)
ifneq ($(PAXCTL_notdumped),)
@@ -655,15 +650,15 @@ endif
## The following oldxmenu-related rules are only (possibly) used if
## HAVE_X11 && !USE_GTK, but there is no harm in always defining them.
$(lwlibdir)/liblw.a: $(config_h) globals.h lisp.h FORCE
- $(MAKE) -C $(lwlibdir) liblw.a
+ $(MAKE) -C $(dir $@) $(notdir $@)
$(oldXMenudir)/libXMenu11.a: FORCE
- $(MAKE) -C $(oldXMenudir) libXMenu11.a
+ $(MAKE) -C $(dir $@) $(notdir $@)
FORCE:
.PHONY: FORCE
.PRECIOUS: ../config.status Makefile
../config.status: $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4
- $(MAKE) -C .. $(notdir $@)
+ $(MAKE) -C $(dir $@) $(notdir $@)
Makefile: ../config.status $(srcdir)/Makefile.in
$(MAKE) -C .. src/$@
@@ -681,7 +676,7 @@ ns-app: emacs$(EXEEXT) $(pdmp)
mostlyclean:
rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o
- rm -f temacs.in$(EXEEXT) fingerprint.c dmpstruct.h
+ rm -f dmpstruct.h fingerprint.c
rm -f emacs.pdmp
rm -f ../etc/DOC
rm -f bootstrap-emacs$(EXEEXT) $(bootstrap_pdmp)
@@ -719,7 +714,7 @@ extraclean: distclean
ETAGS = ../lib-src/etags${EXEEXT}
${ETAGS}: FORCE
- ${MAKE} -C ../lib-src $(notdir $@)
+ $(MAKE) -C $(dir $@) $(notdir $@)
# Remove macuvs.h and fingerprint.c since they'd cause `src/emacs`
# to be built before we can get TAGS.
@@ -744,11 +739,8 @@ TAGS: ${ETAGS} $(ctagsfiles1) $(ctagsfiles2)
## Arrange to make tags tables for ../lisp and ../lwlib,
## which the above TAGS file for the C files includes by reference.
-../lisp/TAGS: FORCE
- $(MAKE) -C ../lisp TAGS ETAGS="$(ETAGS)"
-
-$(lwlibdir)/TAGS: FORCE
- $(MAKE) -C $(lwlibdir) TAGS ETAGS="$(ETAGS)"
+../lisp/TAGS $(lwlibdir)/TAGS: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@) ETAGS="$(ETAGS)"
tags: TAGS ../lisp/TAGS $(lwlibdir)/TAGS
.PHONY: tags
diff --git a/src/alloc.c b/src/alloc.c
index f929a37..dd78386 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3718,8 +3718,8 @@ Its value is void, and its function definition and
property list are nil. */)
Lisp_Object
make_misc_ptr (void *a)
{
- struct Lisp_Misc_Ptr *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Misc_Ptr,
pointer,
- PVEC_MISC_PTR);
+ struct Lisp_Misc_Ptr *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Misc_Ptr,
+ PVEC_MISC_PTR);
p->pointer = a;
return make_lisp_ptr (p, Lisp_Vectorlike);
}
@@ -3729,7 +3729,7 @@ make_misc_ptr (void *a)
Lisp_Object
build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
{
- struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, next,
+ struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, plist,
PVEC_OVERLAY);
Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike);
OVERLAY_START (overlay) = start;
@@ -3743,8 +3743,8 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
doc: /* Return a newly allocated marker which does not point at any
place. */)
(void)
{
- struct Lisp_Marker *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer,
- PVEC_MARKER);
+ struct Lisp_Marker *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker,
+ PVEC_MARKER);
p->buffer = 0;
p->bytepos = 0;
p->charpos = 0;
@@ -3766,8 +3766,8 @@ build_marker (struct buffer *buf, ptrdiff_t charpos,
ptrdiff_t bytepos)
/* Every character is at least one byte. */
eassert (charpos <= bytepos);
- struct Lisp_Marker *m = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer,
- PVEC_MARKER);
+ struct Lisp_Marker *m = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker,
+ PVEC_MARKER);
m->buffer = buf;
m->charpos = charpos;
m->bytepos = bytepos;
@@ -3821,8 +3821,8 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
Lisp_Object
make_user_ptr (void (*finalizer) (void *), void *p)
{
- struct Lisp_User_Ptr *uptr = ALLOCATE_PSEUDOVECTOR (struct Lisp_User_Ptr,
- finalizer, PVEC_USER_PTR);
+ struct Lisp_User_Ptr *uptr
+ = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_User_Ptr, PVEC_USER_PTR);
uptr->finalizer = finalizer;
uptr->p = p;
return make_lisp_ptr (uptr, Lisp_Vectorlike);
@@ -3945,7 +3945,7 @@ FUNCTION. FUNCTION will be run once per finalizer
object. */)
(Lisp_Object function)
{
struct Lisp_Finalizer *finalizer
- = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, prev, PVEC_FINALIZER);
+ = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, function, PVEC_FINALIZER);
finalizer->function = function;
finalizer->prev = finalizer->next = NULL;
finalizer_insert (&finalizers, finalizer);
@@ -5342,7 +5342,8 @@ valid_lisp_object_p (Lisp_Object obj)
/* Allocate room for SIZE bytes from pure Lisp storage and return a
pointer to it. TYPE is the Lisp type for which the memory is
- allocated. TYPE < 0 means it's not used for a Lisp object. */
+ allocated. TYPE < 0 means it's not used for a Lisp object,
+ and that the result should have an alignment of -TYPE. */
static void *
pure_alloc (size_t size, int type)
@@ -5361,8 +5362,11 @@ pure_alloc (size_t size, int type)
{
/* Allocate space for a non-Lisp object from the end of the free
space. */
- pure_bytes_used_non_lisp += size;
- result = purebeg + pure_size - pure_bytes_used_non_lisp;
+ ptrdiff_t unaligned_non_lisp = pure_bytes_used_non_lisp + size;
+ char *unaligned = purebeg + pure_size - unaligned_non_lisp;
+ int decr = (intptr_t) unaligned & (-1 - type);
+ pure_bytes_used_non_lisp = unaligned_non_lisp + decr;
+ result = unaligned - decr;
}
pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
@@ -5549,7 +5553,8 @@ make_pure_bignum (struct Lisp_Bignum *value)
struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike);
XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum));
- pure_limbs = pure_alloc (nbytes, -1);
+ int limb_alignment = alignof (mp_limb_t);
+ pure_limbs = pure_alloc (nbytes, - limb_alignment);
for (i = 0; i < nlimbs; ++i)
pure_limbs[i] = mpz_getlimbn (value->value, i);
@@ -7644,6 +7649,12 @@ than 2**N, where N is this variable's value. N should
be nonnegative. */);
defsubr (&Ssuspicious_object);
}
+#ifdef HAVE_X_WINDOWS
+enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = true };
+#else
+enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = false };
+#endif
+
/* When compiled with GCC, GDB might say "No enum type named
pvec_type" if we don't have at least one symbol with that type, and
then xbacktrace could fail. Similarly for the other enums and
@@ -7662,5 +7673,6 @@ union
enum MAX_ALLOCA MAX_ALLOCA;
enum More_Lisp_Bits More_Lisp_Bits;
enum pvec_type pvec_type;
+ enum defined_HAVE_X_WINDOWS defined_HAVE_X_WINDOWS;
} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};
#endif /* __GNUC__ */
diff --git a/src/bignum.c b/src/bignum.c
index 4118601..009d731 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -86,8 +86,8 @@ make_bignum_bits (size_t bits)
if (integer_width < bits)
overflow_error ();
- struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
- PVEC_BIGNUM);
+ struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum,
+ PVEC_BIGNUM);
mpz_init (b->value);
mpz_swap (b->value, mpz[0]);
return make_lisp_ptr (b, Lisp_Vectorlike);
@@ -342,8 +342,8 @@ bignum_to_string (Lisp_Object num, int base)
Lisp_Object
make_bignum_str (char const *num, int base)
{
- struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
- PVEC_BIGNUM);
+ struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum,
+ PVEC_BIGNUM);
mpz_init (b->value);
int check = mpz_set_str (b->value, num, base);
eassert (check == 0);
diff --git a/src/buffer.c b/src/buffer.c
index 5fabbc2..ab47748 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -37,6 +37,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "window.h"
#include "commands.h"
#include "character.h"
+#include "coding.h"
#include "buffer.h"
#include "region-cache.h"
#include "indent.h"
@@ -583,6 +584,11 @@ even if it is dead. The return value is never nil. */)
set_string_intervals (name, NULL);
bset_name (b, name);
+ b->inhibit_buffer_hooks
+ = (STRINGP (Vcode_conversion_workbuf_name)
+ && strncmp (SSDATA (name), SSDATA (Vcode_conversion_workbuf_name),
+ SBYTES (Vcode_conversion_workbuf_name)) == 0);
+
bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
reset_buffer (b);
@@ -595,7 +601,7 @@ even if it is dead. The return value is never nil. */)
XSETBUFFER (buffer, b);
Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
/* And run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks))
+ if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
call1 (Vrun_hooks, Qbuffer_list_update_hook);
return buffer;
@@ -1201,7 +1207,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object
buffer)
result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
if (!NILP (result))
{
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
{ /* What binding is loaded right now? */
Lisp_Object current_alist_element = blv->valcell;
@@ -1222,7 +1228,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object
buffer)
}
case SYMBOL_FORWARDED:
{
- union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
+ lispfwd fwd = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (fwd))
result = per_buffer_value (buf, XBUFFER_OBJFWD (fwd)->offset);
else
@@ -1493,7 +1499,7 @@ This does not change the name of the visited file (if
any). */)
call0 (intern ("rename-auto-save-file"));
/* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks))
+ if (!NILP (Vrun_hooks) && !current_buffer->inhibit_buffer_hooks)
call1 (Vrun_hooks, Qbuffer_list_update_hook);
/* Refetch since that last call may have done GC. */
@@ -1706,10 +1712,13 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
/* First run the query functions; if any query is answered no,
don't kill the buffer. */
- tem = CALLN (Frun_hook_with_args_until_failure,
- Qkill_buffer_query_functions);
- if (NILP (tem))
- return unbind_to (count, Qnil);
+ if (!b->inhibit_buffer_hooks)
+ {
+ tem = CALLN (Frun_hook_with_args_until_failure,
+ Qkill_buffer_query_functions);
+ if (NILP (tem))
+ return unbind_to (count, Qnil);
+ }
/* Query if the buffer is still modified. */
if (INTERACTIVE && !NILP (BVAR (b, filename))
@@ -1726,7 +1735,8 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
return unbind_to (count, Qt);
/* Then run the hooks. */
- run_hook (Qkill_buffer_hook);
+ if (!b->inhibit_buffer_hooks)
+ run_hook (Qkill_buffer_hook);
unbind_to (count, Qnil);
}
@@ -1928,7 +1938,7 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
bset_undo_list (b, Qnil);
/* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks))
+ if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
call1 (Vrun_hooks, Qbuffer_list_update_hook);
return Qt;
@@ -1970,7 +1980,7 @@ record_buffer (Lisp_Object buffer)
fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
/* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks))
+ if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks)
call1 (Vrun_hooks, Qbuffer_list_update_hook);
}
@@ -2009,7 +2019,7 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal,
Sbury_buffer_internal,
(f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
/* Run buffer-list-update-hook. */
- if (!NILP (Vrun_hooks))
+ if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks)
call1 (Vrun_hooks, Qbuffer_list_update_hook);
return Qnil;
@@ -2130,7 +2140,7 @@ void set_buffer_internal_2 (register struct buffer *b)
Lisp_Object var = XCAR (XCAR (tail));
struct Lisp_Symbol *sym = XSYMBOL (var);
if (sym->u.s.redirect == SYMBOL_LOCALIZED /* Just to be sure. */
- && SYMBOL_BLV (sym)->fwd)
+ && SYMBOL_BLV (sym)->fwd.fwdptr)
/* Just reference the variable
to cause it to become set for this buffer. */
Fsymbol_value (var);
@@ -5434,7 +5444,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd,
const char *namestring,
bo_fwd->predicate = predicate;
sym->u.s.declared_special = true;
sym->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
+ SET_SYMBOL_FWD (sym, bo_fwd);
XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
if (PER_BUFFER_IDX (offset) == 0)
diff --git a/src/buffer.h b/src/buffer.h
index d3528ac..f42c3e9 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -741,8 +741,8 @@ struct buffer
See `cursor-type' for other values. */
Lisp_Object cursor_in_non_selected_windows_;
- /* No more Lisp_Object beyond this point. Except undo_list,
- which is handled specially in Fgarbage_collect. */
+ /* No more Lisp_Object beyond cursor_in_non_selected_windows_.
+ Except undo_list, which is handled specially in Fgarbage_collect. */
/* This structure holds the coordinates of the buffer contents
in ordinary buffers. In indirect buffers, this is not used. */
@@ -855,6 +855,13 @@ struct buffer
/* Non-zero whenever the narrowing is changed in this buffer. */
bool_bf clip_changed : 1;
+ /* Non-zero for internally used temporary buffers that don't need to
+ run hooks kill-buffer-hook, buffer-list-update-hook, and
+ kill-buffer-query-functions. This is used in coding.c to avoid
+ slowing down en/decoding when there are a lot of these hooks
+ defined. */
+ bool_bf inhibit_buffer_hooks : 1;
+
/* List of overlays that end at or before the current center,
in order of end-position. */
struct Lisp_Overlay *overlays_before;
@@ -1012,14 +1019,12 @@ bset_width_table (struct buffer *b, Lisp_Object val)
structure, make sure that this is still correct. */
#define BUFFER_LISP_SIZE \
- ((offsetof (struct buffer, own_text) - header_size) / word_size)
+ PSEUDOVECSIZE (struct buffer, cursor_in_non_selected_windows_)
-/* Size of the struct buffer part beyond leading Lisp_Objects, in word_size
- units. Rounding is needed for --with-wide-int configuration. */
+/* Allocated size of the struct buffer part beyond leading
+ Lisp_Objects, in word_size units. */
-#define BUFFER_REST_SIZE \
- ((((sizeof (struct buffer) - offsetof (struct buffer, own_text)) \
- + (word_size - 1)) & ~(word_size - 1)) / word_size)
+#define BUFFER_REST_SIZE (VECSIZE (struct buffer) - BUFFER_LISP_SIZE)
/* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE
is required for GC, but BUFFER_REST_SIZE is set up just to be consistent
diff --git a/src/coding.c b/src/coding.c
index 905c7ce..e351cc7 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -7785,7 +7785,7 @@ encode_coding (struct coding_system *coding)
/* Name (or base name) of work buffer for code conversion. */
-static Lisp_Object Vcode_conversion_workbuf_name;
+Lisp_Object Vcode_conversion_workbuf_name;
/* A working buffer used by the top level conversion. Once it is
created, it is never destroyed. It has the name
@@ -7797,43 +7797,6 @@ static Lisp_Object Vcode_conversion_reused_workbuf;
/* True iff Vcode_conversion_reused_workbuf is already in use. */
static bool reused_workbuf_in_use;
-
-/* Return a working buffer of code conversion. MULTIBYTE specifies the
- multibyteness of returning buffer. */
-
-static Lisp_Object
-make_conversion_work_buffer (bool multibyte)
-{
- Lisp_Object name, workbuf;
- struct buffer *current;
-
- if (reused_workbuf_in_use)
- {
- name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
- workbuf = Fget_buffer_create (name);
- }
- else
- {
- reused_workbuf_in_use = 1;
- if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf)))
- Vcode_conversion_reused_workbuf
- = Fget_buffer_create (Vcode_conversion_workbuf_name);
- workbuf = Vcode_conversion_reused_workbuf;
- }
- current = current_buffer;
- set_buffer_internal (XBUFFER (workbuf));
- /* We can't allow modification hooks to run in the work buffer. For
- instance, directory_files_internal assumes that file decoding
- doesn't compile new regexps. */
- Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt);
- Ferase_buffer ();
- bset_undo_list (current_buffer, Qt);
- bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
- set_buffer_internal (current);
- return workbuf;
-}
-
-
static void
code_conversion_restore (Lisp_Object arg)
{
@@ -7857,9 +7820,39 @@ code_conversion_save (bool with_work_buf, bool multibyte)
Lisp_Object workbuf = Qnil;
if (with_work_buf)
- workbuf = make_conversion_work_buffer (multibyte);
+ {
+ if (reused_workbuf_in_use)
+ {
+ Lisp_Object name
+ = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
+ workbuf = Fget_buffer_create (name);
+ }
+ else
+ {
+ if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf)))
+ Vcode_conversion_reused_workbuf
+ = Fget_buffer_create (Vcode_conversion_workbuf_name);
+ workbuf = Vcode_conversion_reused_workbuf;
+ }
+ }
record_unwind_protect (code_conversion_restore,
Fcons (Fcurrent_buffer (), workbuf));
+ if (!NILP (workbuf))
+ {
+ struct buffer *current = current_buffer;
+ set_buffer_internal (XBUFFER (workbuf));
+ /* We can't allow modification hooks to run in the work buffer. For
+ instance, directory_files_internal assumes that file decoding
+ doesn't compile new regexps. */
+ Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt);
+ Ferase_buffer ();
+ bset_undo_list (current_buffer, Qt);
+ bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
+ if (EQ (workbuf, Vcode_conversion_reused_workbuf))
+ reused_workbuf_in_use = 1;
+ set_buffer_internal (current);
+ }
+
return workbuf;
}
diff --git a/src/coding.h b/src/coding.h
index e38c0ee..0c03d1a 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -97,6 +97,8 @@ enum define_coding_undecided_arg_index
extern Lisp_Object Vcoding_system_hash_table;
+/* Name (or base name) of work buffer for code conversion. */
+extern Lisp_Object Vcode_conversion_workbuf_name;
/* Enumeration of index to an attribute vector of a coding system. */
diff --git a/src/composite.c b/src/composite.c
index c426cbb..88f1235 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -787,28 +787,19 @@ static Lisp_Object gstring_work;
static Lisp_Object gstring_work_headers;
static Lisp_Object
-fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte,
+fill_gstring_header (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t to, Lisp_Object font_object, Lisp_Object string)
{
- ptrdiff_t len = to - from, i;
-
+ ptrdiff_t len = to - from;
if (len == 0)
error ("Attempt to shape zero-length text");
- if (VECTORP (header))
- {
- if (ASIZE (header) != len + 1)
- args_out_of_range (header, make_fixnum (len + 1));
- }
- else
- {
- if (len <= 8)
- header = AREF (gstring_work_headers, len - 1);
- else
- header = make_uninit_vector (len + 1);
- }
+ eassume (0 < len);
+ Lisp_Object header = (len <= 8
+ ? AREF (gstring_work_headers, len - 1)
+ : make_uninit_vector (len + 1));
ASET (header, 0, font_object);
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
{
int c;
@@ -1748,7 +1739,7 @@ should be ignored. */)
frombyte = string_char_to_byte (string, frompos);
}
- header = fill_gstring_header (Qnil, frompos, frombyte,
+ header = fill_gstring_header (frompos, frombyte,
topos, font_object, string);
gstring = gstring_lookup_cache (header);
if (! NILP (gstring))
diff --git a/src/data.c b/src/data.c
index 15b6106..11cd598 100644
--- a/src/data.c
+++ b/src/data.c
@@ -42,49 +42,49 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *,
struct Lisp_Buffer_Local_Value *);
static bool
-BOOLFWDP (union Lisp_Fwd *a)
+BOOLFWDP (lispfwd a)
{
return XFWDTYPE (a) == Lisp_Fwd_Bool;
}
static bool
-INTFWDP (union Lisp_Fwd *a)
+INTFWDP (lispfwd a)
{
return XFWDTYPE (a) == Lisp_Fwd_Int;
}
static bool
-KBOARD_OBJFWDP (union Lisp_Fwd *a)
+KBOARD_OBJFWDP (lispfwd a)
{
return XFWDTYPE (a) == Lisp_Fwd_Kboard_Obj;
}
static bool
-OBJFWDP (union Lisp_Fwd *a)
+OBJFWDP (lispfwd a)
{
return XFWDTYPE (a) == Lisp_Fwd_Obj;
}
-static struct Lisp_Boolfwd *
-XBOOLFWD (union Lisp_Fwd *a)
+static struct Lisp_Boolfwd const *
+XBOOLFWD (lispfwd a)
{
eassert (BOOLFWDP (a));
- return &a->u_boolfwd;
+ return a.fwdptr;
}
-static struct Lisp_Kboard_Objfwd *
-XKBOARD_OBJFWD (union Lisp_Fwd *a)
+static struct Lisp_Kboard_Objfwd const *
+XKBOARD_OBJFWD (lispfwd a)
{
eassert (KBOARD_OBJFWDP (a));
- return &a->u_kboard_objfwd;
+ return a.fwdptr;
}
-static struct Lisp_Intfwd *
-XFIXNUMFWD (union Lisp_Fwd *a)
+static struct Lisp_Intfwd const *
+XFIXNUMFWD (lispfwd a)
{
eassert (INTFWDP (a));
- return &a->u_intfwd;
+ return a.fwdptr;
}
-static struct Lisp_Objfwd *
-XOBJFWD (union Lisp_Fwd *a)
+static struct Lisp_Objfwd const *
+XOBJFWD (lispfwd a)
{
eassert (OBJFWDP (a));
- return &a->u_objfwd;
+ return a.fwdptr;
}
static void
@@ -669,7 +669,7 @@ global value outside of any lexical scope. */)
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
/* In set_internal, we un-forward vars when their value is
set to Qunbound. */
return Qt;
@@ -980,7 +980,7 @@ chain of aliases, signal a `cyclic-variable-indirection'
error. */)
swap_in_symval_forwarding for that. */
Lisp_Object
-do_symval_forwarding (union Lisp_Fwd *valcontents)
+do_symval_forwarding (lispfwd valcontents)
{
switch (XFWDTYPE (valcontents))
{
@@ -1071,7 +1071,8 @@ wrong_range (Lisp_Object min, Lisp_Object max,
Lisp_Object wrong)
current buffer. This only plays a role for per-buffer variables. */
static void
-store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object
newval, struct buffer *buf)
+store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
+ struct buffer *buf)
{
switch (XFWDTYPE (valcontents))
{
@@ -1178,12 +1179,12 @@ swap_in_global_binding (struct Lisp_Symbol *symbol)
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol);
/* Unload the previously loaded binding. */
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Select the global binding in the symbol. */
set_blv_valcell (blv, blv->defcell);
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
/* Indicate that the global binding is set up now. */
@@ -1213,7 +1214,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol,
struct Lisp_Buffer_Local_
/* Unload the previously loaded binding. */
tem1 = blv->valcell;
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Choose the new binding. */
{
@@ -1227,7 +1228,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol,
struct Lisp_Buffer_Local_
/* Load the new binding. */
set_blv_valcell (blv, tem1);
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
store_symval_forwarding (blv->fwd, blv_value (blv), NULL);
}
}
@@ -1255,7 +1256,9 @@ find_symbol_value (Lisp_Object symbol)
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
swap_in_symval_forwarding (sym, blv);
- return blv->fwd ? do_symval_forwarding (blv->fwd) : blv_value (blv);
+ return (blv->fwd.fwdptr
+ ? do_symval_forwarding (blv->fwd)
+ : blv_value (blv));
}
case SYMBOL_FORWARDED:
return do_symval_forwarding (SYMBOL_FWD (sym));
@@ -1357,7 +1360,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object where,
We need to unload it, and choose a new binding. */
/* Write out `realvalue' to the old loaded binding. */
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
set_blv_value (blv, do_symval_forwarding (blv->fwd));
/* Find the new binding. */
@@ -1404,12 +1407,12 @@ set_internal (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object where,
/* Store the new value in the cons cell. */
set_blv_value (blv, newval);
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
{
if (voide)
/* If storing void (making the symbol void), forward only through
buffer-local indicator, not through Lisp_Objfwd, etc. */
- blv->fwd = NULL;
+ blv->fwd.fwdptr = NULL;
else
store_symval_forwarding (blv->fwd, newval,
BUFFERP (where)
@@ -1421,7 +1424,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object where,
{
struct buffer *buf
= BUFFERP (where) ? XBUFFER (where) : current_buffer;
- union Lisp_Fwd *innercontents = SYMBOL_FWD (sym);
+ lispfwd innercontents = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (innercontents))
{
int offset = XBUFFER_OBJFWD (innercontents)->offset;
@@ -1593,14 +1596,14 @@ default_value (Lisp_Object symbol)
But the `realvalue' slot may be more up to date, since
ordinary setq stores just that slot. So use that. */
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
- if (blv->fwd && EQ (blv->valcell, blv->defcell))
+ if (blv->fwd.fwdptr && EQ (blv->valcell, blv->defcell))
return do_symval_forwarding (blv->fwd);
else
return XCDR (blv->defcell);
}
case SYMBOL_FORWARDED:
{
- union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ lispfwd valcontents = SYMBOL_FWD (sym);
/* For a built-in buffer-local variable, get the default value
rather than letting do_symval_forwarding get the current value. */
@@ -1688,13 +1691,13 @@ set_default_internal (Lisp_Object symbol, Lisp_Object
value,
XSETCDR (blv->defcell, value);
/* If the default binding is now loaded, set the REALVALUE slot too. */
- if (blv->fwd && EQ (blv->defcell, blv->valcell))
+ if (blv->fwd.fwdptr && EQ (blv->defcell, blv->valcell))
store_symval_forwarding (blv->fwd, value, NULL);
return;
}
case SYMBOL_FORWARDED:
{
- union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ lispfwd valcontents = SYMBOL_FWD (sym);
/* Handle variables like case-fold-search that have special slots
in the buffer.
@@ -1744,43 +1747,13 @@ for this variable. */)
set_default_internal (symbol, value, SET_INTERNAL_SET);
return value;
}
-
-DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
- doc: /* Set the default value of variable VAR to VALUE.
-VAR, the variable name, is literal (not evaluated);
-VALUE is an expression: it is evaluated and its value returned.
-The default value of a variable is seen in buffers
-that do not have their own values for the variable.
-
-More generally, you can use multiple variables and values, as in
- (setq-default VAR VALUE VAR VALUE...)
-This sets each VAR's default value to the corresponding VALUE.
-The VALUE for the Nth VAR can refer to the new default values
-of previous VARs.
-usage: (setq-default [VAR VALUE]...) */)
- (Lisp_Object args)
-{
- Lisp_Object args_left, symbol, val;
-
- args_left = val = args;
-
- while (CONSP (args_left))
- {
- val = eval_sub (Fcar (XCDR (args_left)));
- symbol = XCAR (args_left);
- Fset_default (symbol, val);
- args_left = Fcdr (XCDR (args_left));
- }
-
- return val;
-}
/* Lisp functions for creating and removing buffer-local variables. */
union Lisp_Val_Fwd
{
Lisp_Object value;
- union Lisp_Fwd *fwd;
+ lispfwd fwd;
};
static struct Lisp_Buffer_Local_Value *
@@ -1800,7 +1773,10 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded,
or keyboard-local forwarding. */
eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
- blv->fwd = forwarded ? valcontents.fwd : NULL;
+ if (forwarded)
+ blv->fwd = valcontents.fwd;
+ else
+ blv->fwd.fwdptr = NULL;
set_blv_where (blv, Qnil);
blv->local_if_set = 0;
set_blv_defcell (blv, tem);
@@ -1971,7 +1947,7 @@ Instead, use `add-hook' and specify t for the LOCAL
argument. */)
Otherwise, if C code modifies the variable before we load the
binding in, then that new value would clobber the default binding
the next time we unload it. See bug#34318. */
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
swap_in_symval_forwarding (sym, blv);
}
@@ -1998,7 +1974,7 @@ From now on the default value will apply in this buffer.
Return VARIABLE. */)
case SYMBOL_PLAINVAL: return variable;
case SYMBOL_FORWARDED:
{
- union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ lispfwd valcontents = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (valcontents))
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
@@ -2081,7 +2057,7 @@ BUFFER defaults to the current buffer. */)
}
case SYMBOL_FORWARDED:
{
- union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ lispfwd valcontents = SYMBOL_FWD (sym);
if (BUFFER_OBJFWDP (valcontents))
{
int offset = XBUFFER_OBJFWD (valcontents)->offset;
@@ -2152,7 +2128,7 @@ If the current binding is global (the default), the value
is nil. */)
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_FORWARDED:
{
- union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ lispfwd valcontents = SYMBOL_FWD (sym);
if (KBOARD_OBJFWDP (valcontents))
return Fframe_terminal (selected_frame);
else if (!BUFFER_OBJFWDP (valcontents))
@@ -4047,7 +4023,6 @@ syms_of_data (void)
defsubr (&Sdefault_boundp);
defsubr (&Sdefault_value);
defsubr (&Sset_default);
- defsubr (&Ssetq_default);
defsubr (&Smake_variable_buffer_local);
defsubr (&Smake_local_variable);
defsubr (&Skill_local_variable);
diff --git a/src/decompress.c b/src/decompress.c
index e66e479..4ca6a50 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -120,12 +120,18 @@ DEFUN ("zlib-available-p", Fzlib_available_p,
Szlib_available_p, 0, 0, 0,
DEFUN ("zlib-decompress-region", Fzlib_decompress_region,
Szlib_decompress_region,
- 2, 2, 0,
+ 2, 3, 0,
doc: /* Decompress a gzip- or zlib-compressed region.
Replace the text in the region by the decompressed data.
-On failure, return nil and leave the data in place.
+
+If optional parameter ALLOW-PARTIAL is nil or omitted, then on
+failure, return nil and leave the data in place. Otherwise, return
+the number of bytes that were not decompressed and replace the region
+text by whatever data was successfully decompressed (similar to gzip).
+If decompression is completely successful return t.
+
This function can be called only in unibyte buffers. */)
- (Lisp_Object start, Lisp_Object end)
+ (Lisp_Object start, Lisp_Object end, Lisp_Object allow_partial)
{
ptrdiff_t istart, iend, pos_byte;
z_stream stream;
@@ -206,8 +212,14 @@ This function can be called only in unibyte buffers. */)
}
while (inflate_status == Z_OK);
+ Lisp_Object ret = Qt;
if (inflate_status != Z_STREAM_END)
- return unbind_to (count, Qnil);
+ {
+ if (!NILP (allow_partial))
+ ret = make_int (iend - pos_byte);
+ else
+ return unbind_to (count, Qnil);
+ }
unwind_data.start = 0;
@@ -218,7 +230,7 @@ This function can be called only in unibyte buffers. */)
signal_after_change (istart, iend - istart, unwind_data.nbytes);
update_compositions (istart, istart, CHECK_HEAD);
- return unbind_to (count, Qt);
+ return unbind_to (count, ret);
}
diff --git a/src/dispextern.h b/src/dispextern.h
index 7947dc2..1a53656 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2938,7 +2938,7 @@ struct redisplay_interface
#ifdef HAVE_WINDOW_SYSTEM
-# if defined HAVE_XRENDER || defined HAVE_NS || defined HAVE_NTGUI
+# if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS || defined
HAVE_NTGUI
# define HAVE_NATIVE_SCALING
# endif
@@ -2957,7 +2957,6 @@ struct image
#ifdef USE_CAIRO
void *cr_data;
- void *cr_data2;
#endif
#ifdef HAVE_X_WINDOWS
/* X images of the image, corresponding to the above Pixmaps.
diff --git a/src/dmpstruct.awk b/src/dmpstruct.awk
old mode 100755
new mode 100644
diff --git a/src/editfns.c b/src/editfns.c
index ac9b871..6fb43af 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2686,8 +2686,9 @@ but is not deleted; if you save the buffer in a file, the
invisible
text is included in the file. \\[widen] makes all visible again.
See also `save-restriction'.
-When calling from a program, pass two arguments; positions (integers
-or markers) bounding the text that should remain visible. */)
+When calling from Lisp, pass two arguments START and END:
+positions (integers or markers) bounding the text that should
+remain visible. */)
(register Lisp_Object start, Lisp_Object end)
{
CHECK_FIXNUM_COERCE_MARKER (start);
@@ -2836,6 +2837,25 @@ usage: (save-restriction &rest BODY) */)
return unbind_to (count, val);
}
+/* i18n (internationalization). */
+
+DEFUN ("ngettext", Fngettext, Sngettext, 3, 3, 0,
+ doc: /* Return the translation of MSGID (plural MSGID_PLURAL) depending
on N.
+MSGID is the singular form of the string to be converted;
+use it as the key for the search in the translation catalog.
+MSGID_PLURAL is the plural form. Use N to select the proper translation.
+If no message catalog is found, MSGID is returned if N is equal to 1,
+otherwise MSGID_PLURAL. */)
+ (Lisp_Object msgid, Lisp_Object msgid_plural, Lisp_Object n)
+{
+ CHECK_STRING (msgid);
+ CHECK_STRING (msgid_plural);
+ CHECK_INTEGER (n);
+
+ /* Placeholder implementation until we get our act together. */
+ return EQ (n, make_fixnum (1)) ? msgid : msgid_plural;
+}
+
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
doc: /* Display a message at the bottom of the screen.
The message also goes into the `*Messages*' buffer, if `message-log-max'
@@ -4554,6 +4574,8 @@ it to be non-nil. */);
defsubr (&Sinsert_char);
defsubr (&Sinsert_byte);
+ defsubr (&Sngettext);
+
defsubr (&Suser_login_name);
defsubr (&Sgroup_name);
defsubr (&Suser_real_login_name);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 2bb1062..47ca336 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -427,7 +427,7 @@ static struct Lisp_Module_Function *
allocate_module_function (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
- min_arity, PVEC_MODULE_FUNCTION);
+ documentation, PVEC_MODULE_FUNCTION);
}
#define XSET_MODULE_FUNCTION(var, ptr) \
diff --git a/src/emacs.c b/src/emacs.c
index 68835ca..6ed4b0e 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -157,9 +157,14 @@ static uprintmax_t heap_bss_diff;
/* To run as a background daemon under Cocoa or Windows,
we must do a fork+exec, not a simple fork.
- On Cocoa, CoreFoundation lib fails in forked process:
+ On Cocoa, CoreFoundation lib fails in forked process, see Mac OS X
+ Leopard Developer Release Notes for CoreFoundation Framework:
+
http://developer.apple.com/ReleaseNotes/
- CoreFoundation/CoreFoundation.html)
+ CoreFoundation/CoreFoundation.html
+
+ Note: the above is no longer available on-line, but it can be found
+ via the "Wayback machine", https://web.archive.org.
On Windows, a Cygwin fork child cannot access the USER subsystem.
diff --git a/src/eval.c b/src/eval.c
index 09e8fdf..e9f118c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -40,10 +40,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# define CACHEABLE /* empty */
#endif
-/* Chain of condition and catch handlers currently in effect. */
-
-/* struct handler *handlerlist; */
-
/* Non-nil means record all fset's and provide's, to be undone
if the file being autoloaded is not fully loaded.
They are recorded by being consed onto the front of Vautoload_queue:
@@ -248,8 +244,6 @@ init_eval_once_for_pdumper (void)
specpdl = specpdl_ptr = pdlvec + 1;
}
-/* static struct handler handlerlist_sentinel; */
-
void
init_eval (void)
{
@@ -501,17 +495,6 @@ usage: (prog1 FIRST BODY...) */)
return val;
}
-DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
- doc: /* Eval FORM1, FORM2 and BODY sequentially; return value from
FORM2.
-The value of FORM2 is saved during the evaluation of the
-remaining args, whose values are discarded.
-usage: (prog2 FORM1 FORM2 BODY...) */)
- (Lisp_Object args)
-{
- eval_sub (XCAR (args));
- return Fprog1 (XCDR (args));
-}
-
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
doc: /* Set each SYM to the value of its VAL.
The symbols SYM are variables; they are literal (not evaluated).
@@ -4225,7 +4208,6 @@ alist of active lexical bindings. */);
defsubr (&Scond);
defsubr (&Sprogn);
defsubr (&Sprog1);
- defsubr (&Sprog2);
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
diff --git a/src/filelock.c b/src/filelock.c
index 5cec199..baf87b7 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -822,6 +822,7 @@ t if it is locked by you, else a string saying which user
has locked it. */)
USE_SAFE_ALLOCA;
filename = Fexpand_file_name (filename, Qnil);
+ filename = ENCODE_FILE (filename);
MAKE_LOCK_NAME (lfname, filename);
diff --git a/src/fingerprint-dummy.c b/src/fingerprint-dummy.c
deleted file mode 100644
index 1603519..0000000
--- a/src/fingerprint-dummy.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/* Dummy fingerprint
-
-Copyright (C) 2016, 2018-2019 Free Software Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software: you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or (at
-your option) any later version.
-
-GNU Emacs is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
-
-#include "fingerprint.h"
-
-/* Dummy fingerprint to use as hash input. */
-const uint8_t fingerprint[32] = { 0 };
diff --git a/src/fingerprint.h b/src/fingerprint.h
index 913b668..0b195fd 100644
--- a/src/fingerprint.h
+++ b/src/fingerprint.h
@@ -20,12 +20,10 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#ifndef EMACS_FINGERPRINT_H
#define EMACS_FINGERPRINT_H
-#include <stdint.h>
-
/* We generate fingerprint.c and fingerprint.o from all the sources in
Emacs. This way, we have a unique value that we can use to pair
data files (like a portable dump image) with a specific build of
Emacs. */
-extern const uint8_t fingerprint[32];
+extern unsigned char const fingerprint[32];
#endif
diff --git a/src/fns.c b/src/fns.c
index b97b132..c320249 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3904,7 +3904,7 @@ static struct Lisp_Hash_Table *
allocate_hash_table (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table,
- count, PVEC_HASH_TABLE);
+ index, PVEC_HASH_TABLE);
}
/* An upper bound on the size of a hash table index. It must fit in
diff --git a/src/fontset.c b/src/fontset.c
index 2729fae..eec1e0d 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1444,7 +1444,7 @@ or t for the default fontset.
TARGET may be a single character to use FONT-SPEC for.
-Target may be a cons (FROM . TO), where FROM and TO are characters.
+TARGET may be a cons (FROM . TO), where FROM and TO are characters.
In that case, use FONT-SPEC for all the characters in the range
between FROM and TO (inclusive).
diff --git a/src/frame.c b/src/frame.c
index d0c7714..192ef42 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -798,7 +798,8 @@ adjust_frame_size (struct frame *f, int new_width, int
new_height, int inhibit,
static struct frame *
allocate_frame (void)
{
- return ALLOCATE_ZEROED_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME);
+ return ALLOCATE_ZEROED_PSEUDOVECTOR (struct frame, tool_bar_items,
+ PVEC_FRAME);
}
struct frame *
@@ -5662,8 +5663,8 @@ selected frame. This is useful when
`make-pointer-invisible' is set. */)
#ifdef HAVE_WINDOW_SYSTEM
-# if (defined HAVE_NS \
- || (!defined USE_GTK && (defined HAVE_XINERAMA || defined HAVE_XRANDR)))
+# if (defined USE_GTK || defined HAVE_NS || defined HAVE_XINERAMA \
+ || defined HAVE_XRANDR)
void
free_monitors (struct MonitorInfo *monitors, int n_monitors)
{
diff --git a/src/frame.h b/src/frame.h
index ed62e7a..ec8f614 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -190,9 +190,6 @@ struct frame
Lisp_Object current_tool_bar_string;
#endif
- /* Desired and current tool-bar items. */
- Lisp_Object tool_bar_items;
-
#ifdef USE_GTK
/* Where tool bar is, can be left, right, top or bottom.
Except with GTK, the only supported position is `top'. */
@@ -204,7 +201,9 @@ struct frame
Lisp_Object font_data;
#endif
- /* Beyond here, there should be no more Lisp_Object components. */
+ /* Desired and current tool-bar items. */
+ Lisp_Object tool_bar_items;
+ /* tool_bar_items should be the last Lisp_Object member. */
/* Cache of realized faces. */
struct face_cache *face_cache;
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 58e95a4..b130692 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -368,7 +368,11 @@ xg_get_image_for_pixmap (struct frame *f,
GtkWidget *widget,
GtkImage *old_widget)
{
+#if defined USE_CAIRO && GTK_CHECK_VERSION (3, 10, 0)
+ cairo_surface_t *surface;
+#else
GdkPixbuf *icon_buf;
+#endif
/* If we have a file, let GTK do all the image handling.
This seems to be the only way to make insensitive and activated icons
@@ -396,6 +400,17 @@ xg_get_image_for_pixmap (struct frame *f,
on a monochrome display, and sometimes bad on all displays with
certain themes. */
+#if defined USE_CAIRO && GTK_CHECK_VERSION (3, 10, 0)
+ surface = img->cr_data;
+
+ if (surface)
+ {
+ if (! old_widget)
+ old_widget = GTK_IMAGE (gtk_image_new_from_surface (surface));
+ else
+ gtk_image_set_from_surface (old_widget, surface);
+ }
+#else
/* This is a workaround to make icons look good on pseudo color
displays. Apparently GTK expects the images to have an alpha
channel. If they don't, insensitive and activated icons will
@@ -416,6 +431,7 @@ xg_get_image_for_pixmap (struct frame *f,
g_object_unref (G_OBJECT (icon_buf));
}
+#endif
return GTK_WIDGET (old_widget);
}
@@ -1385,7 +1401,6 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool
user_position)
GdkGeometry size_hints;
gint hint_flags = 0;
int base_width, base_height;
- int min_rows = 0, min_cols = 0;
int win_gravity = f->win_gravity;
Lisp_Object fs_state, frame;
int scale = xg_get_scale (f);
@@ -1434,13 +1449,10 @@ x_wm_set_size_hint (struct frame *f, long int flags,
bool user_position)
base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 1)
+ FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f);
- if (min_cols > 0) --min_cols; /* We used one col in base_width = ... 1); */
- if (min_rows > 0) --min_rows; /* We used one row in base_height = ... 1); */
-
size_hints.base_width = base_width;
size_hints.base_height = base_height;
- size_hints.min_width = base_width + min_cols * FRAME_COLUMN_WIDTH (f);
- size_hints.min_height = base_height + min_rows * FRAME_LINE_HEIGHT (f);
+ size_hints.min_width = base_width;
+ size_hints.min_height = base_height;
/* These currently have a one to one mapping with the X values, but I
don't think we should rely on that. */
@@ -4765,9 +4777,15 @@ xg_tool_item_stale_p (GtkWidget *wbutton, const char
*stock_name,
{
gpointer gold_img = g_object_get_data (G_OBJECT (wimage),
XG_TOOL_BAR_IMAGE_DATA);
+#if defined USE_CAIRO && GTK_CHECK_VERSION (3, 10, 0)
+ void *old_img = (void *) gold_img;
+ if (old_img != img->cr_data)
+ return 1;
+#else
Pixmap old_img = (Pixmap) gold_img;
if (old_img != img->pixmap)
return 1;
+#endif
}
/* Check button configuration and label. */
@@ -5059,7 +5077,13 @@ update_frame_tool_bar (struct frame *f)
img = IMAGE_FROM_ID (f, img_id);
prepare_image_for_display (f, img);
- if (img->load_failed_p || img->pixmap == None)
+ if (img->load_failed_p
+#if defined USE_CAIRO && GTK_CHECK_VERSION (3, 10, 0)
+ || img->cr_data == NULL
+#else
+ || img->pixmap == None
+#endif
+ )
{
if (ti)
gtk_container_remove (GTK_CONTAINER (wtoolbar),
@@ -5109,7 +5133,12 @@ update_frame_tool_bar (struct frame *f)
{
w = xg_get_image_for_pixmap (f, img, x->widget, NULL);
g_object_set_data (G_OBJECT (w), XG_TOOL_BAR_IMAGE_DATA,
- (gpointer)img->pixmap);
+#if defined USE_CAIRO && GTK_CHECK_VERSION (3, 10, 0)
+ (gpointer)img->cr_data
+#else
+ (gpointer)img->pixmap
+#endif
+ );
}
#if GTK_CHECK_VERSION (3, 14, 0)
diff --git a/src/image.c b/src/image.c
index 854fbe4..6e415ef 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1157,24 +1157,22 @@ get_spec_bg_or_alpha_as_argb (struct image *img,
return bgcolor;
}
-static void
-create_cairo_image_surface (struct image *img,
- unsigned char *data,
- int width,
- int height)
+static cairo_surface_t *
+create_cairo_image_surface (int width, int height)
{
- cairo_surface_t *surface;
cairo_format_t format = CAIRO_FORMAT_ARGB32;
- int stride = cairo_format_stride_for_width (format, width);
- surface = cairo_image_surface_create_for_data (data,
- format,
- width,
- height,
- stride);
- img->width = width;
- img->height = height;
+ eassert (cairo_format_stride_for_width (format, width) == width * 4);
+
+ return cairo_image_surface_create (format, width, height);
+}
+
+static void
+set_cairo_image_surface (struct image *img, cairo_surface_t *surface)
+{
+ cairo_surface_mark_dirty (surface);
+ img->width = cairo_image_surface_get_width (surface);
+ img->height = cairo_image_surface_get_height (surface);
img->cr_data = surface;
- img->cr_data2 = data;
img->pixmap = 0;
}
#endif
@@ -1404,7 +1402,6 @@ x_clear_image (struct frame *f, struct image *img)
#ifdef USE_CAIRO
if (img->cr_data)
cairo_surface_destroy ((cairo_surface_t *)img->cr_data);
- if (img->cr_data2) xfree (img->cr_data2);
#endif
x_clear_image_1 (f, img,
CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_MASK | CLEAR_IMAGE_COLORS);
@@ -1881,7 +1878,10 @@ x_set_image_size (struct frame *f, struct image *img)
img->height = height;
# endif
-# ifdef HAVE_XRENDER
+# ifdef USE_CAIRO
+ img->width = width;
+ img->height = height;
+# elif defined HAVE_XRENDER
if (img->picture)
{
double xscale = img->width / (double) width;
@@ -3967,9 +3967,9 @@ xpm_load (struct frame *f, struct image *img)
{
int width = img->ximg->width;
int height = img->ximg->height;
- void *data = xmalloc (width * height * 4);
+ cairo_surface_t *surface = create_cairo_image_surface (width, height);
int i;
- uint32_t *od = data;
+ uint32_t *od = (uint32_t *) cairo_image_surface_get_data (surface);
uint32_t *id = (uint32_t *) img->ximg->data;
char *mid = img->mask_img ? img->mask_img->data : 0;
uint32_t bgcolor = get_spec_bg_or_alpha_as_argb (img, f);
@@ -3988,7 +3988,7 @@ xpm_load (struct frame *f, struct image *img)
}
}
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
}
else
{
@@ -5625,8 +5625,8 @@ pbm_load (struct frame *f, struct image *img)
height = pbm_scan_number (&p, end);
#ifdef USE_CAIRO
- void *data = xmalloc (width * height * 4);
- uint32_t *dataptr = data;
+ cairo_surface_t *surface = create_cairo_image_surface (width, height);
+ uint32_t *dataptr = (uint32_t *) cairo_image_surface_get_data (surface);
#endif
if (type != PBM_MONO)
@@ -5710,7 +5710,7 @@ pbm_load (struct frame *f, struct image *img)
if (p >= end)
{
#ifdef USE_CAIRO
- xfree (data);
+ cairo_surface_destroy (surface);
#else
x_destroy_x_image (ximg);
#endif
@@ -5756,7 +5756,7 @@ pbm_load (struct frame *f, struct image *img)
if (raw_p && p + expected_size > end)
{
#ifdef USE_CAIRO
- xfree (data);
+ cairo_surface_destroy (surface);
#else
x_destroy_x_image (ximg);
#endif
@@ -5790,7 +5790,7 @@ pbm_load (struct frame *f, struct image *img)
if (r < 0 || g < 0 || b < 0)
{
#ifdef USE_CAIRO
- xfree (data);
+ cairo_surface_destroy (surface);
#else
x_destroy_x_image (ximg);
#endif
@@ -5827,7 +5827,7 @@ pbm_load (struct frame *f, struct image *img)
/* Maybe fill in the background field while we have ximg handy. */
#ifdef USE_CAIRO
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
#else
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
/* Casting avoids a GCC warning. */
@@ -6173,7 +6173,7 @@ png_load_body (struct frame *f, struct image *img, struct
png_load_context *c)
ptrdiff_t nbytes;
#ifdef USE_CAIRO
- unsigned char *data = 0;
+ cairo_surface_t *surface;
uint32_t *dataptr;
#else
XImagePtr ximg, mask_img = NULL;
@@ -6388,8 +6388,8 @@ png_load_body (struct frame *f, struct image *img, struct
png_load_context *c)
}
#ifdef USE_CAIRO
- data = (unsigned char *) xmalloc (width * height * 4);
- dataptr = (uint32_t *) data;
+ surface = create_cairo_image_surface (width, height);
+ dataptr = (uint32_t *) cairo_image_surface_get_data (surface);
#else
/* Create an image and pixmap serving as mask if the PNG image
contains an alpha channel. */
@@ -6480,7 +6480,7 @@ png_load_body (struct frame *f, struct image *img, struct
png_load_context *c)
img->height = height;
#ifdef USE_CAIRO
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
#else
/* Maybe fill in the background field while we have ximg handy.
Casting avoids a GCC warning. */
@@ -7084,8 +7084,8 @@ jpeg_load_body (struct frame *f, struct image *img,
JPOOL_IMAGE, row_stride, 1);
#ifdef USE_CAIRO
{
- unsigned char *data = (unsigned char *) xmalloc (width*height*4);
- uint32_t *dataptr = (uint32_t *) data;
+ cairo_surface_t *surface = create_cairo_image_surface (width, height);
+ uint32_t *dataptr = (uint32_t *) cairo_image_surface_get_data (surface);
int r, g, b;
for (y = 0; y < height; ++y)
@@ -7102,7 +7102,7 @@ jpeg_load_body (struct frame *f, struct image *img,
}
}
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
}
#else
for (y = 0; y < height; ++y)
@@ -7564,8 +7564,8 @@ tiff_load (struct frame *f, struct image *img)
#ifdef USE_CAIRO
{
- unsigned char *data = (unsigned char *) xmalloc (width*height*4);
- uint32_t *dataptr = (uint32_t *) data;
+ cairo_surface_t *surface = create_cairo_image_surface (width, height);
+ uint32_t *dataptr = (uint32_t *) cairo_image_surface_get_data (surface);
for (y = 0; y < height; ++y)
{
@@ -7581,7 +7581,7 @@ tiff_load (struct frame *f, struct image *img)
}
}
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
}
#else
/* Initialize the color table. */
@@ -8020,9 +8020,8 @@ gif_load (struct frame *f, struct image *img)
}
#ifdef USE_CAIRO
- /* xzalloc so data is zero => transparent */
- void *data = xzalloc (width * height * 4);
- uint32_t *data32 = data;
+ cairo_surface_t *surface = create_cairo_image_surface (width, height);
+ uint32_t *data32 = (uint32_t *) cairo_image_surface_get_data (surface);
if (STRINGP (specified_bg))
{
XColor color;
@@ -8169,7 +8168,7 @@ gif_load (struct frame *f, struct image *img)
{
#ifdef USE_CAIRO
uint32_t *dataptr =
- (data32 + ((row + subimg_top) * subimg_width
+ (data32 + ((row + subimg_top) * width
+ x + subimg_left));
int r = gif_color_map->Colors[c].Red;
int g = gif_color_map->Colors[c].Green;
@@ -8181,7 +8180,7 @@ gif_load (struct frame *f, struct image *img)
XPutPixel (ximg, x + subimg_left, row + subimg_top,
pixel_colors[c]);
#endif
- }
+ }
}
}
}
@@ -8195,7 +8194,7 @@ gif_load (struct frame *f, struct image *img)
{
#ifdef USE_CAIRO
uint32_t *dataptr =
- (data32 + ((y + subimg_top) * subimg_width
+ (data32 + ((y + subimg_top) * width
+ x + subimg_left));
int r = gif_color_map->Colors[c].Red;
int g = gif_color_map->Colors[c].Green;
@@ -8265,7 +8264,7 @@ gif_load (struct frame *f, struct image *img)
}
#ifdef USE_CAIRO
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
#else
/* Maybe fill in the background field while we have ximg handy. */
if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
@@ -8693,7 +8692,7 @@ imagemagick_load_image (struct frame *f, struct image
*img,
char hint_buffer[MaxTextExtent];
char *filename_hint = NULL;
#ifdef USE_CAIRO
- void *data = NULL;
+ cairo_surface_t *surface;
#endif
/* Initialize the ImageMagick environment. */
@@ -8905,9 +8904,9 @@ imagemagick_load_image (struct frame *f, struct image
*img,
ad-hoc and needs to be more researched. */
void *dataptr;
#ifdef USE_CAIRO
- data = xmalloc (width * height * 4);
+ surface = create_cairo_image_surface (width, height);
const char *exportdepth = "BGRA";
- dataptr = data;
+ dataptr = cairo_image_surface_get_data (surface);
#else
int imagedepth = 24; /*MagickGetImageDepth(image_wand);*/
const char *exportdepth = imagedepth <= 8 ? "I" : "BGRP"; /*"RGBP";*/
@@ -8954,7 +8953,8 @@ imagemagick_load_image (struct frame *f, struct image
*img,
double quantum_range = QuantumRange;
MagickRealType color_scale = 65535.0 / quantum_range;
#ifdef USE_CAIRO
- data = xmalloc (width * height * 4);
+ surface = create_cairo_image_surface (width, height);
+ uint32_t *dataptr = (uint32_t *) cairo_image_surface_get_data (surface);
color_scale /= 256;
#else
/* Try to create a x pixmap to hold the imagemagick pixmap. */
@@ -8999,7 +8999,7 @@ imagemagick_load_image (struct frame *f, struct image
*img,
{
PixelGetMagickColor (pixels[x], &pixel);
#ifdef USE_CAIRO
- ((uint32_t *)data)[width * y + x] =
+ dataptr[width * y + x] =
lookup_rgb_color (f,
color_scale * pixel.red,
color_scale * pixel.green,
@@ -9017,7 +9017,7 @@ imagemagick_load_image (struct frame *f, struct image
*img,
}
#ifdef USE_CAIRO
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
#else
#ifdef COLOR_TABLE_SUPPORT
/* Remember colors allocated for this image. */
@@ -9480,13 +9480,13 @@ svg_load_image (struct frame *f, struct image *img,
char *contents,
{
#ifdef USE_CAIRO
- unsigned char *data = (unsigned char *) xmalloc (width*height*4);
+ cairo_surface_t *surface = create_cairo_image_surface (width, height);
+ uint32_t *dataptr = (uint32_t *) cairo_image_surface_get_data (surface);
uint32_t bgcolor = get_spec_bg_or_alpha_as_argb (img, f);
for (int y = 0; y < height; ++y)
{
const guchar *iconptr = pixels + y * rowstride;
- uint32_t *dataptr = (uint32_t *) (data + y * rowstride);
for (int x = 0; x < width; ++x)
{
@@ -9503,7 +9503,7 @@ svg_load_image (struct frame *f, struct image *img, char
*contents,
}
}
- create_cairo_image_surface (img, data, width, height);
+ set_cairo_image_surface (img, surface);
g_object_unref (pixbuf);
#else
/* Try to create a x pixmap to hold the svg pixmap. */
@@ -9921,7 +9921,7 @@ DEFUN ("image-scaling-p", Fimage_scaling_p,
Simage_scaling_p, 0, 1, 0,
Return t if FRAME supports native scaling, nil otherwise. */)
(Lisp_Object frame)
{
-#if defined (HAVE_NS) || defined (HAVE_NTGUI)
+#if defined (USE_CAIRO) || defined (HAVE_NS) || defined (HAVE_NTGUI)
return Qt;
#elif defined (HAVE_X_WINDOWS) && defined (HAVE_XRENDER)
int event_basep, error_basep;
diff --git a/src/json.c b/src/json.c
index 5e1439f..74e0534 100644
--- a/src/json.c
+++ b/src/json.c
@@ -337,8 +337,14 @@ enum json_object_type {
json_object_plist
};
+enum json_array_type {
+ json_array_array,
+ json_array_list
+};
+
struct json_configuration {
enum json_object_type object_type;
+ enum json_array_type array_type;
Lisp_Object null_object;
Lisp_Object false_object;
};
@@ -521,7 +527,7 @@ static void
json_parse_args (ptrdiff_t nargs,
Lisp_Object *args,
struct json_configuration *conf,
- bool configure_object_type)
+ bool parse_object_types)
{
if ((nargs % 2) != 0)
wrong_type_argument (Qplistp, Flist (nargs, args));
@@ -531,7 +537,7 @@ json_parse_args (ptrdiff_t nargs,
for (ptrdiff_t i = nargs; i > 0; i -= 2) {
Lisp_Object key = args[i - 2];
Lisp_Object value = args[i - 1];
- if (configure_object_type && EQ (key, QCobject_type))
+ if (parse_object_types && EQ (key, QCobject_type))
{
if (EQ (value, Qhash_table))
conf->object_type = json_object_hashtable;
@@ -542,12 +548,22 @@ json_parse_args (ptrdiff_t nargs,
else
wrong_choice (list3 (Qhash_table, Qalist, Qplist), value);
}
+ else if (parse_object_types && EQ (key, QCarray_type))
+ {
+ if (EQ (value, Qarray))
+ conf->array_type = json_array_array;
+ else if (EQ (value, Qlist))
+ conf->array_type = json_array_list;
+ else
+ wrong_choice (list2 (Qarray, Qlist), value);
+ }
else if (EQ (key, QCnull_object))
conf->null_object = value;
else if (EQ (key, QCfalse_object))
conf->false_object = value;
- else if (configure_object_type)
- wrong_choice (list3 (QCobject_type,
+ else if (parse_object_types)
+ wrong_choice (list4 (QCobject_type,
+ QCarray_type,
QCnull_object,
QCfalse_object),
value);
@@ -604,7 +620,8 @@ usage: (json-serialize OBJECT &rest ARGS) */)
}
#endif
- struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+ struct json_configuration conf =
+ {json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
json_t *json = lisp_to_json_toplevel (args[0], &conf);
@@ -701,7 +718,8 @@ usage: (json-insert OBJECT &rest ARGS) */)
}
#endif
- struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+ struct json_configuration conf =
+ {json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
json_t *json = lisp_to_json (args[0], &conf);
@@ -817,10 +835,35 @@ json_to_lisp (json_t *json, struct json_configuration
*conf)
size_t size = json_array_size (json);
if (PTRDIFF_MAX < size)
overflow_error ();
- Lisp_Object result = make_vector (size, Qunbound);
- for (ptrdiff_t i = 0; i < size; ++i)
- ASET (result, i,
- json_to_lisp (json_array_get (json, i), conf));
+ Lisp_Object result;
+ switch (conf->array_type)
+ {
+ case json_array_array:
+ {
+ result = make_vector (size, Qunbound);
+ for (ptrdiff_t i = 0; i < size; ++i)
+ {
+ rarely_quit (i);
+ ASET (result, i,
+ json_to_lisp (json_array_get (json, i), conf));
+ }
+ break;
+ }
+ case json_array_list:
+ {
+ result = Qnil;
+ for (ptrdiff_t i = size - 1; i >= 0; --i)
+ {
+ rarely_quit (i);
+ result = Fcons (json_to_lisp (json_array_get (json, i),
conf),
+ result);
+ }
+ break;
+ }
+ default:
+ /* Can't get here. */
+ emacs_abort ();
+ }
--lisp_eval_depth;
return result;
}
@@ -905,18 +948,22 @@ json_to_lisp (json_t *json, struct json_configuration
*conf)
DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
NULL,
doc: /* Parse the JSON STRING into a Lisp object.
-
This is essentially the reverse operation of `json-serialize', which
-see. The returned object will be a vector, hashtable, alist, or
+see. The returned object will be a vector, list, hashtable, alist, or
plist. Its elements will be the JSON null value, the JSON false
value, t, numbers, strings, or further vectors, hashtables, alists, or
plists. If there are duplicate keys in an object, all but the last
-one are ignored. If STRING doesn't contain a valid JSON object, an
-error of type `json-parse-error' is signaled. The arguments ARGS are
-a list of keyword/argument pairs:
+one are ignored. If STRING doesn't contain a valid JSON object, this
+function signals an error of type `json-parse-error'.
+
+The arguments ARGS are a list of keyword/argument pairs:
The keyword argument `:object-type' specifies which Lisp type is used
-to represent objects; it can be `hash-table', `alist' or `plist'.
+to represent objects; it can be `hash-table', `alist' or `plist'. It
+defaults to `hash-table'.
+
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' (the default) or `list'.
The keyword argument `:null-object' specifies which object to use
to represent a JSON null value. It defaults to `:null'.
@@ -946,7 +993,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
Lisp_Object string = args[0];
Lisp_Object encoded = json_encode (string);
check_string_without_embedded_nuls (encoded);
- struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+ struct json_configuration conf =
+ {json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, true);
json_error_t error;
@@ -993,9 +1041,32 @@ json_read_buffer_callback (void *buffer, size_t buflen,
void *data)
DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
0, MANY, NULL,
doc: /* Read JSON object from current buffer starting at point.
-This is similar to `json-parse-string', which see. Move point after
-the end of the object if parsing was successful. On error, point is
-not moved.
+Move point after the end of the object if parsing was successful.
+On error, don't move point.
+
+The returned object will be a vector, list, hashtable, alist, or
+plist. Its elements will be the JSON null value, the JSON false
+value, t, numbers, strings, or further vectors, lists, hashtables,
+alists, or plists. If there are duplicate keys in an object, all
+but the last one are ignored.
+
+If the current buffer doesn't contain a valid JSON object, the
+function signals an error of type `json-parse-error'.
+
+The arguments ARGS are a list of keyword/argument pairs:
+
+The keyword argument `:object-type' specifies which Lisp type is used
+to represent objects; it can be `hash-table', `alist' or `plist'. It
+defaults to `hash-table'.
+
+The keyword argument `:array-type' specifies which Lisp type is used
+to represent arrays; it can be `array' (the default) or `list'.
+
+The keyword argument `:null-object' specifies which object to use
+to represent a JSON null value. It defaults to `:null'.
+
+The keyword argument `:false-object' specifies which object to use to
+represent a JSON false value. It defaults to `:false'.
usage: (json-parse-buffer &rest args) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
@@ -1016,7 +1087,8 @@ usage: (json-parse-buffer &rest args) */)
}
#endif
- struct json_configuration conf = {json_object_hashtable, QCnull, QCfalse};
+ struct json_configuration conf =
+ {json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs, args, &conf, true);
ptrdiff_t point = PT_BYTE;
@@ -1095,10 +1167,12 @@ syms_of_json (void)
Fput (Qjson_parse_string, Qside_effect_free, Qt);
DEFSYM (QCobject_type, ":object-type");
+ DEFSYM (QCarray_type, ":array-type");
DEFSYM (QCnull_object, ":null-object");
DEFSYM (QCfalse_object, ":false-object");
DEFSYM (Qalist, "alist");
DEFSYM (Qplist, "plist");
+ DEFSYM (Qarray, "array");
defsubr (&Sjson_serialize);
defsubr (&Sjson_insert);
diff --git a/src/lisp.h b/src/lisp.h
index c33c311..681efc3 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -797,6 +797,13 @@ INLINE void
#define XUNTAG(a, type, ctype) ((ctype *) \
((char *) XLP (a) - LISP_WORD_TAG (type)))
+
+/* A forwarding pointer to a value. It uses a generic pointer to
+ avoid alignment bugs that could occur if it used a pointer to a
+ union of the possible values (struct Lisp_Objfwd, struct
+ Lisp_Intfwd, etc.). The pointer is packaged inside a struct to
+ help static checking. */
+typedef struct { void const *fwdptr; } lispfwd;
/* Interned state of a symbol. */
@@ -862,7 +869,7 @@ struct Lisp_Symbol
Lisp_Object value;
struct Lisp_Symbol *alias;
struct Lisp_Buffer_Local_Value *blv;
- union Lisp_Fwd *fwd;
+ lispfwd fwd;
} val;
/* Function value of the symbol or Qnil if not fboundp. */
@@ -1897,9 +1904,9 @@ memclear (void *p, ptrdiff_t nbytes)
at the end and we need to compute the number of Lisp_Object fields (the
ones that the GC needs to trace). */
-#define PSEUDOVECSIZE(type, nonlispfield) \
- (offsetof (type, nonlispfield) < header_size \
- ? 0 : (offsetof (type, nonlispfield) - header_size) / word_size)
+#define PSEUDOVECSIZE(type, lastlispfield) \
+ (offsetof (type, lastlispfield) + word_size < header_size \
+ ? 0 : (offsetof (type, lastlispfield) + word_size - header_size) /
word_size)
/* Compute A OP B, using the unsigned comparison operator OP. A and B
should be integer expressions. This is not the same as
@@ -2102,11 +2109,14 @@ enum char_table_specials
/* This is the number of slots that every char table must have. This
counts the ordinary slots and the top, defalt, parent, and purpose
slots. */
- CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras),
+ CHAR_TABLE_STANDARD_SLOTS
+ = (PSEUDOVECSIZE (struct Lisp_Char_Table, contents) - 1
+ + (1 << CHARTAB_SIZE_BITS_0)),
- /* This is an index of first Lisp_Object field in Lisp_Sub_Char_Table
+ /* This is the index of the first Lisp_Object field in Lisp_Sub_Char_Table
when the latter is treated as an ordinary Lisp_Vector. */
- SUB_CHAR_TABLE_OFFSET = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table,
contents)
+ SUB_CHAR_TABLE_OFFSET
+ = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) - 1
};
/* Sanity-check pseudovector layout. */
@@ -2171,10 +2181,10 @@ SYMBOL_BLV (struct Lisp_Symbol *sym)
eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && sym->u.s.val.blv);
return sym->u.s.val.blv;
}
-INLINE union Lisp_Fwd *
+INLINE lispfwd
SYMBOL_FWD (struct Lisp_Symbol *sym)
{
- eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd);
+ eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd.fwdptr);
return sym->u.s.val.fwd;
}
@@ -2197,10 +2207,10 @@ SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct
Lisp_Buffer_Local_Value *v)
sym->u.s.val.blv = v;
}
INLINE void
-SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
+SET_SYMBOL_FWD (struct Lisp_Symbol *sym, void const *v)
{
eassume (sym->u.s.redirect == SYMBOL_FORWARDED && v);
- sym->u.s.val.fwd = v;
+ sym->u.s.val.fwd.fwdptr = v;
}
INLINE Lisp_Object
@@ -2306,8 +2316,8 @@ struct Lisp_Hash_Table
hash table size to reduce collisions. */
Lisp_Object index;
- /* Only the fields above are traced normally by the GC. The ones below
- `count' are special and are either ignored by the GC or traced in
+ /* Only the fields above are traced normally by the GC. The ones after
+ 'index' are special and are either ignored by the GC or traced in
a special way (e.g. because of weakness). */
/* Number of key/value entries in the table. */
@@ -2727,7 +2737,7 @@ struct Lisp_Buffer_Local_Value
Presumably equivalent to (defcell!=valcell). */
bool_bf found : 1;
/* If non-NULL, a forwarding to the C var where it should also be set. */
- union Lisp_Fwd *fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
+ lispfwd fwd; /* Should never be (Buffer|Kboard)_Objfwd. */
/* The buffer for which the loaded binding was found. */
Lisp_Object where;
/* A cons cell that holds the default value. It has the form
@@ -2749,32 +2759,24 @@ struct Lisp_Kboard_Objfwd
int offset;
};
-union Lisp_Fwd
- {
- struct Lisp_Intfwd u_intfwd;
- struct Lisp_Boolfwd u_boolfwd;
- struct Lisp_Objfwd u_objfwd;
- struct Lisp_Buffer_Objfwd u_buffer_objfwd;
- struct Lisp_Kboard_Objfwd u_kboard_objfwd;
- };
-
INLINE enum Lisp_Fwd_Type
-XFWDTYPE (union Lisp_Fwd *a)
+XFWDTYPE (lispfwd a)
{
- return a->u_intfwd.type;
+ enum Lisp_Fwd_Type const *p = a.fwdptr;
+ return *p;
}
INLINE bool
-BUFFER_OBJFWDP (union Lisp_Fwd *a)
+BUFFER_OBJFWDP (lispfwd a)
{
return XFWDTYPE (a) == Lisp_Fwd_Buffer_Obj;
}
-INLINE struct Lisp_Buffer_Objfwd *
-XBUFFER_OBJFWD (union Lisp_Fwd *a)
+INLINE struct Lisp_Buffer_Objfwd const *
+XBUFFER_OBJFWD (lispfwd a)
{
eassert (BUFFER_OBJFWDP (a));
- return &a->u_buffer_objfwd;
+ return a.fwdptr;
}
/* Lisp floating point type. */
@@ -3097,11 +3099,11 @@ enum maxargs
CALLN is overkill for simple usages like 'Finsert (1, &text);'. */
#define CALLN(f, ...) CALLMANY (f, ((Lisp_Object []) {__VA_ARGS__}))
-extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *);
-extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object
*);
-extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *);
-extern void defvar_int (struct Lisp_Intfwd *, const char *, intmax_t *);
-extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
+extern void defvar_lisp (struct Lisp_Objfwd const *, char const *);
+extern void defvar_lisp_nopro (struct Lisp_Objfwd const *, char const *);
+extern void defvar_bool (struct Lisp_Boolfwd const *, char const *);
+extern void defvar_int (struct Lisp_Intfwd const *, char const *);
+extern void defvar_kboard (struct Lisp_Kboard_Objfwd const *, char const *);
/* Macros we use to define forwarded Lisp variables.
These are used in the syms_of_FILENAME functions.
@@ -3122,29 +3124,34 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *,
const char *, int);
#define DEFVAR_LISP(lname, vname, doc) \
do { \
- static struct Lisp_Objfwd o_fwd; \
- defvar_lisp (&o_fwd, lname, &globals.f_ ## vname); \
+ static struct Lisp_Objfwd const o_fwd \
+ = {Lisp_Fwd_Obj, &globals.f_##vname}; \
+ defvar_lisp (&o_fwd, lname); \
} while (false)
#define DEFVAR_LISP_NOPRO(lname, vname, doc) \
do { \
- static struct Lisp_Objfwd o_fwd; \
- defvar_lisp_nopro (&o_fwd, lname, &globals.f_ ## vname); \
+ static struct Lisp_Objfwd const o_fwd \
+ = {Lisp_Fwd_Obj, &globals.f_##vname}; \
+ defvar_lisp_nopro (&o_fwd, lname); \
} while (false)
#define DEFVAR_BOOL(lname, vname, doc) \
do { \
- static struct Lisp_Boolfwd b_fwd; \
- defvar_bool (&b_fwd, lname, &globals.f_ ## vname); \
+ static struct Lisp_Boolfwd const b_fwd \
+ = {Lisp_Fwd_Bool, &globals.f_##vname}; \
+ defvar_bool (&b_fwd, lname); \
} while (false)
#define DEFVAR_INT(lname, vname, doc) \
do { \
- static struct Lisp_Intfwd i_fwd; \
- defvar_int (&i_fwd, lname, &globals.f_ ## vname); \
+ static struct Lisp_Intfwd const i_fwd \
+ = {Lisp_Fwd_Int, &globals.f_##vname}; \
+ defvar_int (&i_fwd, lname); \
} while (false)
#define DEFVAR_KBOARD(lname, vname, doc) \
do { \
- static struct Lisp_Kboard_Objfwd ko_fwd; \
- defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
+ static struct Lisp_Kboard_Objfwd const ko_fwd \
+ = {Lisp_Fwd_Kboard_Obj, offsetof (KBOARD, vname##_)}; \
+ defvar_kboard (&ko_fwd, lname); \
} while (false)
@@ -3233,11 +3240,6 @@ union specbinding
} bt;
};
-/* These 3 are defined as macros in thread.h. */
-/* extern union specbinding *specpdl; */
-/* extern union specbinding *specpdl_ptr; */
-/* extern ptrdiff_t specpdl_size; */
-
INLINE ptrdiff_t
SPECPDL_INDEX (void)
{
@@ -3557,7 +3559,7 @@ extern _Noreturn void args_out_of_range (Lisp_Object,
Lisp_Object);
extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
Lisp_Object);
extern _Noreturn void circular_list (Lisp_Object);
-extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
+extern Lisp_Object do_symval_forwarding (lispfwd);
enum Set_Internal_Bind {
SET_INTERNAL_SET,
SET_INTERNAL_BIND,
@@ -3941,6 +3943,11 @@ make_nil_vector (ptrdiff_t size)
extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
enum pvec_type);
+/* Allocate uninitialized pseudovector with no Lisp_Object slots. */
+
+#define ALLOCATE_PLAIN_PSEUDOVECTOR(type, tag) \
+ ((type *) allocate_pseudovector (VECSIZE (type), 0, 0, tag))
+
/* Allocate partially initialized pseudovector where all Lisp_Object
slots are set to Qnil but the rest (if any) is left uninitialized. */
@@ -4218,7 +4225,6 @@ extern void syms_of_module (void);
#endif
/* Defined in thread.c. */
-extern struct thread_state primary_thread;
extern void mark_threads (void);
extern void unmark_main_thread (void);
diff --git a/src/lread.c b/src/lread.c
index 2d64b63..5f33fcd 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4425,31 +4425,22 @@ defalias (struct Lisp_Subr *sname, char *string)
C variable of type intmax_t. Sample call (with "xx" to fool make-docfile):
DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */
void
-defvar_int (struct Lisp_Intfwd *i_fwd,
- const char *namestring, intmax_t *address)
+defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring)
{
- Lisp_Object sym;
- sym = intern_c_string (namestring);
- i_fwd->type = Lisp_Fwd_Int;
- i_fwd->intvar = address;
+ Lisp_Object sym = intern_c_string (namestring);
XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
+ SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd);
}
-/* Similar but define a variable whose value is t if address contains 1,
- nil if address contains 0. */
+/* Similar but define a variable whose value is t if 1, nil if 0. */
void
-defvar_bool (struct Lisp_Boolfwd *b_fwd,
- const char *namestring, bool *address)
+defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring)
{
- Lisp_Object sym;
- sym = intern_c_string (namestring);
- b_fwd->type = Lisp_Fwd_Bool;
- b_fwd->boolvar = address;
+ Lisp_Object sym = intern_c_string (namestring);
XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
+ SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
}
@@ -4459,40 +4450,31 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd,
gc-marked for some other reason, since marking the same slot twice
can cause trouble with strings. */
void
-defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
- const char *namestring, Lisp_Object *address)
+defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring)
{
- Lisp_Object sym;
- sym = intern_c_string (namestring);
- o_fwd->type = Lisp_Fwd_Obj;
- o_fwd->objvar = address;
+ Lisp_Object sym = intern_c_string (namestring);
XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
+ SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd);
}
void
-defvar_lisp (struct Lisp_Objfwd *o_fwd,
- const char *namestring, Lisp_Object *address)
+defvar_lisp (struct Lisp_Objfwd const *o_fwd, char const *namestring)
{
- defvar_lisp_nopro (o_fwd, namestring, address);
- staticpro (address);
+ defvar_lisp_nopro (o_fwd, namestring);
+ staticpro (o_fwd->objvar);
}
/* Similar but define a variable whose value is the Lisp Object stored
at a particular offset in the current kboard object. */
void
-defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
- const char *namestring, int offset)
+defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring)
{
- Lisp_Object sym;
- sym = intern_c_string (namestring);
- ko_fwd->type = Lisp_Fwd_Kboard_Obj;
- ko_fwd->offset = offset;
+ Lisp_Object sym = intern_c_string (namestring);
XSYMBOL (sym)->u.s.declared_special = true;
XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
- SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
+ SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd);
}
/* Check that the elements of lpath exist. */
diff --git a/src/minibuf.c b/src/minibuf.c
index a0025e2..10fd5e5 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -995,7 +995,8 @@ the current input method and the setting
of`enable-multibyte-characters'. */)
DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
doc: /* Read the name of a command and return as a symbol.
Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
-if it is a list. */)
+if it is a list. If DEFAULT-VALUE is omitted or nil, and the user enters
+null input, return a symbol whose name is an empty string. */)
(Lisp_Object prompt, Lisp_Object default_value)
{
Lisp_Object name, default_string;
diff --git a/src/pdumper.c b/src/pdumper.c
index f459d97..600c5b3 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -46,7 +46,9 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "thread.h"
#include "bignum.h"
-#include "dmpstruct.h"
+#ifdef CHECK_STRUCTS
+# include "dmpstruct.h"
+#endif
/*
TODO:
@@ -68,16 +70,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef HAVE_PDUMPER
-/* CHECK_STRUCTS being true makes the build break if we notice
- changes to the source defining certain Lisp structures we dump. If
- you change one of these structures, check that the pdumper code is
- still valid, and update the pertinent hash lower down in this file
- (pdumper.c) by manually copying the value from the dmpstruct.h
- generated from your new code. */
-#ifndef CHECK_STRUCTS
-# define CHECK_STRUCTS 1
-#endif
-
#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7)
# pragma GCC diagnostic error "-Wconversion"
# pragma GCC diagnostic error "-Wshadow"
@@ -135,8 +127,6 @@ verify (sizeof (intptr_t) == sizeof (ptrdiff_t));
verify (sizeof (void (*)(void)) == sizeof (void *));
verify (sizeof (ptrdiff_t) <= sizeof (Lisp_Object));
verify (sizeof (ptrdiff_t) <= sizeof (EMACS_INT));
-verify (sizeof (off_t) == sizeof (int32_t)
- || sizeof (off_t) == sizeof (int64_t));
verify (CHAR_BIT == 8);
#define DIVIDE_ROUND_UP(x, y) (((x) + (y) - 1) / (y))
@@ -157,9 +147,9 @@ static struct
} remembered_data[32];
static int nr_remembered_data = 0;
-typedef int32_t dump_off;
-#define DUMP_OFF_MIN INT32_MIN
-#define DUMP_OFF_MAX INT32_MAX
+typedef int_least32_t dump_off;
+#define DUMP_OFF_MIN INT_LEAST32_MIN
+#define DUMP_OFF_MAX INT_LEAST32_MAX
__attribute__((format (printf,1,2)))
static void
@@ -302,10 +292,10 @@ verify (DUMP_ALIGNMENT >= GCALIGNMENT);
struct dump_reloc
{
- uint32_t raw_offset : DUMP_RELOC_OFFSET_BITS;
+ unsigned int raw_offset : DUMP_RELOC_OFFSET_BITS;
ENUM_BF (dump_reloc_type) type : DUMP_RELOC_TYPE_BITS;
};
-verify (sizeof (struct dump_reloc) == sizeof (int32_t));
+verify (sizeof (struct dump_reloc) == sizeof (dump_off));
/* Set the type of a dump relocation.
@@ -335,7 +325,7 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off
offset)
}
static void
-dump_fingerprint (const char *label, const uint8_t *xfingerprint)
+dump_fingerprint (const char *label, unsigned char const *xfingerprint)
{
fprintf (stderr, "%s: ", label);
for (int i = 0; i < 32; ++i)
@@ -366,7 +356,7 @@ struct dump_header
char magic[sizeof (dump_magic)];
/* Associated Emacs binary. */
- uint8_t fingerprint[32];
+ unsigned char fingerprint[32];
/* Relocation table for the dump file; each entry is a
struct dump_reloc. */
@@ -495,6 +485,7 @@ struct dump_context
Lisp_Object old_purify_flag;
Lisp_Object old_post_gc_hook;
+ Lisp_Object old_process_environment;
#ifdef REL_ALLOC
bool blocked_ralloc;
@@ -1776,6 +1767,8 @@ dump_roots (struct dump_context *ctx)
visit_static_gc_roots (visitor);
}
+#define PDUMPER_MAX_OBJECT_SIZE 2048
+
static dump_off
field_relpos (const void *in_start, const void *in_field)
{
@@ -1783,7 +1776,15 @@ field_relpos (const void *in_start, const void *in_field)
ptrdiff_t in_field_val = (ptrdiff_t) in_field;
eassert (in_start_val <= in_field_val);
ptrdiff_t relpos = in_field_val - in_start_val;
- eassert (relpos < 1024); /* Sanity check. */
+ /* The following assertion attempts to detect bugs whereby IN_START
+ and IN_FIELD don't point to the same object/structure, on the
+ assumption that a too-large difference between them is
+ suspicious. As of Apr 2019 the largest object we dump -- 'struct
+ buffer' -- is slightly smaller than 1KB, and we want to leave
+ some margin for future extensions. If the assertion below is
+ ever violated, make sure the two pointers indeed point into the
+ same object, and if so, enlarge the value of PDUMPER_MAX_OBJECT_SIZE. */
+ eassert (relpos < PDUMPER_MAX_OBJECT_SIZE);
return (dump_off) relpos;
}
@@ -2334,32 +2335,30 @@ dump_fwd_kboard_obj (struct dump_context *ctx,
}
static dump_off
-dump_fwd (struct dump_context *ctx, union Lisp_Fwd *fwd)
+dump_fwd (struct dump_context *ctx, lispfwd fwd)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_5227B18E87)
-# error "Lisp_Fwd changed. See CHECK_STRUCTS comment."
-#endif
#if CHECK_STRUCTS && !defined (HASH_Lisp_Fwd_Type_9CBA6EE55E)
# error "Lisp_Fwd_Type changed. See CHECK_STRUCTS comment."
#endif
+ void const *p = fwd.fwdptr;
dump_off offset;
switch (XFWDTYPE (fwd))
{
case Lisp_Fwd_Int:
- offset = dump_fwd_int (ctx, &fwd->u_intfwd);
+ offset = dump_fwd_int (ctx, p);
break;
case Lisp_Fwd_Bool:
- offset = dump_fwd_bool (ctx, &fwd->u_boolfwd);
+ offset = dump_fwd_bool (ctx, p);
break;
case Lisp_Fwd_Obj:
- offset = dump_fwd_obj (ctx, &fwd->u_objfwd);
+ offset = dump_fwd_obj (ctx, p);
break;
case Lisp_Fwd_Buffer_Obj:
- offset = dump_fwd_buffer_obj (ctx, &fwd->u_buffer_objfwd);
+ offset = dump_fwd_buffer_obj (ctx, p);
break;
case Lisp_Fwd_Kboard_Obj:
- offset = dump_fwd_kboard_obj (ctx, &fwd->u_kboard_objfwd);
+ offset = dump_fwd_kboard_obj (ctx, p);
break;
default:
emacs_abort ();
@@ -2372,20 +2371,20 @@ static dump_off
dump_blv (struct dump_context *ctx,
const struct Lisp_Buffer_Local_Value *blv)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Buffer_Local_Value_066F33A92E)
+#if CHECK_STRUCTS && !defined HASH_Lisp_Buffer_Local_Value_3C363FAC3C
# error "Lisp_Buffer_Local_Value changed. See CHECK_STRUCTS comment."
#endif
struct Lisp_Buffer_Local_Value out;
dump_object_start (ctx, &out, sizeof (out));
DUMP_FIELD_COPY (&out, blv, local_if_set);
DUMP_FIELD_COPY (&out, blv, found);
- if (blv->fwd)
- dump_field_fixup_later (ctx, &out, blv, &blv->fwd);
+ if (blv->fwd.fwdptr)
+ dump_field_fixup_later (ctx, &out, blv, &blv->fwd.fwdptr);
dump_field_lv (ctx, &out, blv, &blv->where, WEIGHT_NORMAL);
dump_field_lv (ctx, &out, blv, &blv->defcell, WEIGHT_STRONG);
dump_field_lv (ctx, &out, blv, &blv->valcell, WEIGHT_STRONG);
dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
- if (blv->fwd)
+ if (blv->fwd.fwdptr)
dump_remember_fixup_ptr_raw
(ctx,
offset + dump_offsetof (struct Lisp_Buffer_Local_Value, fwd),
@@ -2437,7 +2436,7 @@ dump_symbol (struct dump_context *ctx,
Lisp_Object object,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Symbol_60EA1E748E)
+#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC
# error "Lisp_Symbol changed. See CHECK_STRUCTS comment."
#endif
#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113)
@@ -2693,7 +2692,7 @@ dump_hash_table (struct dump_context *ctx,
Lisp_Object object,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Hash_Table_73C9BFB7D1)
+#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_EF95ED06FF
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment."
#endif
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
@@ -2761,7 +2760,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_AE2C8CE357
+#if CHECK_STRUCTS && !defined HASH_buffer_E34A11C6B9
# error "buffer changed. See CHECK_STRUCTS comment."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2873,6 +2872,7 @@ dump_buffer (struct dump_context *ctx, const struct
buffer *in_buffer)
DUMP_FIELD_COPY (out, buffer, prevent_redisplay_optimizations_p);
DUMP_FIELD_COPY (out, buffer, clip_changed);
+ DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks);
dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_before,
Lisp_Vectorlike, WEIGHT_NORMAL);
@@ -3594,6 +3594,8 @@ dump_unwind_cleanup (void *data)
r_alloc_inhibit_buffer_relocation (0);
#endif
Vpurify_flag = ctx->old_purify_flag;
+ Vpost_gc_hook = ctx->old_post_gc_hook;
+ Vprocess_environment = ctx->old_process_environment;
}
/* Return DUMP_OFFSET, making sure it is within the heap. */
@@ -4025,12 +4027,6 @@ types. */)
Lisp_Object symbol = intern ("command-line-processed");
specbind (symbol, Qnil);
- /* Reset process-environment -- this is for when they re-dump a
- pdump-restored emacs, since set_initial_environment wants always
- to cons it from scratch. */
- Vprocess_environment = Qnil;
- garbage_collect ();
-
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
filename = ENCODE_FILE (filename);
@@ -4092,6 +4088,12 @@ types. */)
ctx->old_post_gc_hook = Vpost_gc_hook;
Vpost_gc_hook = Qnil;
+ /* Reset process-environment -- this is for when they re-dump a
+ pdump-restored emacs, since set_initial_environment wants always
+ to cons it from scratch. */
+ ctx->old_process_environment = Vprocess_environment;
+ Vprocess_environment = Qnil;
+
ctx->fd = emacs_open (SSDATA (filename),
O_RDWR | O_TRUNC | O_CREAT, 0666);
if (ctx->fd < 0)
@@ -4307,17 +4309,12 @@ enum dump_memory_protection
DUMP_MEMORY_ACCESS_READWRITE = 3,
};
+#if VM_SUPPORTED == VM_MS_WINDOWS
static void *
dump_anonymous_allocate_w32 (void *base,
size_t size,
enum dump_memory_protection protection)
{
-#if VM_SUPPORTED != VM_MS_WINDOWS
- (void) base;
- (void) size;
- (void) protection;
- emacs_abort ();
-#else
void *ret;
DWORD mem_type;
DWORD mem_prot;
@@ -4346,26 +4343,22 @@ dump_anonymous_allocate_w32 (void *base,
? EBUSY
: EPERM;
return ret;
-#endif
}
+#endif
+
+#if VM_SUPPORTED == VM_POSIX
/* Old versions of macOS only define MAP_ANON, not MAP_ANONYMOUS.
FIXME: This probably belongs elsewhere (gnulib/autoconf?) */
-#ifndef MAP_ANONYMOUS
-#define MAP_ANONYMOUS MAP_ANON
-#endif
+# ifndef MAP_ANONYMOUS
+# define MAP_ANONYMOUS MAP_ANON
+# endif
static void *
dump_anonymous_allocate_posix (void *base,
size_t size,
enum dump_memory_protection protection)
{
-#if VM_SUPPORTED != VM_POSIX
- (void) base;
- (void) size;
- (void) protection;
- emacs_abort ();
-#else
void *ret;
int mem_prot;
@@ -4410,8 +4403,8 @@ dump_anonymous_allocate_posix (void *base,
if (ret == MAP_FAILED)
ret = NULL;
return ret;
-#endif
}
+#endif
/* Perform anonymous memory allocation. */
static void *
@@ -4419,14 +4412,14 @@ dump_anonymous_allocate (void *base,
const size_t size,
enum dump_memory_protection protection)
{
- void *ret = NULL;
- if (VM_SUPPORTED == VM_MS_WINDOWS)
- ret = dump_anonymous_allocate_w32 (base, size, protection);
- else if (VM_SUPPORTED == VM_POSIX)
- ret = dump_anonymous_allocate_posix (base, size, protection);
- else
- errno = ENOSYS;
- return ret;
+#if VM_SUPPORTED == VM_POSIX
+ return dump_anonymous_allocate_posix (base, size, protection);
+#elif VM_SUPPORTED == VM_MS_WINDOWS
+ return dump_anonymous_allocate_w32 (base, size, protection);
+#else
+ errno = ENOSYS;
+ return NULL;
+#endif
}
/* Undo the effect of dump_reserve_address_space(). */
@@ -4448,18 +4441,11 @@ dump_anonymous_release (void *addr, size_t size)
#endif
}
+#if VM_SUPPORTED == VM_MS_WINDOWS
static void *
dump_map_file_w32 (void *base, int fd, off_t offset, size_t size,
enum dump_memory_protection protection)
{
-#if VM_SUPPORTED != VM_MS_WINDOWS
- (void) base;
- (void) fd;
- (void) offset;
- (void) size;
- (void) protection;
- emacs_abort ();
-#else
void *ret = NULL;
HANDLE section = NULL;
HANDLE file;
@@ -4514,21 +4500,14 @@ dump_map_file_w32 (void *base, int fd, off_t offset,
size_t size,
if (section && !CloseHandle (section))
emacs_abort ();
return ret;
-#endif
}
+#endif
+#if VM_SUPPORTED == VM_POSIX
static void *
dump_map_file_posix (void *base, int fd, off_t offset, size_t size,
enum dump_memory_protection protection)
{
-#if VM_SUPPORTED != VM_POSIX
- (void) base;
- (void) fd;
- (void) offset;
- (void) size;
- (void) protection;
- emacs_abort ();
-#else
void *ret;
int mem_prot;
int mem_flags;
@@ -4558,22 +4537,22 @@ dump_map_file_posix (void *base, int fd, off_t offset,
size_t size,
if (ret == MAP_FAILED)
ret = NULL;
return ret;
-#endif
}
+#endif
/* Map a file into memory. */
static void *
dump_map_file (void *base, int fd, off_t offset, size_t size,
enum dump_memory_protection protection)
{
- void *ret = NULL;
- if (VM_SUPPORTED == VM_MS_WINDOWS)
- ret = dump_map_file_w32 (base, fd, offset, size, protection);
- else if (VM_SUPPORTED == VM_POSIX)
- ret = dump_map_file_posix (base, fd, offset, size, protection);
- else
- errno = ENOSYS;
+#if VM_SUPPORTED == VM_POSIX
+ return dump_map_file_posix (base, fd, offset, size, protection);
+#elif VM_SUPPORTED == VM_MS_WINDOWS
+ return dump_map_file_w32 (base, fd, offset, size, protection);
+#else
+ errno = ENOSYS;
return ret;
+#endif
}
/* Remove a virtual memory mapping.
@@ -4623,7 +4602,8 @@ dump_discard_mem (void *mem, size_t size)
/* Discard COWed pages. */
(void) VirtualFree (mem, size, MEM_DECOMMIT);
/* Release the commit charge for the mapping. */
- (void) VirtualProtect (mem, size, PAGE_NOACCESS, NULL);
+ DWORD old_prot;
+ (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot);
#elif VM_SUPPORTED == VM_POSIX
# ifdef HAVE_POSIX_MADVISE
/* Discard COWed pages. */
diff --git a/src/process.c b/src/process.c
index 802ac02..6770a5e 100644
--- a/src/process.c
+++ b/src/process.c
@@ -858,7 +858,8 @@ allocate_pty (char pty_name[PTY_NAME_SIZE])
static struct Lisp_Process *
allocate_process (void)
{
- return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
+ return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, thread,
+ PVEC_PROCESS);
}
static Lisp_Object
diff --git a/src/process.h b/src/process.h
index d66aa06..5e957c4 100644
--- a/src/process.h
+++ b/src/process.h
@@ -117,9 +117,7 @@ struct Lisp_Process
/* The thread a process is linked to, or nil for any thread. */
Lisp_Object thread;
-
- /* After this point, there are no Lisp_Objects any more. */
- /* alloc.c assumes that `pid' is the first such non-Lisp slot. */
+ /* After this point, there are no Lisp_Objects. */
/* Process ID. A positive value is a child process ID.
Zero is for pseudo-processes such as network or serial connections,
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 45b4f81..8dc6980 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -151,8 +151,6 @@
#define ISWORD(c) (SYNTAX (c) == Sword)
-#define SIGN_EXTEND_CHAR(c) ((signed char) (c))
-
/* Use alloca instead of malloc. This is because using malloc in
re_search* or re_match* could cause memory leaks when C-g is used
in Emacs (note that SAFE_ALLOCA could also call malloc, but does so
@@ -182,10 +180,6 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA;
#define FIRST_STRING_P(ptr) \
(size1 && string1 <= (ptr) && (ptr) <= string1 + size1)
-/* (Re)Allocate N items of type T using malloc, or fail. */
-#define TALLOC(n, t) ((t *) xmalloc ((n) * sizeof (t)))
-#define RETALLOC(addr, n, t) ((addr) = (t *) xrealloc (addr, (n) * sizeof (t)))
-
#define BYTEWIDTH 8 /* In bits. */
/* Type of source-pattern and string chars. */
@@ -193,8 +187,8 @@ typedef const unsigned char re_char;
static void re_compile_fastmap (struct re_pattern_buffer *);
static ptrdiff_t re_match_2_internal (struct re_pattern_buffer *bufp,
- re_char *string1, size_t size1,
- re_char *string2, size_t size2,
+ re_char *string1, ptrdiff_t size1,
+ re_char *string2, ptrdiff_t size2,
ptrdiff_t pos,
struct re_registers *regs,
ptrdiff_t stop);
@@ -368,8 +362,8 @@ typedef enum
static int
extract_number (re_char *source)
{
- unsigned leading_byte = SIGN_EXTEND_CHAR (source[1]);
- return (leading_byte << 8) + source[0];
+ signed char leading_byte = source[1];
+ return leading_byte * 256 + source[0];
}
/* Same as EXTRACT_NUMBER, except increment SOURCE to after the number.
@@ -416,7 +410,7 @@ extract_number_and_incr (re_char **source)
#define CHARSET_BITMAP_SIZE(p) ((p)[1] & 0x7F)
/* Nonzero if charset P has range table. */
-#define CHARSET_RANGE_TABLE_EXISTS_P(p) ((p)[1] & 0x80)
+#define CHARSET_RANGE_TABLE_EXISTS_P(p) (((p)[1] & 0x80) != 0)
/* Return the address of range table of charset P. But not the start
of table itself, but the before where the number of ranges is
@@ -460,18 +454,18 @@ static int regex_emacs_debug = -100000;
static void
print_fastmap (char *fastmap)
{
- unsigned was_a_range = 0;
- unsigned i = 0;
+ bool was_a_range = false;
+ int i = 0;
while (i < (1 << BYTEWIDTH))
{
if (fastmap[i++])
{
- was_a_range = 0;
+ was_a_range = false;
putchar (i - 1);
while (i < (1 << BYTEWIDTH) && fastmap[i])
{
- was_a_range = 1;
+ was_a_range = true;
i++;
}
if (was_a_range)
@@ -545,10 +539,10 @@ print_partial_compiled_pattern (re_char *start, re_char
*end)
case charset:
case charset_not:
{
- register int c, last = -100;
- register int in_range = 0;
+ int c, last = -100;
+ bool in_range = false;
int length = CHARSET_BITMAP_SIZE (p - 1);
- int has_range_table = CHARSET_RANGE_TABLE_EXISTS_P (p - 1);
+ bool has_range_table = CHARSET_RANGE_TABLE_EXISTS_P (p - 1);
fprintf (stderr, "/charset [%s",
(re_opcode_t) *(p - 1) == charset_not ? "^" : "");
@@ -564,13 +558,13 @@ print_partial_compiled_pattern (re_char *start, re_char
*end)
if (last + 1 == c && ! in_range)
{
fprintf (stderr, "-");
- in_range = 1;
+ in_range = true;
}
/* Have we broken a range? */
else if (last + 1 != c && in_range)
{
fprintf (stderr, "%c", last);
- in_range = 0;
+ in_range = false;
}
if (! in_range)
@@ -739,7 +733,7 @@ print_compiled_pattern (struct re_pattern_buffer *bufp)
re_char *buffer = bufp->buffer;
print_partial_compiled_pattern (buffer, buffer + bufp->used);
- printf ("%zu bytes used/%zu bytes allocated.\n",
+ printf ("%tu bytes used/%tu bytes allocated.\n",
bufp->used, bufp->allocated);
if (bufp->fastmap_accurate && bufp->fastmap)
@@ -748,7 +742,7 @@ print_compiled_pattern (struct re_pattern_buffer *bufp)
print_fastmap (bufp->fastmap);
}
- printf ("re_nsub: %zu\t", bufp->re_nsub);
+ printf ("re_nsub: %tu\t", bufp->re_nsub);
printf ("regs_alloc: %d\t", bufp->regs_allocated);
printf ("can_be_null: %d\t", bufp->can_be_null);
fflush (stdout);
@@ -757,25 +751,20 @@ print_compiled_pattern (struct re_pattern_buffer *bufp)
static void
-print_double_string (re_char *where, re_char *string1, ssize_t size1,
- re_char *string2, ssize_t size2)
+print_double_string (re_char *where, re_char *string1, ptrdiff_t size1,
+ re_char *string2, ptrdiff_t size2)
{
- ssize_t this_char;
-
if (where == NULL)
printf ("(null)");
else
{
if (FIRST_STRING_P (where))
{
- for (this_char = where - string1; this_char < size1; this_char++)
- putchar (string1[this_char]);
-
+ fwrite_unlocked (where, 1, string1 + size1 - where, stdout);
where = string2;
}
- for (this_char = where - string2; this_char < size2; this_char++)
- putchar (string2[this_char]);
+ fwrite_unlocked (where, 1, string2 + size2 - where, stdout);
}
}
@@ -872,13 +861,12 @@ enum { RE_NREGS = 30 };
whose default stack limit is 2mb. In order for a larger
value to work reliably, you have to try to make it accord
with the process stack limit. */
-size_t emacs_re_max_failures = 40000;
+ptrdiff_t emacs_re_max_failures = 40000;
union fail_stack_elt
{
re_char *pointer;
- /* This should be the biggest 'int' that's no bigger than a pointer. */
- long integer;
+ intptr_t integer;
};
typedef union fail_stack_elt fail_stack_elt_t;
@@ -886,9 +874,9 @@ typedef union fail_stack_elt fail_stack_elt_t;
typedef struct
{
fail_stack_elt_t *stack;
- size_t size;
- size_t avail; /* Offset of next open position. */
- size_t frame; /* Offset of the cur constructed frame. */
+ ptrdiff_t size;
+ ptrdiff_t avail; /* Offset of next open position. */
+ ptrdiff_t frame; /* Offset of the cur constructed frame. */
} fail_stack_type;
#define FAIL_STACK_EMPTY() (fail_stack.frame == 0)
@@ -967,17 +955,17 @@ typedef struct
while (REMAINING_AVAIL_SLOTS <= space) { \
if (!GROW_FAIL_STACK (fail_stack)) \
return -2; \
- DEBUG_PRINT ("\n Doubled stack; size now: %zu\n", (fail_stack).size);\
- DEBUG_PRINT (" slots available: %zu\n", REMAINING_AVAIL_SLOTS);\
+ DEBUG_PRINT ("\n Doubled stack; size now: %tu\n", fail_stack.size); \
+ DEBUG_PRINT (" slots available: %tu\n", REMAINING_AVAIL_SLOTS);\
}
/* Push register NUM onto the stack. */
#define PUSH_FAILURE_REG(num) \
do { \
char *destination; \
- long n = num;
\
+ intptr_t n = num; \
ENSURE_FAIL_STACK(3);
\
- DEBUG_PRINT (" Push reg %ld (spanning %p -> %p)\n", \
+ DEBUG_PRINT (" Push reg %"PRIdPTR" (spanning %p -> %p)\n",
\
n, regstart[n], regend[n]); \
PUSH_FAILURE_POINTER (regstart[n]); \
PUSH_FAILURE_POINTER (regend[n]); \
@@ -1002,7 +990,7 @@ do {
\
/* Pop a saved register off the stack. */
#define POP_FAILURE_REG_OR_COUNT() \
do { \
- long pfreg = POP_FAILURE_INT (); \
+ intptr_t pfreg = POP_FAILURE_INT (); \
if (pfreg == -1) \
{ \
/* It's a counter. */ \
@@ -1010,7 +998,7 @@ do {
\
unsigned char *ptr = (unsigned char *) POP_FAILURE_POINTER (); \
pfreg = POP_FAILURE_INT (); \
STORE_NUMBER (ptr, pfreg); \
- DEBUG_PRINT (" Pop counter %p = %ld\n", ptr, pfreg); \
+ DEBUG_PRINT (" Pop counter %p = %"PRIdPTR"\n", ptr, pfreg); \
} \
else \
{ \
@@ -1034,7 +1022,7 @@ do {
\
&& FAILURE_PAT (failure) <= bufp->buffer + bufp->used); \
if (FAILURE_PAT (failure) == pat_cur) \
{ \
- cycle = 1; \
+ cycle = true; \
break; \
} \
DEBUG_PRINT (" Other pattern: %p\n", FAILURE_PAT (failure)); \
@@ -1057,14 +1045,14 @@ do {
\
char *destination; \
DEBUG_STATEMENT (nfailure_points_pushed++); \
DEBUG_PRINT ("\nPUSH_FAILURE_POINT:\n"); \
- DEBUG_PRINT (" Before push, next avail: %zu\n", (fail_stack).avail);
\
- DEBUG_PRINT (" size: %zu\n", (fail_stack).size);\
+ DEBUG_PRINT (" Before push, next avail: %tu\n", fail_stack.avail); \
+ DEBUG_PRINT (" size: %tu\n", fail_stack.size); \
\
ENSURE_FAIL_STACK (NUM_NONREG_ITEMS);
\
\
DEBUG_PRINT ("\n"); \
\
- DEBUG_PRINT (" Push frame index: %zu\n", fail_stack.frame); \
+ DEBUG_PRINT (" Push frame index: %tu\n", fail_stack.frame); \
PUSH_FAILURE_INT (fail_stack.frame); \
\
DEBUG_PRINT (" Push string %p: \"", string_place); \
@@ -1106,8 +1094,8 @@ do {
\
\
/* Remove failure points and point to how many regs pushed. */ \
DEBUG_PRINT ("POP_FAILURE_POINT:\n");
\
- DEBUG_PRINT (" Before pop, next avail: %zu\n", fail_stack.avail); \
- DEBUG_PRINT (" size: %zu\n", fail_stack.size); \
+ DEBUG_PRINT (" Before pop, next avail: %tu\n", fail_stack.avail); \
+ DEBUG_PRINT (" size: %tu\n", fail_stack.size); \
\
/* Pop the saved registers. */ \
while (fail_stack.frame < fail_stack.avail) \
@@ -1141,7 +1129,7 @@ do {
\
/* Subroutine declarations and macros for regex_compile. */
-static reg_errcode_t regex_compile (re_char *pattern, size_t size,
+static reg_errcode_t regex_compile (re_char *pattern, ptrdiff_t size,
bool posix_backtracking,
const char *whitespace_regexp,
struct re_pattern_buffer *bufp);
@@ -1155,7 +1143,7 @@ static bool at_begline_loc_p (re_char *pattern, re_char
*p);
static bool at_endline_loc_p (re_char *p, re_char *pend);
static re_char *skip_one_char (re_char *p);
static int analyze_first (re_char *p, re_char *pend,
- char *fastmap, const int multibyte);
+ char *fastmap, bool multibyte);
/* Fetch the next character in the uncompiled pattern, with no
translation. */
@@ -1178,8 +1166,8 @@ static int analyze_first (re_char *p, re_char *pend,
/* Ensure at least N more bytes of space in buffer. */
#define GET_BUFFER_SPACE(n) \
- while ((size_t) (b - bufp->buffer + (n)) > bufp->allocated)
\
- EXTEND_BUFFER ()
+ if (bufp->buffer + bufp->allocated - b < (n)) \
+ EXTEND_BUFFER ((n) - (bufp->buffer + bufp->allocated - b))
/* Ensure one more byte of buffer space and then add C to it. */
#define BUF_PUSH(c) \
@@ -1221,18 +1209,16 @@ static int analyze_first (re_char *p, re_char *pend,
be too small, many things would have to change. */
# define MAX_BUF_SIZE (1 << 15)
-/* Extend the buffer by twice its current size via realloc and
+/* Extend the buffer by at least N bytes via realloc and
reset the pointers that pointed into the old block to point to the
correct places in the new one. If extending the buffer results in it
being larger than MAX_BUF_SIZE, then flag memory exhausted. */
-#define EXTEND_BUFFER()
\
+#define EXTEND_BUFFER(n) \
do { \
+ ptrdiff_t requested_extension = n; \
unsigned char *old_buffer = bufp->buffer; \
- if (bufp->allocated == MAX_BUF_SIZE) \
+ if (MAX_BUF_SIZE - bufp->allocated < requested_extension) \
return REG_ESIZE;
\
- bufp->allocated <<= 1; \
- if (bufp->allocated > MAX_BUF_SIZE)
\
- bufp->allocated = MAX_BUF_SIZE; \
ptrdiff_t b_off = b - old_buffer; \
ptrdiff_t begalt_off = begalt - old_buffer;
\
bool fixup_alt_jump_set = !!fixup_alt_jump;
\
@@ -1242,7 +1228,8 @@ static int analyze_first (re_char *p, re_char *pend,
if (fixup_alt_jump_set) fixup_alt_jump_off = fixup_alt_jump - old_buffer; \
if (laststart_set) laststart_off = laststart - old_buffer; \
if (pending_exact_set) pending_exact_off = pending_exact - old_buffer; \
- RETALLOC (bufp->buffer, bufp->allocated, unsigned char); \
+ bufp->buffer = xpalloc (bufp->buffer, &bufp->allocated, \
+ requested_extension, MAX_BUF_SIZE, 1); \
unsigned char *new_buffer = bufp->buffer; \
b = new_buffer + b_off; \
begalt = new_buffer + begalt_off; \
@@ -1264,9 +1251,8 @@ typedef int regnum_t;
/* Macros for the compile stack. */
-/* Since offsets can go either forwards or backwards, this type needs to
- be able to hold values from -(MAX_BUF_SIZE - 1) to MAX_BUF_SIZE - 1. */
typedef long pattern_offset_t;
+verify (LONG_MIN <= -(MAX_BUF_SIZE - 1) && MAX_BUF_SIZE - 1 <= LONG_MAX);
typedef struct
{
@@ -1280,8 +1266,8 @@ typedef struct
typedef struct
{
compile_stack_elt_t *stack;
- size_t size;
- size_t avail; /* Offset of next open position. */
+ ptrdiff_t size;
+ ptrdiff_t avail; /* Offset of next open position. */
} compile_stack_type;
@@ -1302,9 +1288,7 @@ struct range_table_work_area
int bits; /* flag to record character classes */
};
-/* Make sure that WORK_AREA can hold more N multibyte characters.
- This is used only in set_image_of_range and set_image_of_range_1.
- It expects WORK_AREA to be a pointer.
+/* Make sure that WORK_AREA can hold N more multibyte characters.
If it can't get the space, it returns from the surrounding function. */
#define EXTEND_RANGE_TABLE(work_area, n) \
@@ -1501,7 +1485,7 @@ struct range_table_work_area
The function can be used on ASCII and multibyte (UTF-8-encoded) strings.
*/
re_wctype_t
-re_wctype_parse (const unsigned char **strp, unsigned limit)
+re_wctype_parse (const unsigned char **strp, ptrdiff_t limit)
{
const char *beg = (const char *)*strp, *it;
@@ -1679,13 +1663,13 @@ do {
\
'buffer' is the compiled pattern;
'syntax' is set to SYNTAX;
'used' is set to the length of the compiled pattern;
- 'fastmap_accurate' is zero;
+ 'fastmap_accurate' is false;
're_nsub' is the number of subexpressions in PATTERN;
The 'fastmap' field is neither examined nor set. */
static reg_errcode_t
-regex_compile (re_char *pattern, size_t size,
+regex_compile (re_char *pattern, ptrdiff_t size,
bool posix_backtracking,
const char *whitespace_regexp,
struct re_pattern_buffer *bufp)
@@ -1732,7 +1716,7 @@ regex_compile (re_char *pattern, size_t size,
/* Work area for range table of charset. */
struct range_table_work_area range_table_work;
- /* If the object matched can contain multibyte characters. */
+ /* If the regular expression is multibyte. */
bool multibyte = RE_MULTIBYTE_P (bufp);
/* Nonzero if we have pushed down into a subpattern. */
@@ -1749,16 +1733,15 @@ regex_compile (re_char *pattern, size_t size,
DEBUG_PRINT ("\nCompiling pattern: ");
if (regex_emacs_debug > 0)
{
- size_t debug_count;
-
- for (debug_count = 0; debug_count < size; debug_count++)
+ for (ptrdiff_t debug_count = 0; debug_count < size; debug_count++)
putchar (pattern[debug_count]);
putchar ('\n');
}
#endif
/* Initialize the compile stack. */
- compile_stack.stack = TALLOC (INIT_COMPILE_STACK_SIZE, compile_stack_elt_t);
+ compile_stack.stack = xmalloc (INIT_COMPILE_STACK_SIZE
+ * sizeof *compile_stack.stack);
compile_stack.size = INIT_COMPILE_STACK_SIZE;
compile_stack.avail = 0;
@@ -1766,8 +1749,8 @@ regex_compile (re_char *pattern, size_t size,
range_table_work.allocated = 0;
/* Initialize the pattern buffer. */
- bufp->fastmap_accurate = 0;
- bufp->used_syntax = 0;
+ bufp->fastmap_accurate = false;
+ bufp->used_syntax = false;
/* Set 'used' to zero, so that if we return an error, the pattern
printer (for debugging) will think there's no pattern. We reset it
@@ -1778,16 +1761,9 @@ regex_compile (re_char *pattern, size_t size,
if (bufp->allocated == 0)
{
- if (bufp->buffer)
- { /* If zero allocated, but buffer is non-null, try to realloc
- enough space. This loses if buffer's address is bogus, but
- that is the user's responsibility. */
- RETALLOC (bufp->buffer, INIT_BUF_SIZE, unsigned char);
- }
- else
- { /* Caller did not allocate a buffer. Do it for them. */
- bufp->buffer = TALLOC (INIT_BUF_SIZE, unsigned char);
- }
+ /* This loses if BUFP->buffer is bogus, but that is the user's
+ responsibility. */
+ bufp->buffer = xrealloc (bufp->buffer, INIT_BUF_SIZE);
bufp->allocated = INIT_BUF_SIZE;
}
@@ -1907,10 +1883,10 @@ regex_compile (re_char *pattern, size_t size,
if (many_times_ok)
{
bool simple = skip_one_char (laststart) == b;
- size_t startoffset = 0;
+ ptrdiff_t startoffset = 0;
re_opcode_t ofj =
/* Check if the loop can match the empty string. */
- (simple || !analyze_first (laststart, b, NULL, 0))
+ (simple || !analyze_first (laststart, b, NULL, false))
? on_failure_jump : on_failure_jump_loop;
eassert (skip_one_char (laststart) <= b);
@@ -1957,7 +1933,7 @@ regex_compile (re_char *pattern, size_t size,
GET_BUFFER_SPACE (7); /* We might use less. */
if (many_times_ok)
{
- bool emptyp = analyze_first (laststart, b, NULL, 0);
+ bool emptyp = !!analyze_first (laststart, b, NULL, false);
/* The non-greedy multiple match looks like
a repeat..until: we only need a conditional jump
@@ -2075,7 +2051,7 @@ regex_compile (re_char *pattern, size_t size,
content of the syntax-table is not hardcoded in the
range_table. SPACE and WORD are the two exceptions. */
if ((1 << cc) & ((1 << RECC_SPACE) | (1 << RECC_WORD)))
- bufp->used_syntax = 1;
+ bufp->used_syntax = true;
/* Repeat the loop. */
continue;
@@ -2182,7 +2158,7 @@ regex_compile (re_char *pattern, size_t size,
{
case '(':
{
- int shy = 0;
+ bool shy = false;
regnum_t regnum = 0;
if (p+1 < pend)
{
@@ -2195,7 +2171,7 @@ regex_compile (re_char *pattern, size_t size,
PATFETCH (c);
switch (c)
{
- case ':': shy = 1; break;
+ case ':': shy = true; break;
case '0':
/* An explicitly specified regnum must start
with non-0. */
@@ -2204,7 +2180,11 @@ regex_compile (re_char *pattern, size_t size,
FALLTHROUGH;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
- regnum = 10*regnum + (c - '0'); break;
+ if (INT_MULTIPLY_WRAPV (regnum, 10, ®num)
+ || INT_ADD_WRAPV (regnum, c - '0',
+ ®num))
+ FREE_STACK_RETURN (REG_ESIZE);
+ break;
default:
/* Only (?:...) is supported right now. */
FREE_STACK_RETURN (REG_BADPAT);
@@ -2217,7 +2197,7 @@ regex_compile (re_char *pattern, size_t size,
regnum = ++bufp->re_nsub;
else if (regnum)
{ /* It's actually not shy, but explicitly numbered. */
- shy = 0;
+ shy = false;
if (regnum > bufp->re_nsub)
bufp->re_nsub = regnum;
else if (regnum > bufp->re_nsub
@@ -2234,11 +2214,9 @@ regex_compile (re_char *pattern, size_t size,
regnum = - bufp->re_nsub;
if (COMPILE_STACK_FULL)
- {
- RETALLOC (compile_stack.stack, compile_stack.size << 1,
- compile_stack_elt_t);
- compile_stack.size <<= 1;
- }
+ compile_stack.stack
+ = xpalloc (compile_stack.stack, &compile_stack.size,
+ 1, -1, sizeof *compile_stack.stack);
/* These are the values to restore when we hit end of this
group. They are all relative offsets, so that if the
@@ -2395,9 +2373,8 @@ regex_compile (re_char *pattern, size_t size,
else
{ /* If the upper bound is > 1, we need to insert
more at the end of the loop. */
- unsigned int nbytes = (upper_bound < 0 ? 3
- : upper_bound > 1 ? 5 : 0);
- unsigned int startoffset = 0;
+ int nbytes = upper_bound < 0 ? 3 : upper_bound > 1 ? 5 : 0;
+ int startoffset = 0;
GET_BUFFER_SPACE (20); /* We might use less. */
@@ -2801,8 +2778,7 @@ group_in_compile_stack (compile_stack_type compile_stack,
regnum_t regnum)
Return -1 if fastmap was not updated accurately. */
static int
-analyze_first (re_char *p, re_char *pend, char *fastmap,
- const int multibyte)
+analyze_first (re_char *p, re_char *pend, char *fastmap, bool multibyte)
{
int j, k;
bool not;
@@ -3104,6 +3080,8 @@ re_compile_fastmap (struct re_pattern_buffer *bufp)
eassert (fastmap && bufp->buffer);
memset (fastmap, 0, 1 << BYTEWIDTH); /* Assume nothing's valid. */
+
+ /* FIXME: Is the following assignment correct even when ANALYSIS < 0? */
bufp->fastmap_accurate = 1; /* It will be when we're done. */
analysis = analyze_first (bufp->buffer, bufp->buffer + bufp->used,
@@ -3126,7 +3104,7 @@ re_compile_fastmap (struct re_pattern_buffer *bufp)
void
re_set_registers (struct re_pattern_buffer *bufp, struct re_registers *regs,
- unsigned int num_regs, ptrdiff_t *starts, ptrdiff_t *ends)
+ ptrdiff_t num_regs, ptrdiff_t *starts, ptrdiff_t *ends)
{
if (num_regs)
{
@@ -3149,7 +3127,7 @@ re_set_registers (struct re_pattern_buffer *bufp, struct
re_registers *regs,
doesn't let you say where to stop matching. */
ptrdiff_t
-re_search (struct re_pattern_buffer *bufp, const char *string, size_t size,
+re_search (struct re_pattern_buffer *bufp, const char *string, ptrdiff_t size,
ptrdiff_t startpos, ptrdiff_t range, struct re_registers *regs)
{
return re_search_2 (bufp, NULL, 0, string, size, startpos, range,
@@ -3186,8 +3164,8 @@ re_search (struct re_pattern_buffer *bufp, const char
*string, size_t size,
stack overflow). */
ptrdiff_t
-re_search_2 (struct re_pattern_buffer *bufp, const char *str1, size_t size1,
- const char *str2, size_t size2,
+re_search_2 (struct re_pattern_buffer *bufp, const char *str1, ptrdiff_t size1,
+ const char *str2, ptrdiff_t size2,
ptrdiff_t startpos, ptrdiff_t range,
struct re_registers *regs, ptrdiff_t stop)
{
@@ -3196,7 +3174,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char
*str1, size_t size1,
re_char *string2 = (re_char *) str2;
char *fastmap = bufp->fastmap;
Lisp_Object translate = bufp->translate;
- size_t total_size = size1 + size2;
+ ptrdiff_t total_size = size1 + size2;
ptrdiff_t endpos = startpos + range;
bool anchored_start;
/* Nonzero if we are searching multibyte string. */
@@ -3420,10 +3398,8 @@ re_search_2 (struct re_pattern_buffer *bufp, const char
*str1, size_t size1,
/* Declarations and macros for re_match_2. */
-static int bcmp_translate (re_char *s1, re_char *s2,
- ptrdiff_t len,
- Lisp_Object translate,
- const int multibyte);
+static bool bcmp_translate (re_char *, re_char *, ptrdiff_t,
+ Lisp_Object, bool);
/* This converts PTR, a pointer into one of the search strings 'string1'
and 'string2' into an offset from the beginning of that string. */
@@ -3567,8 +3543,9 @@ skip_noops (re_char *p, re_char *pend)
character (i.e. without any translations). UNIBYTE denotes whether c is
unibyte or multibyte character. */
static bool
-execute_charset (re_char **pp, unsigned c, unsigned corig, bool unibyte)
+execute_charset (re_char **pp, int c, int corig, bool unibyte)
{
+ eassume (0 <= c && 0 <= corig);
re_char *p = *pp, *rtp = NULL;
bool not = (re_opcode_t) *p == charset_not;
@@ -3628,8 +3605,8 @@ execute_charset (re_char **pp, unsigned c, unsigned
corig, bool unibyte)
return not;
}
-/* Non-zero if "p1 matches something" implies "p2 fails". */
-static int
+/* True if "p1 matches something" implies "p2 fails". */
+static bool
mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1,
re_char *p2)
{
@@ -3662,7 +3639,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
if (skip_one_char (p1))
{
DEBUG_PRINT (" End of pattern: fast loop.\n");
- return 1;
+ return true;
}
break;
@@ -3678,7 +3655,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
if (c != RE_STRING_CHAR (p1 + 2, multibyte))
{
DEBUG_PRINT (" '%c' != '%c' => fast loop.\n", c, p1[2]);
- return 1;
+ return true;
}
}
@@ -3688,14 +3665,14 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
if (!execute_charset (&p1, c, c, !multibyte || ASCII_CHAR_P (c)))
{
DEBUG_PRINT (" No match => fast loop.\n");
- return 1;
+ return true;
}
}
else if ((re_opcode_t) *p1 == anychar
&& c == '\n')
{
DEBUG_PRINT (" . != \\n => fast loop.\n");
- return 1;
+ return true;
}
}
break;
@@ -3738,7 +3715,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
|| idx == CHARSET_BITMAP_SIZE (p1))
{
DEBUG_PRINT (" No match => fast loop.\n");
- return 1;
+ return true;
}
}
else if ((re_opcode_t) *p1 == charset_not)
@@ -3755,7 +3732,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
if (idx == p2[1])
{
DEBUG_PRINT (" No match => fast loop.\n");
- return 1;
+ return true;
}
}
}
@@ -3809,7 +3786,7 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
}
/* Safe default. */
- return 0;
+ return false;
}
@@ -3828,9 +3805,10 @@ mutually_exclusive_p (struct re_pattern_buffer *bufp,
re_char *p1,
matched substring. */
ptrdiff_t
-re_match_2 (struct re_pattern_buffer *bufp, const char *string1,
- size_t size1, const char *string2, size_t size2, ptrdiff_t pos,
- struct re_registers *regs, ptrdiff_t stop)
+re_match_2 (struct re_pattern_buffer *bufp,
+ char const *string1, ptrdiff_t size1,
+ char const *string2, ptrdiff_t size2,
+ ptrdiff_t pos, struct re_registers *regs, ptrdiff_t stop)
{
ptrdiff_t result;
@@ -3849,13 +3827,13 @@ re_match_2 (struct re_pattern_buffer *bufp, const char
*string1,
/* This is a separate function so that we can force an alloca cleanup
afterwards. */
static ptrdiff_t
-re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1,
- size_t size1, re_char *string2, size_t size2,
+re_match_2_internal (struct re_pattern_buffer *bufp,
+ re_char *string1, ptrdiff_t size1,
+ re_char *string2, ptrdiff_t size2,
ptrdiff_t pos, struct re_registers *regs, ptrdiff_t stop)
{
/* General temporaries. */
int mcnt;
- size_t reg;
/* Just past the end of the corresponding string. */
re_char *end1, *end2;
@@ -3895,13 +3873,14 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
scanning the strings. */
fail_stack_type fail_stack;
#ifdef DEBUG_COMPILES_ARGUMENTS
- unsigned nfailure_points_pushed = 0, nfailure_points_popped = 0;
+ ptrdiff_t nfailure_points_pushed = 0, nfailure_points_popped = 0;
#endif
/* We fill all the registers internally, independent of what we
return, for use in backreferences. The number here includes
an element for register zero. */
- size_t num_regs = bufp->re_nsub + 1;
+ ptrdiff_t num_regs = bufp->re_nsub + 1;
+ eassume (0 < num_regs);
/* Information on the contents of registers. These are pointers into
the input strings; they record just what was matched (on this
@@ -3916,7 +3895,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
variables when we find a match better than any we've seen before.
This happens as we backtrack through the failure points, which in
turn happens only if we have not yet matched the entire string. */
- unsigned best_regs_set = false;
+ bool best_regs_set = false;
re_char **best_regstart UNINIT, **best_regend UNINIT;
/* Logically, this is 'best_regend[0]'. But we don't want to have to
@@ -3931,7 +3910,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
#ifdef DEBUG_COMPILES_ARGUMENTS
/* Counts the total number of registers pushed. */
- unsigned num_regs_pushed = 0;
+ ptrdiff_t num_regs_pushed = 0;
#endif
DEBUG_PRINT ("\n\nEntering re_match_2.\n");
@@ -3961,9 +3940,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
}
/* Initialize subexpression text positions to -1 to mark ones that no
- start_memory/stop_memory has been seen for. Also initialize the
- register information struct. */
- for (reg = 1; reg < num_regs; reg++)
+ start_memory/stop_memory has been seen for. */
+ for (ptrdiff_t reg = 1; reg < num_regs; reg++)
regstart[reg] = regend[reg] = NULL;
/* We move 'string1' into 'string2' if the latter's empty -- but not if
@@ -4070,7 +4048,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
DEBUG_PRINT ("\nSAVING match as best so far.\n");
- for (reg = 1; reg < num_regs; reg++)
+ for (ptrdiff_t reg = 1; reg < num_regs; reg++)
{
best_regstart[reg] = regstart[reg];
best_regend[reg] = regend[reg];
@@ -4096,7 +4074,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
dend = ((d >= string1 && d <= end1)
? end_match_1 : end_match_2);
- for (reg = 1; reg < num_regs; reg++)
+ for (ptrdiff_t reg = 1; reg < num_regs; reg++)
{
regstart[reg] = best_regstart[reg];
regend[reg] = best_regend[reg];
@@ -4112,23 +4090,25 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
{
/* Have the register data arrays been allocated? */
if (bufp->regs_allocated == REGS_UNALLOCATED)
- { /* No. So allocate them with malloc. We need one
- extra element beyond 'num_regs' for the '-1' marker
- GNU code uses. */
- regs->num_regs = max (RE_NREGS, num_regs + 1);
- regs->start = TALLOC (regs->num_regs, ptrdiff_t);
- regs->end = TALLOC (regs->num_regs, ptrdiff_t);
+ { /* No. So allocate them with malloc. */
+ ptrdiff_t n = max (RE_NREGS, num_regs);
+ regs->start = xnmalloc (n, sizeof *regs->start);
+ regs->end = xnmalloc (n, sizeof *regs->end);
+ regs->num_regs = n;
bufp->regs_allocated = REGS_REALLOCATE;
}
else if (bufp->regs_allocated == REGS_REALLOCATE)
{ /* Yes. If we need more elements than were already
allocated, reallocate them. If we need fewer, just
leave it alone. */
- if (regs->num_regs < num_regs + 1)
+ ptrdiff_t n = regs->num_regs;
+ if (n < num_regs)
{
- regs->num_regs = num_regs + 1;
- RETALLOC (regs->start, regs->num_regs, ptrdiff_t);
- RETALLOC (regs->end, regs->num_regs, ptrdiff_t);
+ n = max (n + (n >> 1), num_regs);
+ regs->start
+ = xnrealloc (regs->start, n, sizeof *regs->start);
+ regs->end = xnrealloc (regs->end, n, sizeof *regs->end);
+ regs->num_regs = n;
}
}
else
@@ -4143,9 +4123,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
regs->end[0] = POINTER_TO_OFFSET (d);
}
- /* Go through the first 'min (num_regs, regs->num_regs)'
- registers, since that is all we initialized. */
- for (reg = 1; reg < min (num_regs, regs->num_regs); reg++)
+ for (ptrdiff_t reg = 1; reg < num_regs; reg++)
{
if (REG_UNSET (regstart[reg]) || REG_UNSET (regend[reg]))
regs->start[reg] = regs->end[reg] = -1;
@@ -4157,18 +4135,15 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
}
/* If the regs structure we return has more elements than
- were in the pattern, set the extra elements to -1. If
- we (re)allocated the registers, this is the case,
- because we always allocate enough to have at least one
- -1 at the end. */
- for (reg = num_regs; reg < regs->num_regs; reg++)
+ were in the pattern, set the extra elements to -1. */
+ for (ptrdiff_t reg = num_regs; reg < regs->num_regs; reg++)
regs->start[reg] = regs->end[reg] = -1;
}
- DEBUG_PRINT ("%u failure points pushed, %u popped (%u remain).\n",
+ DEBUG_PRINT ("%td failure points pushed, %td popped (%td remain).\n",
nfailure_points_pushed, nfailure_points_popped,
nfailure_points_pushed - nfailure_points_popped);
- DEBUG_PRINT ("%u registers pushed.\n", num_regs_pushed);
+ DEBUG_PRINT ("%td registers pushed.\n", num_regs_pushed);
ptrdiff_t dcnt = POINTER_TO_OFFSET (d) - pos;
@@ -4293,9 +4268,6 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
case charset:
case charset_not:
{
- register unsigned int c, corig;
- int len;
-
/* Whether matching against a unibyte character. */
bool unibyte_char = false;
@@ -4303,7 +4275,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
(re_opcode_t) *(p - 1) == charset_not ? "_not" : "");
PREFETCH ();
- corig = c = RE_STRING_CHAR_AND_LENGTH (d, len, target_multibyte);
+ int len;
+ int corig = RE_STRING_CHAR_AND_LENGTH (d, len, target_multibyte);
+ int c = corig;
if (target_multibyte)
{
int c1;
@@ -4371,7 +4345,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
/* Strictly speaking, there should be code such as:
eassert (REG_UNSET (regend[*p]));
- PUSH_FAILURE_REGSTOP ((unsigned int)*p);
+ PUSH_FAILURE_REGSTOP (*p);
But the only info to be pushed is regend[*p] and it is known to
be UNSET, so there really isn't anything to push.
@@ -4550,7 +4524,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
eassert ((re_opcode_t)p[-4] == no_op);
{
- int cycle = 0;
+ bool cycle = false;
CHECK_INFINITE_LOOP (p - 4, d);
if (!cycle)
/* If there's a cycle, just continue without pushing
@@ -4569,7 +4543,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
DEBUG_PRINT ("EXECUTING on_failure_jump_loop %d (to %p):\n",
mcnt, p + mcnt);
{
- int cycle = 0;
+ bool cycle = false;
CHECK_INFINITE_LOOP (p - 3, d);
if (cycle)
/* If there's a cycle, get out of the loop, as if the matching
@@ -5027,12 +5001,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
re_char *string1,
/* Subroutine definitions for re_match_2. */
-/* Return zero if TRANSLATE[S1] and TRANSLATE[S2] are identical for LEN
- bytes; nonzero otherwise. */
+/* Return true if TRANSLATE[S1] and TRANSLATE[S2] are not identical
+ for LEN bytes. */
-static int
+static bool
bcmp_translate (re_char *s1, re_char *s2, ptrdiff_t len,
- Lisp_Object translate, int target_multibyte)
+ Lisp_Object translate, bool target_multibyte)
{
re_char *p1 = s1, *p2 = s2;
re_char *p1_end = s1 + len;
@@ -5050,15 +5024,12 @@ bcmp_translate (re_char *s1, re_char *s2, ptrdiff_t len,
if (RE_TRANSLATE (translate, p1_ch)
!= RE_TRANSLATE (translate, p2_ch))
- return 1;
+ return true;
p1 += p1_charlen, p2 += p2_charlen;
}
- if (p1 != p1_end || p2 != p2_end)
- return 1;
-
- return 0;
+ return p1 != p1_end || p2 != p2_end;
}
/* Entry points for GNU code. */
@@ -5073,17 +5044,14 @@ bcmp_translate (re_char *s1, re_char *s2, ptrdiff_t len,
We call regex_compile to do the actual compilation. */
const char *
-re_compile_pattern (const char *pattern, size_t length,
+re_compile_pattern (const char *pattern, ptrdiff_t length,
bool posix_backtracking, const char *whitespace_regexp,
struct re_pattern_buffer *bufp)
{
- reg_errcode_t ret;
-
- /* GNU code is written to assume at least RE_NREGS registers will be set
- (and at least one extra will be -1). */
bufp->regs_allocated = REGS_UNALLOCATED;
- ret = regex_compile ((re_char *) pattern, length,
+ reg_errcode_t ret
+ = regex_compile ((re_char *) pattern, length,
posix_backtracking,
whitespace_regexp,
bufp);
diff --git a/src/regex-emacs.h b/src/regex-emacs.h
index 5a52135..ddf14e0 100644
--- a/src/regex-emacs.h
+++ b/src/regex-emacs.h
@@ -26,7 +26,7 @@
uses struct re_registers. */
struct re_registers
{
- unsigned num_regs;
+ ptrdiff_t num_regs;
ptrdiff_t *start;
ptrdiff_t *end;
};
@@ -50,7 +50,7 @@ struct re_registers
extern Lisp_Object re_match_object;
/* Roughly the maximum number of failure points on the stack. */
-extern size_t emacs_re_max_failures;
+extern ptrdiff_t emacs_re_max_failures;
/* Amount of memory that we can safely stack allocate. */
extern ptrdiff_t emacs_re_safe_alloca;
@@ -69,10 +69,10 @@ struct re_pattern_buffer
unsigned char *buffer;
/* Number of bytes to which 'buffer' points. */
- size_t allocated;
+ ptrdiff_t allocated;
/* Number of bytes actually used in 'buffer'. */
- size_t used;
+ ptrdiff_t used;
/* Charset of unibyte characters at compiling time. */
int charset_unibyte;
@@ -89,35 +89,35 @@ struct re_pattern_buffer
Lisp_Object translate;
/* Number of subexpressions found by the compiler. */
- size_t re_nsub;
+ ptrdiff_t re_nsub;
/* True if and only if this pattern can match the empty string.
Well, in truth it's used only in 're_search_2', to see
whether or not we should use the fastmap, so we don't set
this absolutely perfectly; see 're_compile_fastmap'. */
- unsigned can_be_null : 1;
+ bool_bf can_be_null : 1;
/* If REGS_UNALLOCATED, allocate space in the 'regs' structure
- for 'max (RE_NREGS, re_nsub + 1)' groups.
+ for at least (re_nsub + 1) groups.
If REGS_REALLOCATE, reallocate space if necessary.
If REGS_FIXED, use what's there. */
unsigned regs_allocated : 2;
/* Set to false when 'regex_compile' compiles a pattern; set to true
by 're_compile_fastmap' if it updates the fastmap. */
- unsigned fastmap_accurate : 1;
+ bool_bf fastmap_accurate : 1;
/* If true, the compilation of the pattern had to look up the syntax table,
so the compiled pattern is valid for the current syntax table only. */
- unsigned used_syntax : 1;
+ bool_bf used_syntax : 1;
/* If true, multi-byte form in the regexp pattern should be
recognized as a multibyte character. */
- unsigned multibyte : 1;
+ bool_bf multibyte : 1;
/* If true, multi-byte form in the target of match should be
recognized as a multibyte character. */
- unsigned target_multibyte : 1;
+ bool_bf target_multibyte : 1;
};
/* Declarations for routines. */
@@ -125,7 +125,7 @@ struct re_pattern_buffer
/* Compile the regular expression PATTERN, with length LENGTH
and syntax given by the global 're_syntax_options', into the buffer
BUFFER. Return NULL if successful, and an error string if not. */
-extern const char *re_compile_pattern (const char *pattern, size_t length,
+extern const char *re_compile_pattern (const char *pattern, ptrdiff_t length,
bool posix_backtracking,
const char *whitespace_regexp,
struct re_pattern_buffer *buffer);
@@ -137,7 +137,7 @@ extern const char *re_compile_pattern (const char *pattern,
size_t length,
match, or -2 for an internal error. Also return register
information in REGS (if REGS is non-null). */
extern ptrdiff_t re_search (struct re_pattern_buffer *buffer,
- const char *string, size_t length,
+ const char *string, ptrdiff_t length,
ptrdiff_t start, ptrdiff_t range,
struct re_registers *regs);
@@ -145,8 +145,8 @@ extern ptrdiff_t re_search (struct re_pattern_buffer
*buffer,
/* Like 're_search', but search in the concatenation of STRING1 and
STRING2. Also, stop searching at index START + STOP. */
extern ptrdiff_t re_search_2 (struct re_pattern_buffer *buffer,
- const char *string1, size_t length1,
- const char *string2, size_t length2,
+ const char *string1, ptrdiff_t length1,
+ const char *string2, ptrdiff_t length2,
ptrdiff_t start, ptrdiff_t range,
struct re_registers *regs,
ptrdiff_t stop);
@@ -155,8 +155,8 @@ extern ptrdiff_t re_search_2 (struct re_pattern_buffer
*buffer,
/* Like 're_search_2', but return how many characters in STRING the regexp
in BUFFER matched, starting at position START. */
extern ptrdiff_t re_match_2 (struct re_pattern_buffer *buffer,
- const char *string1, size_t length1,
- const char *string2, size_t length2,
+ const char *string1, ptrdiff_t length1,
+ const char *string2, ptrdiff_t length2,
ptrdiff_t start, struct re_registers *regs,
ptrdiff_t stop);
@@ -175,7 +175,7 @@ extern ptrdiff_t re_match_2 (struct re_pattern_buffer
*buffer,
freeing the old data. */
extern void re_set_registers (struct re_pattern_buffer *buffer,
struct re_registers *regs,
- unsigned num_regs,
+ ptrdiff_t num_regs,
ptrdiff_t *starts, ptrdiff_t *ends);
/* Character classes. */
@@ -192,6 +192,6 @@ typedef enum { RECC_ERROR = 0,
extern bool re_iswctype (int ch, re_wctype_t cc);
extern re_wctype_t re_wctype_parse (const unsigned char **strp,
- unsigned limit);
+ ptrdiff_t limit);
#endif /* EMACS_REGEX_H */
diff --git a/src/search.c b/src/search.c
index a1e0b09..a450e92 100644
--- a/src/search.c
+++ b/src/search.c
@@ -59,31 +59,6 @@ static struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
/* The head of the linked list; points to the most recently used buffer. */
static struct regexp_cache *searchbuf_head;
-
-/* Every call to re_search, etc., must pass &search_regs as the regs
- argument unless you can show it is unnecessary (i.e., if re_search
- is certainly going to be called again before region-around-match
- can be called).
-
- Since the registers are now dynamically allocated, we need to make
- sure not to refer to the Nth register before checking that it has
- been allocated by checking search_regs.num_regs.
-
- The regex code keeps track of whether it has allocated the search
- buffer using bits in the re_pattern_buffer. This means that whenever
- you compile a new pattern, it completely forgets whether it has
- allocated any registers, and will allocate new registers the next
- time you call a searching or matching function. Therefore, we need
- to call re_set_registers after compiling a new pattern or after
- setting the match registers, so that the regex functions will be
- able to free or re-allocate it properly. */
-/* static struct re_registers search_regs; */
-
-/* The buffer in which the last search was performed, or
- Qt if the last search was done in a string;
- Qnil if no searching has been done yet. */
-/* static Lisp_Object last_thing_searched; */
-
static void set_search_regs (ptrdiff_t, ptrdiff_t);
static void save_search_regs (void);
static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t,
@@ -223,11 +198,13 @@ static struct regexp_cache *
compile_pattern (Lisp_Object pattern, struct re_registers *regp,
Lisp_Object translate, bool posix, bool multibyte)
{
- struct regexp_cache *cp, **cpp;
+ struct regexp_cache *cp, **cpp, **lru_nonbusy;
- for (cpp = &searchbuf_head; ; cpp = &cp->next)
+ for (cpp = &searchbuf_head, lru_nonbusy = NULL; ; cpp = &cp->next)
{
cp = *cpp;
+ if (!cp->busy)
+ lru_nonbusy = cpp;
/* Entries are initialized to nil, and may be set to nil by
compile_pattern_1 if the pattern isn't valid. Don't apply
string accessors in those cases. However, compile_pattern_1
@@ -247,13 +224,14 @@ compile_pattern (Lisp_Object pattern, struct re_registers
*regp,
&& cp->buf.charset_unibyte == charset_unibyte)
break;
- /* If we're at the end of the cache, compile into the nil cell
- we found, or the last (least recently used) cell with a
- string value. */
+ /* If we're at the end of the cache, compile into the last
+ (least recently used) non-busy cell in the cache. */
if (cp->next == 0)
{
- if (cp->busy)
+ if (!lru_nonbusy)
error ("Too much matching reentrancy");
+ cpp = lru_nonbusy;
+ cp = *cpp;
compile_it:
eassert (!cp->busy);
compile_pattern_1 (cp, pattern, translate, posix);
@@ -341,7 +319,10 @@ looking_at_1 (Lisp_Object string, bool posix)
ZV_BYTE - BEGV_BYTE);
if (i == -2)
- matcher_overflow ();
+ {
+ unbind_to (count, Qnil);
+ matcher_overflow ();
+ }
val = (i >= 0 ? Qt : Qnil);
if (preserve_match_data && i >= 0)
@@ -1220,6 +1201,7 @@ search_buffer_re (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
pos_byte - BEGV_BYTE);
if (val == -2)
{
+ unbind_to (count, Qnil);
matcher_overflow ();
}
if (val >= 0)
@@ -1265,6 +1247,7 @@ search_buffer_re (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
lim_byte - BEGV_BYTE);
if (val == -2)
{
+ unbind_to (count, Qnil);
matcher_overflow ();
}
if (val >= 0)
@@ -2763,7 +2746,7 @@ since only regular expressions have distinguished
subexpressions. */)
error out since otherwise this will result in confusing bugs. */
ptrdiff_t sub_start = search_regs.start[sub];
ptrdiff_t sub_end = search_regs.end[sub];
- unsigned num_regs = search_regs.num_regs;
+ ptrdiff_t num_regs = search_regs.num_regs;
newpoint = search_regs.start[sub] + SCHARS (newtext);
/* Replace the old text with the new in the cleanest possible way. */
@@ -3079,29 +3062,19 @@ If optional arg RESEAT is non-nil, make markers on LIST
point nowhere. */)
return Qnil;
}
-/* If true the match data have been saved in saved_search_regs
- during the execution of a sentinel or filter. */
-/* static bool search_regs_saved; */
-/* static struct re_registers saved_search_regs; */
-/* static Lisp_Object saved_last_thing_searched; */
-
/* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
if asynchronous code (filter or sentinel) is running. */
static void
save_search_regs (void)
{
- if (!search_regs_saved)
+ if (saved_search_regs.num_regs == 0)
{
- saved_search_regs.num_regs = search_regs.num_regs;
- saved_search_regs.start = search_regs.start;
- saved_search_regs.end = search_regs.end;
+ saved_search_regs = search_regs;
saved_last_thing_searched = last_thing_searched;
last_thing_searched = Qnil;
search_regs.num_regs = 0;
search_regs.start = 0;
search_regs.end = 0;
-
- search_regs_saved = 1;
}
}
@@ -3109,19 +3082,17 @@ save_search_regs (void)
void
restore_search_regs (void)
{
- if (search_regs_saved)
+ if (saved_search_regs.num_regs != 0)
{
if (search_regs.num_regs > 0)
{
xfree (search_regs.start);
xfree (search_regs.end);
}
- search_regs.num_regs = saved_search_regs.num_regs;
- search_regs.start = saved_search_regs.start;
- search_regs.end = saved_search_regs.end;
+ search_regs = saved_search_regs;
last_thing_searched = saved_last_thing_searched;
saved_last_thing_searched = Qnil;
- search_regs_saved = 0;
+ saved_search_regs.num_regs = 0;
}
}
diff --git a/src/termhooks.h b/src/termhooks.h
index ca6782f..a92b981 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -408,7 +408,7 @@ struct terminal
whether the mapping is available. */
Lisp_Object glyph_code_table;
- /* All fields before `next_terminal' should be Lisp_Object and are traced
+ /* All earlier fields should be Lisp_Objects and are traced
by the GC. All fields afterwards are ignored by the GC. */
/* Chain of all terminal devices. */
diff --git a/src/terminal.c b/src/terminal.c
index 1d7a965..0ee0121 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -264,8 +264,8 @@ get_named_terminal (const char *name)
static struct terminal *
allocate_terminal (void)
{
- return ALLOCATE_ZEROED_PSEUDOVECTOR
- (struct terminal, next_terminal, PVEC_TERMINAL);
+ return ALLOCATE_ZEROED_PSEUDOVECTOR (struct terminal, glyph_code_table,
+ PVEC_TERMINAL);
}
/* Create a new terminal object of TYPE and add it to the terminal list. RIF
diff --git a/src/thread.c b/src/thread.c
index 59e5b66..670680f 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -267,7 +267,7 @@ informational only. */)
if (!NILP (name))
CHECK_STRING (name);
- mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX);
+ mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, name, PVEC_MUTEX);
memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex),
0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex,
mutex));
@@ -386,7 +386,7 @@ informational only. */)
if (!NILP (name))
CHECK_STRING (name);
- condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR);
+ condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, name, PVEC_CONDVAR);
memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond),
0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar,
cond));
@@ -768,9 +768,21 @@ run_thread (void *state)
return NULL;
}
+static void
+free_search_regs (struct re_registers *regs)
+{
+ if (regs->num_regs != 0)
+ {
+ xfree (regs->start);
+ xfree (regs->end);
+ }
+}
+
void
finalize_one_thread (struct thread_state *state)
{
+ free_search_regs (&state->m_search_regs);
+ free_search_regs (&state->m_saved_search_regs);
sys_cond_destroy (&state->thread_condvar);
}
@@ -793,7 +805,7 @@ If NAME is given, it must be a string; it names the new
thread. */)
if (!NILP (name))
CHECK_STRING (name);
- new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom,
+ new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, event_object,
PVEC_THREAD);
memset ((char *) new_thread + offset, 0,
sizeof (struct thread_state) - offset);
@@ -1052,7 +1064,7 @@ static void
init_main_thread (void)
{
main_thread.s.header.size
- = PSEUDOVECSIZE (struct thread_state, m_stack_bottom);
+ = PSEUDOVECSIZE (struct thread_state, event_object);
XSETPVECTYPE (&main_thread.s, PVEC_THREAD);
main_thread.s.m_last_thing_searched = Qnil;
main_thread.s.m_saved_last_thing_searched = Qnil;
diff --git a/src/thread.h b/src/thread.h
index cb7e60f..0514669 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -61,8 +61,8 @@ struct thread_state
/* If we are waiting for some event, this holds the object we are
waiting on. */
Lisp_Object event_object;
+ /* event_object must be the last Lisp field. */
- /* m_stack_bottom must be the first non-Lisp field. */
/* An address near the bottom of the stack.
Tells GC how to save a copy of the stack. */
char const *m_stack_bottom;
@@ -111,8 +111,8 @@ struct thread_state
struct buffer *m_current_buffer;
#define current_buffer (current_thread->m_current_buffer)
- /* Every call to re_match_2, etc., must pass &search_regs as the regs
- argument unless you can show it is unnecessary (i.e., if re_match_2
+ /* Every call to re_search, etc., must pass &search_regs as the regs
+ argument unless you can show it is unnecessary (i.e., if re_search
is certainly going to be called again before region-around-match
can be called).
@@ -131,11 +131,6 @@ struct thread_state
struct re_registers m_search_regs;
#define search_regs (current_thread->m_search_regs)
- /* If non-zero the match data have been saved in saved_search_regs
- during the execution of a sentinel or filter. */
- bool m_search_regs_saved;
-#define search_regs_saved (current_thread->m_search_regs_saved)
-
struct re_registers m_saved_search_regs;
#define saved_search_regs (current_thread->m_saved_search_regs)
diff --git a/src/w32fns.c b/src/w32fns.c
index 25900c5..af82b46 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -10099,6 +10099,8 @@ It can also be nil, which means try `HKCU', and if that
fails, try `HKLM'.
KEY and NAME must be strings, and NAME must not include slashes.
KEY can use either forward- or back-slashes.
+To access the default value of KEY (if it is defined), use NAME
+that is an empty string.
If the the named KEY or its subkey called NAME don't exist, or cannot
be accessed by the current user, the function returns nil. Otherwise,
diff --git a/src/w32proc.c b/src/w32proc.c
index 8e878e6..75e345a 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1776,22 +1776,27 @@ w32_executable_type (char * filename,
if (data_dir)
{
/* Look for Cygwin DLL in the DLL import list. */
- IMAGE_DATA_DIRECTORY import_dir =
- data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
+ IMAGE_DATA_DIRECTORY import_dir
+ = data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
/* Import directory can be missing in .NET DLLs. */
if (import_dir.VirtualAddress != 0)
{
+ IMAGE_SECTION_HEADER *section
+ = rva_to_section (import_dir.VirtualAddress, nt_header);
+ if (!section)
+ emacs_abort ();
+
IMAGE_IMPORT_DESCRIPTOR * imports =
- RVA_TO_PTR (import_dir.VirtualAddress,
- rva_to_section (import_dir.VirtualAddress,
- nt_header),
+ RVA_TO_PTR (import_dir.VirtualAddress, section,
executable);
for ( ; imports->Name; imports++)
{
- IMAGE_SECTION_HEADER * section =
- rva_to_section (imports->Name, nt_header);
+ section = rva_to_section (imports->Name, nt_header);
+ if (!section)
+ emacs_abort ();
+
char * dllname = RVA_TO_PTR (imports->Name, section,
executable);
diff --git a/src/w32term.c b/src/w32term.c
index 0f0d648..bb1f0ba 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1896,6 +1896,24 @@ x_draw_image_foreground (struct glyph_string *s)
orig_height = s->slice.height;
}
+ double w_factor = 1.0, h_factor = 1.0;
+ bool scaled = false;
+ int orig_slice_width = s->slice.width,
+ orig_slice_height = s->slice.height;
+ int orig_slice_x = s->slice.x, orig_slice_y = s->slice.y;
+ /* For scaled images we need to restore the original slice's
+ dimensions and origin coordinates, from before the scaling. */
+ if (s->img->width != orig_width || s->img->height != orig_height)
+ {
+ scaled = true;
+ w_factor = (double) orig_width / (double) s->img->width;
+ h_factor = (double) orig_height / (double) s->img->height;
+ orig_slice_width = s->slice.width * w_factor + 0.5;
+ orig_slice_height = s->slice.height * h_factor + 0.5;
+ orig_slice_x = s->slice.x * w_factor + 0.5;
+ orig_slice_y = s->slice.y * h_factor + 0.5;
+ }
+
if (s->img->mask)
{
HDC mask_dc = CreateCompatibleDC (s->hdc);
@@ -1903,7 +1921,7 @@ x_draw_image_foreground (struct glyph_string *s)
SetTextColor (s->hdc, RGB (255, 255, 255));
SetBkColor (s->hdc, RGB (0, 0, 0));
- if (s->slice.width == orig_width && s->slice.height == orig_height)
+ if (!scaled)
{
BitBlt (s->hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCINVERT);
@@ -1922,14 +1940,14 @@ x_draw_image_foreground (struct glyph_string *s)
&& (pmode = SetStretchBltMode (s->hdc, HALFTONE)) != 0)
SetBrushOrgEx (s->hdc, 0, 0, NULL);
StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height,
- compat_hdc, s->slice.x, s->slice.y,
- orig_width, orig_height, SRCINVERT);
+ compat_hdc, orig_slice_x, orig_slice_y,
+ orig_slice_width, orig_slice_height, SRCINVERT);
StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height,
- mask_dc, s->slice.x, s->slice.y,
- orig_width, orig_height, SRCAND);
+ mask_dc, orig_slice_x, orig_slice_y,
+ orig_slice_width, orig_slice_height, SRCAND);
StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height,
- compat_hdc, s->slice.x, s->slice.y,
- orig_width, orig_height, SRCINVERT);
+ compat_hdc, orig_slice_x, orig_slice_y,
+ orig_slice_width, orig_slice_height, SRCINVERT);
if (pmode)
SetStretchBltMode (s->hdc, pmode);
}
@@ -1940,7 +1958,7 @@ x_draw_image_foreground (struct glyph_string *s)
{
SetTextColor (s->hdc, s->gc->foreground);
SetBkColor (s->hdc, s->gc->background);
- if (s->slice.width == orig_width && s->slice.height == orig_height)
+ if (!scaled)
BitBlt (s->hdc, x, y, s->slice.width, s->slice.height,
compat_hdc, s->slice.x, s->slice.y, SRCCOPY);
else
@@ -1951,8 +1969,8 @@ x_draw_image_foreground (struct glyph_string *s)
&& (pmode = SetStretchBltMode (s->hdc, HALFTONE)) != 0)
SetBrushOrgEx (s->hdc, 0, 0, NULL);
StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height,
- compat_hdc, s->slice.x, s->slice.y,
- orig_width, orig_height, SRCCOPY);
+ compat_hdc, orig_slice_x, orig_slice_y,
+ orig_slice_width, orig_slice_height, SRCCOPY);
if (pmode)
SetStretchBltMode (s->hdc, pmode);
}
@@ -3672,7 +3690,7 @@ x_window_to_scroll_bar (Window window_id, int type)
! NILP (bar));
bar = XSCROLL_BAR (bar)->next)
if (SCROLL_BAR_W32_WINDOW (XSCROLL_BAR (bar)) == window_id
- && (type = 2
+ && (type == 2
|| (type == 1 && XSCROLL_BAR (bar)->horizontal)
|| (type == 0 && !XSCROLL_BAR (bar)->horizontal)))
return XSCROLL_BAR (bar);
@@ -3878,7 +3896,7 @@ x_scroll_bar_create (struct window *w, int left, int top,
int width, int height,
HWND hwnd;
SCROLLINFO si;
struct scroll_bar *bar
- = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, top, PVEC_OTHER);
+ = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, w32_widget_high, PVEC_OTHER);
Lisp_Object barobj;
block_input ();
diff --git a/src/widget.c b/src/widget.c
index c695bd5..508974d 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -297,7 +297,6 @@ update_wm_hints (EmacsFrame ew)
int char_height;
int base_width;
int base_height;
- int min_rows = 0, min_cols = 0;
/* This happens when the frame is just created. */
if (! wmshell) return;
@@ -323,8 +322,8 @@ update_wm_hints (EmacsFrame ew)
XtNbaseHeight, (XtArgVal) base_height,
XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
- XtNminWidth, (XtArgVal) (base_width + min_cols * cw),
- XtNminHeight, (XtArgVal) (base_height + min_rows * ch),
+ XtNminWidth, (XtArgVal) base_width,
+ XtNminHeight, (XtArgVal) base_height,
NULL);
}
diff --git a/src/window.c b/src/window.c
index be338c2..ef2ed63 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1796,7 +1796,12 @@ DEFUN ("set-window-start", Fset_window_start,
Sset_window_start, 2, 3, 0,
doc: /* Make display in WINDOW start at position POS in WINDOW's buffer.
WINDOW must be a live window and defaults to the selected one. Return
POS. Optional third arg NOFORCE non-nil inhibits next redisplay from
-overriding motion of point in order to display at this exact start. */)
+overriding motion of point in order to display at this exact start.
+
+For reliable setting of WINDOW start position, make sure point is
+at a position that will be visible when that start is in effect,
+otherwise there's a chance POS will be disregarded, e.g., if point
+winds up in a partially-visible line. */)
(Lisp_Object window, Lisp_Object pos, Lisp_Object noforce)
{
register struct window *w = decode_live_window (window);
@@ -4170,8 +4175,8 @@ temp_output_buffer_show (register Lisp_Object buf)
static struct window *
allocate_window (void)
{
- return ALLOCATE_ZEROED_PSEUDOVECTOR
- (struct window, current_matrix, PVEC_WINDOW);
+ return ALLOCATE_ZEROED_PSEUDOVECTOR (struct window, mode_line_help_echo,
+ PVEC_WINDOW);
}
/* Make new window, have it replace WINDOW in window-tree, and make
@@ -6710,7 +6715,8 @@ struct save_window_data
Lisp_Object saved_windows;
/* All fields above are traced by the GC.
- From `frame-cols' down, the fields are ignored by the GC. */
+ After saved_windows, the fields are ignored by the GC. */
+
/* We should be able to do without the following two. */
int frame_cols, frame_lines;
/* These two should get eventually replaced by their pixel
@@ -7383,15 +7389,11 @@ redirection (see `redirect-frame-focus'). The variable
saved by this function. */)
(Lisp_Object frame)
{
- Lisp_Object tem;
- ptrdiff_t i, n_windows;
- struct save_window_data *data;
struct frame *f = decode_live_frame (frame);
-
- n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f)));
- data = ALLOCATE_PSEUDOVECTOR (struct save_window_data, frame_cols,
- PVEC_WINDOW_CONFIGURATION);
-
+ ptrdiff_t n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f)));
+ struct save_window_data *data
+ = ALLOCATE_PSEUDOVECTOR (struct save_window_data, saved_windows,
+ PVEC_WINDOW_CONFIGURATION);
data->frame_cols = FRAME_COLS (f);
data->frame_lines = FRAME_LINES (f);
data->frame_menu_bar_lines = FRAME_MENU_BAR_LINES (f);
@@ -7407,9 +7409,9 @@ saved by this function. */)
data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window
: Qnil;
data->root_window = FRAME_ROOT_WINDOW (f);
data->focus_frame = FRAME_FOCUS_FRAME (f);
- tem = make_uninit_vector (n_windows);
+ Lisp_Object tem = make_uninit_vector (n_windows);
data->saved_windows = tem;
- for (i = 0; i < n_windows; i++)
+ for (ptrdiff_t i = 0; i < n_windows; i++)
ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window)));
save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0);
XSETWINDOW_CONFIGURATION (tem, data);
diff --git a/src/window.h b/src/window.h
index 4235a6e..fdef407 100644
--- a/src/window.h
+++ b/src/window.h
@@ -212,9 +212,8 @@ struct window
/* The help echo text for this window. Qnil if there's none. */
Lisp_Object mode_line_help_echo;
- /* No Lisp data may follow below this point without changing
- mark_object in alloc.c. The member current_matrix must be the
- first non-Lisp member. */
+ /* No Lisp data may follow this point; mode_line_help_echo must be
+ the last Lisp member. */
/* Glyph matrices. */
struct glyph_matrix *current_matrix;
diff --git a/src/xfns.c b/src/xfns.c
index f238a3d..e521ed1 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -5030,7 +5030,7 @@ Internal use only, use `display-monitor-attributes-list'
instead. */)
mi->mm_height = height_mm;
#if GTK_CHECK_VERSION (3, 22, 0)
- mi->name = g_strdup (gdk_monitor_get_model (monitor));
+ dupstring (&mi->name, (gdk_monitor_get_model (monitor)));
#elif GTK_CHECK_VERSION (2, 14, 0)
mi->name = gdk_screen_get_monitor_plug_name (gscreen, i);
#endif
@@ -5041,6 +5041,11 @@ Internal use only, use `display-monitor-attributes-list'
instead. */)
primary_monitor,
monitor_frames,
source);
+#if GTK_CHECK_VERSION (2, 14, 0)
+ free_monitors (monitors, n_monitors);
+#else
+ xfree (monitors);
+#endif
unblock_input ();
#else /* not USE_GTK */
diff --git a/src/xsettings.c b/src/xsettings.c
index 0c5e36d..947d5cf 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -393,8 +393,8 @@ parse_settings (unsigned char *prop,
unsigned long bytes,
struct xsettings *settings)
{
- Lisp_Object byteorder = Fbyteorder ();
- int my_bo = XFIXNAT (byteorder) == 'B' ? MSBFirst : LSBFirst;
+ int int1 = 1;
+ int my_bo = *(char *) &int1 == 1 ? LSBFirst : MSBFirst;
int that_bo = prop[0];
CARD32 n_settings;
int bytes_parsed = 0;
diff --git a/src/xterm.c b/src/xterm.c
index 1b0c2f5..def6915 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -426,7 +426,7 @@ x_set_cr_source_with_gc_background (struct frame *f, GC gc)
/* Fringe bitmaps. */
static int max_fringe_bmp = 0;
-static cairo_pattern_t **fringe_bmp = 0;
+static cairo_surface_t **fringe_bmp = 0;
static void
x_cr_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd)
@@ -434,13 +434,12 @@ x_cr_define_fringe_bitmap (int which, unsigned short
*bits, int h, int wd)
int i, stride;
cairo_surface_t *surface;
unsigned char *data;
- cairo_pattern_t *pattern;
if (which >= max_fringe_bmp)
{
i = max_fringe_bmp;
max_fringe_bmp = which + 20;
- fringe_bmp = (cairo_pattern_t **) xrealloc (fringe_bmp, max_fringe_bmp *
sizeof (cairo_pattern_t *));
+ fringe_bmp = xrealloc (fringe_bmp, max_fringe_bmp * sizeof
(*fringe_bmp));
while (i < max_fringe_bmp)
fringe_bmp[i++] = 0;
}
@@ -458,12 +457,10 @@ x_cr_define_fringe_bitmap (int which, unsigned short
*bits, int h, int wd)
}
cairo_surface_mark_dirty (surface);
- pattern = cairo_pattern_create_for_surface (surface);
- cairo_surface_destroy (surface);
unblock_input ();
- fringe_bmp[which] = pattern;
+ fringe_bmp[which] = surface;
}
static void
@@ -475,23 +472,20 @@ x_cr_destroy_fringe_bitmap (int which)
if (fringe_bmp[which])
{
block_input ();
- cairo_pattern_destroy (fringe_bmp[which]);
+ cairo_surface_destroy (fringe_bmp[which]);
unblock_input ();
}
fringe_bmp[which] = 0;
}
static void
-x_cr_draw_image (struct frame *f, GC gc, cairo_pattern_t *image,
+x_cr_draw_image (struct frame *f, GC gc, cairo_surface_t *image,
+ int image_width, int image_height,
int src_x, int src_y, int width, int height,
int dest_x, int dest_y, bool overlay_p)
{
- cairo_t *cr;
- cairo_matrix_t matrix;
- cairo_surface_t *surface;
- cairo_format_t format;
+ cairo_t *cr = x_begin_cr_clip (f, gc);
- cr = x_begin_cr_clip (f, gc);
if (overlay_p)
cairo_rectangle (cr, dest_x, dest_y, width, height);
else
@@ -500,21 +494,33 @@ x_cr_draw_image (struct frame *f, GC gc, cairo_pattern_t
*image,
cairo_rectangle (cr, dest_x, dest_y, width, height);
cairo_fill_preserve (cr);
}
- cairo_clip (cr);
- cairo_matrix_init_translate (&matrix, src_x - dest_x, src_y - dest_y);
- cairo_pattern_set_matrix (image, &matrix);
- cairo_pattern_get_surface (image, &surface);
- format = cairo_image_surface_get_format (surface);
+
+ int orig_image_width = cairo_image_surface_get_width (image);
+ if (image_width == 0) image_width = orig_image_width;
+ int orig_image_height = cairo_image_surface_get_height (image);
+ if (image_height == 0) image_height = orig_image_height;
+
+ cairo_pattern_t *pattern = cairo_pattern_create_for_surface (image);
+ cairo_matrix_t matrix;
+ cairo_matrix_init_scale (&matrix, orig_image_width / (double) image_width,
+ orig_image_height / (double) image_height);
+ cairo_matrix_translate (&matrix, src_x - dest_x, src_y - dest_y);
+ cairo_pattern_set_matrix (pattern, &matrix);
+
+ cairo_format_t format = cairo_image_surface_get_format (image);
if (format != CAIRO_FORMAT_A8 && format != CAIRO_FORMAT_A1)
{
- cairo_set_source (cr, image);
+ cairo_set_source (cr, pattern);
cairo_fill (cr);
}
else
{
x_set_cr_source_with_gc_foreground (f, gc);
- cairo_mask (cr, image);
+ cairo_clip (cr);
+ cairo_mask (cr, pattern);
}
+ cairo_pattern_destroy (pattern);
+
x_end_cr_clip (f);
}
@@ -916,16 +922,17 @@ x_set_frame_alpha (struct frame *f)
else
alpha = f->alpha[1];
+ if (alpha < 0.0)
+ return;
+
if (FLOATP (Vframe_alpha_lower_limit))
alpha_min = XFLOAT_DATA (Vframe_alpha_lower_limit);
else if (FIXNUMP (Vframe_alpha_lower_limit))
alpha_min = (XFIXNUM (Vframe_alpha_lower_limit)) / 100.0;
- if (alpha < 0.0)
- return;
- else if (alpha > 1.0)
+ if (alpha > 1.0)
alpha = 1.0;
- else if (0.0 <= alpha && alpha < alpha_min && alpha_min <= 1.0)
+ else if (alpha < alpha_min && alpha_min <= 1.0)
alpha = alpha_min;
opac = alpha * OPAQUE;
@@ -1438,7 +1445,7 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row
*row, struct draw_fring
: f->output_data.x->cursor_pixel)
: face->foreground));
XSetBackground (display, gc, face->background);
- x_cr_draw_image (f, gc, fringe_bmp[p->which], 0, p->dh,
+ x_cr_draw_image (f, gc, fringe_bmp[p->which], 0, 0, 0, p->dh,
p->wd, p->h, p->x, p->y, p->overlay_p);
XSetForeground (display, gc, gcv.foreground);
XSetBackground (display, gc, gcv.background);
@@ -1519,7 +1526,9 @@ static void x_setup_relief_colors (struct glyph_string *);
static void x_draw_image_glyph_string (struct glyph_string *);
static void x_draw_image_relief (struct glyph_string *);
static void x_draw_image_foreground (struct glyph_string *);
+#ifndef USE_CAIRO
static void x_draw_image_foreground_1 (struct glyph_string *, Pixmap);
+#endif
static void x_clear_glyph_string_rect (struct glyph_string *, int,
int, int, int);
static void x_draw_relief_rect (struct frame *, int, int, int, int,
@@ -3043,6 +3052,32 @@ x_draw_image_foreground (struct glyph_string *s)
if (s->slice.y == 0)
y += s->img->vmargin;
+#ifdef USE_CAIRO
+ if (s->img->cr_data)
+ {
+ x_set_glyph_string_clipping (s);
+ x_cr_draw_image (s->f, s->gc,
+ s->img->cr_data, s->img->width, s->img->height,
+ s->slice.x, s->slice.y, s->slice.width, s->slice.height,
+ x, y, true);
+ if (!s->img->mask)
+ {
+ /* When the image has a mask, we can expect that at
+ least part of a mouse highlight or a block cursor will
+ be visible. If the image doesn't have a mask, make
+ a block cursor visible by drawing a rectangle around
+ the image. I believe it's looking better if we do
+ nothing here for mouse-face. */
+ if (s->hl == DRAW_CURSOR)
+ {
+ int relief = eabs (s->img->relief);
+ x_draw_rectangle (s->f, s->gc, x - relief, y - relief,
+ s->slice.width + relief*2 - 1,
+ s->slice.height + relief*2 - 1);
+ }
+ }
+ }
+#else /* ! USE_CAIRO */
if (s->img->pixmap)
{
if (s->img->mask)
@@ -3103,6 +3138,7 @@ x_draw_image_foreground (struct glyph_string *s)
}
}
}
+#endif /* ! USE_CAIRO */
else
/* Draw a rectangle if image could not be loaded. */
x_draw_rectangle (s->f, s->gc, x, y,
@@ -3185,6 +3221,7 @@ x_draw_image_relief (struct glyph_string *s)
}
+#ifndef USE_CAIRO
/* Draw the foreground of image glyph string S to PIXMAP. */
static void
@@ -3257,6 +3294,7 @@ x_draw_image_foreground_1 (struct glyph_string *s, Pixmap
pixmap)
x_draw_rectangle (s->f, s->gc, x, y,
s->slice.width - 1, s->slice.height - 1);
}
+#endif /* ! USE_CAIRO */
/* Draw part of the background of glyph string S. X, Y, W, and H
@@ -3316,6 +3354,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
|| s->img->pixmap == 0
|| s->width != s->background_width)
{
+#ifndef USE_CAIRO
if (s->img->mask)
{
/* Create a pixmap as large as the glyph string. Fill it
@@ -3356,6 +3395,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
}
}
else
+#endif /* ! USE_CAIRO */
{
int x = s->x;
int y = s->y;
@@ -3378,25 +3418,8 @@ x_draw_image_glyph_string (struct glyph_string *s)
}
/* Draw the foreground. */
-#ifdef USE_CAIRO
- if (s->img->cr_data)
- {
- cairo_t *cr = x_begin_cr_clip (s->f, s->gc);
-
- int x = s->x + s->img->hmargin;
- int y = s->y + s->img->vmargin;
- int width = s->background_width;
-
- cairo_set_source_surface (cr, s->img->cr_data,
- x - s->slice.x,
- y - s->slice.y);
- cairo_rectangle (cr, x, y, width, height);
- cairo_fill (cr);
- x_end_cr_clip (s->f);
- }
- else
-#endif
- if (pixmap != None)
+#ifndef USE_CAIRO
+ if (pixmap != None)
{
x_draw_image_foreground_1 (s, pixmap);
x_set_glyph_string_clipping (s);
@@ -3405,6 +3428,7 @@ x_draw_image_glyph_string (struct glyph_string *s)
XFreePixmap (s->display, pixmap);
}
else
+#endif /* ! USE_CAIRO */
x_draw_image_foreground (s);
/* If we must draw a relief around the image, do it. */
@@ -4315,7 +4339,6 @@ x_scroll_run (struct window *w, struct run *run)
#ifdef USE_CAIRO
if (FRAME_CR_CONTEXT (f))
{
- int wx = WINDOW_LEFT_EDGE_X (w);
cairo_surface_t *s = cairo_image_surface_create (CAIRO_FORMAT_ARGB32,
width, height);
cairo_t *cr = cairo_create (s);
@@ -4326,8 +4349,8 @@ x_scroll_run (struct window *w, struct run *run)
cr = FRAME_CR_CONTEXT (f);
cairo_save (cr);
- cairo_set_source_surface (cr, s, wx, to_y);
- cairo_rectangle (cr, wx, to_y, width, height);
+ cairo_set_source_surface (cr, s, x, to_y);
+ cairo_rectangle (cr, x, to_y, width, height);
cairo_fill (cr);
cairo_restore (cr);
cairo_surface_destroy (s);
@@ -5321,7 +5344,7 @@ x_window_to_scroll_bar (Display *display, Window
window_id, int type)
bar = XSCROLL_BAR (bar)->next)
if (XSCROLL_BAR (bar)->x_window == window_id
&& FRAME_X_DISPLAY (XFRAME (frame)) == display
- && (type = 2
+ && (type == 2
|| (type == 1 && XSCROLL_BAR (bar)->horizontal)
|| (type == 0 && !XSCROLL_BAR (bar)->horizontal)))
return XSCROLL_BAR (bar);
@@ -6589,8 +6612,8 @@ x_scroll_bar_create (struct window *w, int top, int left,
int width, int height, bool horizontal)
{
struct frame *f = XFRAME (w->frame);
- struct scroll_bar *bar
- = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER);
+ struct scroll_bar *bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev,
+ PVEC_OTHER);
Lisp_Object barobj;
block_input ();
diff --git a/src/xterm.h b/src/xterm.h
index 972a10f..c5ad386 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -897,7 +897,7 @@ struct scroll_bar
/* The next and previous in the chain of scroll bars in this frame. */
Lisp_Object next, prev;
- /* Fields from `x_window' down will not be traced by the GC. */
+ /* Fields after 'prev' are not traced by the GC. */
/* The X window representing this scroll bar. */
Window x_window;
diff --git a/src/xwidget.c b/src/xwidget.c
index c562849..2486a2d 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -41,14 +41,13 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
static struct xwidget *
allocate_xwidget (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct xwidget, height, PVEC_XWIDGET);
+ return ALLOCATE_PSEUDOVECTOR (struct xwidget, script_callbacks,
PVEC_XWIDGET);
}
static struct xwidget_view *
allocate_xwidget_view (void)
{
- return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, redisplayed,
- PVEC_XWIDGET_VIEW);
+ return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, w, PVEC_XWIDGET_VIEW);
}
#define XSETXWIDGET(a, b) XSETPSEUDOVECTOR (a, b, PVEC_XWIDGET)
diff --git a/src/xwidget.h b/src/xwidget.h
index 8c598ef..1b6368d 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -49,8 +49,7 @@ struct xwidget
/* Vector of currently executing scripts with callbacks. */
Lisp_Object script_callbacks;
-
- /* Here ends the Lisp part. "height" is the marker field. */
+ /* Here ends the Lisp part. script_callbacks is the marker field. */
int height;
int width;
@@ -68,8 +67,7 @@ struct xwidget_view
union vectorlike_header header;
Lisp_Object model;
Lisp_Object w;
-
- /* Here ends the lisp part. "redisplayed" is the marker field. */
+ /* Here ends the lisp part. "w" is the marker field. */
/* If touched by redisplay. */
bool redisplayed;
diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el
new file mode 100644
index 0000000..d54a992
--- /dev/null
+++ b/test/lisp/button-tests.el
@@ -0,0 +1,40 @@
+;;; button-tests.el --- tests for button.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest button-at ()
+ "Test `button-at' behavior."
+ (with-temp-buffer
+ (should-not (button-at (point)))
+ (let ((button (insert-text-button "text button"))
+ (marker (button-at (1- (point)))))
+ (should (markerp marker))
+ (should (= (button-end button) (button-end marker) (point))))
+ (let ((button (insert-button "overlay button"))
+ (overlay (button-at (1- (point)))))
+ (should (overlayp overlay))
+ (should (eq button overlay)))
+ ;; Buttons and widgets are incompatible (bug#34506).
+ (widget-create 'link "link widget")
+ (should-not (button-at (1- (point))))))
+
+;;; button-tests.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el
b/test/lisp/emacs-lisp/pcase-tests.el
index 1e9d37f..af8c9a3 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -51,11 +51,13 @@
(ert-deftest pcase-tests-member ()
(should (pcase-tests-grep
- 'memq (macroexpand-all '(pcase x ((or 1 2 3) body)))))
+ 'memql (macroexpand-all '(pcase x ((or 1 2 3) body)))))
(should (pcase-tests-grep
'member (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
(should-not (pcase-tests-grep
'memq (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
+ (should-not (pcase-tests-grep
+ 'memql (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
(let ((exp (macroexpand-all
'(pcase x
("a" body1)
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 5003620..842d66d 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -266,9 +266,8 @@ This returns only for the local case and gfilenotify;
otherwise it is nil.
(declare (indent 1))
`(ert-deftest ,(intern (concat (symbol-name test) "-remote")) ()
,docstring
- :tags '(:expensive-test)
:expected-result (or ,expected :passed)
- (skip-unless (not ,skip))
+ :tags ,(if skip ''(:expensive-test :unstable) ''(:expensive-test))
(let* ((temporary-file-directory
file-notify-test-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
diff --git a/test/lisp/gnus/gnus-test-headers.el
b/test/lisp/gnus/gnus-test-headers.el
index 805a300..abf3d4f 100644
--- a/test/lisp/gnus/gnus-test-headers.el
+++ b/test/lisp/gnus/gnus-test-headers.el
@@ -1,21 +1,23 @@
;;; gnus-test-headers.el --- Tests for Gnus header-related functions -*-
lexical-binding: t; -*-
-;; Copyright (C) 2018 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2019 Free Software Foundation, Inc.
;; Author: Eric Abrahamsen <address@hidden>
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/mail/rmail-tests.el b/test/lisp/mail/rmail-tests.el
index 00f4583..3a0fdbc 100644
--- a/test/lisp/mail/rmail-tests.el
+++ b/test/lisp/mail/rmail-tests.el
@@ -23,7 +23,7 @@
(ert-deftest rmail-autoload ()
- "Tests to see whether reftex-auc has been autoloaded"
+ "Test that `rmail-edit-current-message' has been autoloaded."
(should
(fboundp 'rmail-edit-current-message))
(should
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 34b676e..cc3200b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2013,9 +2013,9 @@ properly. BODY shall not contain a timeout."
(expand-file-name "/method:host:/:/~/path/./file")
"/method:host:/:/~/path/file")))
-;; The following test is inspired by Bug#26911. It is rather a bug in
-;; `expand-file-name', and it fails for all Emacs versions. Test
-;; added for later, when it is fixed.
+;; The following test is inspired by Bug#26911 and Bug#34834. They
+;; are rather bugs in `expand-file-name', and it fails for all Emacs
+;; versions. Test added for later, when they are fixed.
(ert-deftest tramp-test05-expand-file-name-relative ()
"Check `expand-file-name'."
;; Mark as failed until bug has been fixed.
@@ -3849,12 +3849,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
+
+ ;; Simple process.
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test1" (current-buffer) "cat"))
@@ -3866,11 +3868,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ ;; We cannot use `string-equal', because tramp-adb.el
+ ;; echoes also the sent string.
+ (should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
+ ;; Simple process using a file.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
@@ -3891,6 +3896,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(delete-process proc)
(delete-file tmp-name)))
+ ;; Process filter.
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test3" (current-buffer) "cat"))
@@ -3905,7 +3911,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ ;; We cannot use `string-equal', because tramp-adb.el
+ ;; echoes also the sent string.
+ (should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc))))))
@@ -3914,9 +3922,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ ;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
+ (tramp--test-instrument-test-case 0
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
@@ -3938,7 +3948,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ ;; We cannot use `string-equal', because tramp-adb.el
+ ;; echoes also the sent string.
+ (should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -3981,9 +3993,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
- (while (< (- (point-max) (point-min)) (length "foo"))
+ (while (not (string-match "foo" (buffer-string)))
(while (accept-process-output proc 0 nil t))))
- (should (string-equal (buffer-string) "foo")))
+ ;; We cannot use `string-equal', because tramp-adb.el
+ ;; echoes also the sent string.
+ (should (string-match "\\`foo" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4006,33 +4020,37 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
- (should (string-equal (buffer-string) "killed\n")))
+ ;; We cannot use `string-equal', because tramp-adb.el
+ ;; echoes also the sent string.
+ (should (string-match "killed\n\\'" (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
- ;; Process with stderr.
- (let ((stderr (generate-new-buffer (generate-new-buffer-name "stderr"))))
- (unwind-protect
- (with-temp-buffer
- (setq proc
- (make-process
- :name "test5" :buffer (current-buffer)
- :command '("cat" "/")
- :stderr stderr
- :file-handler t))
- (should (processp proc))
- ;; Read stderr.
- (with-current-buffer stderr
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (= (point-min) (point-max))
- (while (accept-process-output proc 0 nil t))))
- (should
- (string-equal (buffer-string) "cat: /: Is a directory\n"))))
+ ;; Process with stderr. tramp-adb.el doesn't support it (yet).
+ (unless (tramp--test-adb-p)
+ (let ((stderr
+ (generate-new-buffer (generate-new-buffer-name "stderr"))))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (make-process
+ :name "test5" :buffer (current-buffer)
+ :command '("cat" "/")
+ :stderr stderr
+ :file-handler t))
+ (should (processp proc))
+ ;; Read stderr.
+ (with-current-buffer stderr
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (= (point-min) (point-max))
+ (while (accept-process-output proc 0 nil t))))
+ (should
+ (string-match "^cat:.* Is a directory" (buffer-string)))))
- ;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (kill-buffer stderr)))))))
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (kill-buffer stderr)))))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
@@ -4096,8 +4114,6 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-file tmp-name)))
- ;; tramp-adb.el is not fit yet for asynchronous processes.
- (unless (tramp--test-adb-p)
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
@@ -4124,10 +4140,8 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(buffer-string))))
;; Cleanup.
- (ignore-errors (delete-file tmp-name))))
+ (ignore-errors (delete-file tmp-name)))
- ;; tramp-adb.el is not fit yet for asynchronous processes.
- (unless (tramp--test-adb-p)
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
@@ -4155,7 +4169,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(buffer-string))))
;; Cleanup.
- (ignore-errors (delete-file tmp-name)))))))
+ (ignore-errors (delete-file tmp-name))))))
(defun tramp--test-shell-command-to-string-asynchronously (command)
"Like `shell-command-to-string', but for asynchronous processes."
@@ -4352,7 +4366,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
"Check that connection-local `explicit-shell-file-name' is set."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
+ ;; remote processes in Emacs. That doesn't work for tramp-adb.el.
+ (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
+ (tramp--test-sh-p)))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
(fboundp 'connection-local-set-profiles)))
@@ -4366,15 +4383,16 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(unwind-protect
(progn
;; `shell-mode' would ruin our test, because it deletes all
- ;; buffer local variables.
+ ;; buffer local variables. Not needed in Emacs 27.1.
(put 'explicit-shell-file-name 'permanent-local t)
- ;; Declare connection-local variable `explicit-shell-file-name'.
+ ;; Declare connection-local variables `explicit-shell-file-name'
+ ;; and `explicit-sh-args'.
(with-no-warnings
(connection-local-set-profile-variables
'remote-sh
`((explicit-shell-file-name
. ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
- (explicit-sh-args . ("-i"))))
+ (explicit-sh-args . ("-c" "echo foo"))))
(connection-local-set-profiles
`(:application tramp
:protocol ,(file-remote-p default-directory 'method)
@@ -4384,14 +4402,18 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(put 'explicit-shell-file-name 'safe-local-variable #'identity)
(put 'explicit-sh-args 'safe-local-variable #'identity)
- ;; Run interactive shell. Since the default directory is
- ;; remote, `explicit-shell-file-name' shall be set in order
- ;; to avoid a question.
+ ;; Run `shell' interactively. Since the default directory
+ ;; is remote, `explicit-shell-file-name' shall be set in
+ ;; order to avoid a question. `explicit-sh-args' echoes the
+ ;; test data.
(with-current-buffer (get-buffer-create "*shell*")
(ignore-errors (kill-process (current-buffer)))
(should-not explicit-shell-file-name)
(call-interactively #'shell)
- (should explicit-shell-file-name)))
+ (with-timeout (10)
+ (while (accept-process-output
+ (get-buffer-process (current-buffer)) nil nil t)))
+ (should (string-match "^foo$" (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
@@ -4557,7 +4579,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; skip the test then.
(condition-case nil
(vc-create-repo (car vc-handled-backends))
- (error (skip-unless nil)))
+ (error (ert-skip "`vc-create-repo' not supported")))
;; The structure of VC-FILESET is not documented. Let's
;; hope it won't change.
(condition-case nil
@@ -5345,20 +5367,17 @@ process sentinels. They shall not disturb each other."
;; we mark it as unstable.
:tags '(:expensive-test :unstable)
(skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
- ;; This test is sensible wrt to other running tests. Let it work
- ;; only if it is the only selected test.
- ;; FIXME: There must be a better solution.
- (skip-unless
- (= 1 (length
- (ert-select-tests (ert--stats-selector ert--current-run-stats) t))))
+ ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
+ ;; remote processes in Emacs. That doesn't work for tramp-adb.el.
+ (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
+ (tramp--test-sh-p)))
(with-timeout
(tramp--test-asynchronous-requests-timeout (tramp--test-timeout-handler))
(define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
(let* (;; For the watchdog.
(default-directory (expand-file-name temporary-file-directory))
- (shell-file-name "/bin/sh")
+ (shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
(watchdog
(start-process-shell-command
"*watchdog*" nil
@@ -5458,7 +5477,7 @@ process sentinels. They shall not disturb each other."
"Process filter %s %s %s" proc string
(current-time-string))
(with-current-buffer (process-buffer proc)
(insert string))
- (unless (zerop (length string))
+ (when (< (process-get proc 'bar) 2)
(dired-uncache (process-get proc 'foo))
(should (file-attributes (process-get proc 'foo))))))
;; Add process sentinel. It shall not perform remote
@@ -5511,7 +5530,12 @@ process sentinels. They shall not disturb each other."
(dolist (buf buffers)
(with-current-buffer buf
(should
- (string-equal (format "%s\n%s\n" buf buf) (buffer-string)))))
+ (string-equal
+ ;; tramp-adb.el echoes, so we must add the three strings.
+ (if (tramp--test-adb-p)
+ (format "%s\n%s\n%s\n%s\n%s\n" buf buf buf buf buf)
+ (format "%s\n%s\n" buf buf))
+ (buffer-string)))))
(should-not
(directory-files
tmp-name nil directory-files-no-dot-files-regexp)))
@@ -5712,10 +5736,9 @@ Since it unloads Tramp, it shall be the last test to
run."
;; do not work properly for `nextcloud'.
;; * Fix `tramp-test29-start-file-process' and
;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
-;; * Fix `tramp-test29-start-file-process',
-;; `tramp-test30-make-process' and `tramp-test32-shell-command' for
-;; `adb' (see comment in `tramp-adb-send-command').
-;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.
+;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. Looks
+;; like it is resolved now. Remove `:unstable' tag?
+;; * Implement `tramp-test31-interrupt-process' for `adb'.
(provide 'tramp-tests)
;;; tramp-tests.el ends here
diff --git a/test/lisp/progmodes/flymake-tests.el
b/test/lisp/progmodes/flymake-tests.el
index 629cdf9..7321934 100644
--- a/test/lisp/progmodes/flymake-tests.el
+++ b/test/lisp/progmodes/flymake-tests.el
@@ -142,6 +142,8 @@ SEVERITY-PREDICATE is used to setup
(ert-deftest different-diagnostic-types ()
"Test GCC warning via function predicate."
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2019-03/msg01043.html
+ :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed)
(skip-unless (and (executable-find "gcc")
(version<=
"5" (string-trim
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 94c846e..b940f45 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -5345,13 +5345,23 @@ class SomeClass:
(ert-deftest python-tests--python-nav-end-of-statement--infloop ()
"Checks that `python-nav-end-of-statement' doesn't infloop in a
buffer with overlapping strings."
+ ;; FIXME: The treatment of strings has changed in the mean time, and the
+ ;; test below now neither signals an error nor inf-loops.
+ ;; The description of the problem it's trying to catch is not clear enough
+ ;; to be able to see if the underlying problem is really fixed, sadly.
+ ;; E.g. I don't know what is meant by "overlap", really.
+ :tags '(:unstable)
(python-tests-with-temp-buffer "''' '\n''' ' '\n"
(syntax-propertize (point-max))
;; Create a situation where strings nominally overlap. This
;; shouldn't happen in practice, but apparently it can happen when
;; a package calls `syntax-ppss' in a narrowed buffer during JIT
;; lock.
+ ;; FIXME: 4-5 is the SPC right after the opening triple quotes: why
+ ;; put a string-fence syntax on it?
(put-text-property 4 5 'syntax-table (string-to-syntax "|"))
+ ;; FIXME: 8-9 is the middle quote in the closing triple quotes:
+ ;; it shouldn't have any syntax-table property to remove anyway!
(remove-text-properties 8 9 '(syntax-table nil))
(goto-char 4)
(setq-local syntax-propertize-function nil)
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index d9f059c..cc2feeb 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -22,6 +22,11 @@
(require 'ert)
(eval-when-compile (require 'cl-lib))
+(defun simple-test--buffer-substrings ()
+ "Return cons of buffer substrings before and after point."
+ (cons (buffer-substring (point-min) (point))
+ (buffer-substring (point) (point-max))))
+
(defmacro simple-test--dummy-buffer (&rest body)
(declare (indent 0)
(debug t))
@@ -31,10 +36,7 @@
(insert "(a b")
(save-excursion (insert " c d)"))
,@body
- (with-no-warnings
- (cons (buffer-substring (point-min) (point))
- (buffer-substring (point) (point-max))))))
-
+ (with-no-warnings (simple-test--buffer-substrings))))
;;; `transpose-sexps'
@@ -46,8 +48,7 @@
(insert "(s1) (s2) (s3) (s4) (s5)")
(backward-sexp 1)
,@body
- (cons (buffer-substring (point-min) (point))
- (buffer-substring (point) (point-max)))))
+ (simple-test--buffer-substrings)))
;;; Transposition with negative args (bug#20698, bug#21885)
(ert-deftest simple-transpose-subr ()
@@ -215,37 +216,144 @@
;;; `delete-indentation'
+
(ert-deftest simple-delete-indentation-no-region ()
- "delete-indentation works when no mark is set."
- ;; interactive \r returns nil for BEG END args
- (unwind-protect
- (with-temp-buffer
- (insert (concat "zero line \n"
- "first line \n"
- "second line"))
- (delete-indentation)
- (should (string-equal
- (buffer-string)
- (concat "zero line \n"
- "first line second line")))
- )))
+ "Test `delete-indentation' when no mark is set; see bug#35021."
+ (with-temp-buffer
+ (insert " first \n second \n third \n fourth ")
+ (should-not (mark t))
+ ;; Without prefix argument.
+ (should-not (call-interactively #'delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first \n second \n third" . " fourth ")))
+ (should-not (call-interactively #'delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first \n second" . " third fourth ")))
+ ;; With prefix argument.
+ (goto-char (point-min))
+ (let ((current-prefix-arg '(4)))
+ (should-not (call-interactively #'delete-indentation)))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first" . " second third fourth ")))))
(ert-deftest simple-delete-indentation-inactive-region ()
- "delete-indentation ignores inactive region."
- ;; interactive \r returns non-nil for BEG END args
- (unwind-protect
- (with-temp-buffer
- (insert (concat "zero line \n"
- "first line \n"
- "second line"))
- (push-mark (point-min) t t)
- (deactivate-mark)
- (delete-indentation)
- (should (string-equal
- (buffer-string)
- (concat "zero line \n"
- "first line second line")))
- )))
+ "Test `delete-indentation' with an inactive region."
+ (with-temp-buffer
+ (insert " first \n second \n third ")
+ (set-marker (mark-marker) (point-min))
+ (should (mark t))
+ (should-not (call-interactively #'delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first \n second" . " third ")))))
+
+(ert-deftest simple-delete-indentation-blank-line ()
+ "Test `delete-indentation' does not skip blank lines.
+See bug#35036."
+ (with-temp-buffer
+ (insert "\n\n third \n \n \n sixth \n\n")
+ ;; Without prefix argument.
+ (should-not (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("\n\n third \n \n \n sixth \n" . "")))
+ (should-not (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("\n\n third \n \n \n sixth" . "")))
+ (should-not (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("\n\n third \n \n" . "sixth")))
+ ;; With prefix argument.
+ (goto-char (point-min))
+ (should-not (delete-indentation t))
+ (should (equal (simple-test--buffer-substrings)
+ '("" . "\n third \n \nsixth")))
+ (should-not (delete-indentation t))
+ (should (equal (simple-test--buffer-substrings)
+ '("" . "third \n \nsixth")))
+ (should-not (delete-indentation t))
+ (should (equal (simple-test--buffer-substrings)
+ '("third" . "\nsixth")))
+ (should-not (delete-indentation t))
+ (should (equal (simple-test--buffer-substrings)
+ '("third" . " sixth")))))
+
+(ert-deftest simple-delete-indentation-boundaries ()
+ "Test `delete-indentation' motion at buffer boundaries."
+ (with-temp-buffer
+ (insert " first \n second \n third ")
+ ;; Stay at EOB.
+ (should-not (delete-indentation t))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first \n second \n third " . "")))
+ ;; Stay at BOB.
+ (forward-line -1)
+ (save-restriction
+ (narrow-to-region (point) (line-end-position))
+ (should-not (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("" . " second ")))
+ ;; Go to EOB.
+ (should-not (delete-indentation t))
+ (should (equal (simple-test--buffer-substrings)
+ '(" second " . ""))))
+ ;; Go to BOB.
+ (end-of-line 0)
+ (should-not (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("" . " first \n second \n third ")))))
+
+(ert-deftest simple-delete-indentation-region ()
+ "Test `delete-indentation' with an active region."
+ (with-temp-buffer
+ ;; Empty region.
+ (insert " first ")
+ (should-not (delete-indentation nil (point) (point)))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first " . "")))
+ ;; Single line.
+ (should-not (delete-indentation
+ nil (line-beginning-position) (1- (point))))
+ (should (equal (simple-test--buffer-substrings)
+ '("" . " first ")))
+ (should-not (delete-indentation nil (1+ (point)) (line-end-position)))
+ (should (equal (simple-test--buffer-substrings)
+ '(" " . "first ")))
+ (should-not (delete-indentation
+ nil (line-beginning-position) (line-end-position)))
+ (should (equal (simple-test--buffer-substrings)
+ '("" . " first ")))
+ ;; Multiple lines.
+ (goto-char (point-max))
+ (insert "\n second \n third \n fourth ")
+ (goto-char (point-min))
+ (should-not (delete-indentation
+ nil (line-end-position) (line-beginning-position 2)))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first" . " second \n third \n fourth ")))
+ (should-not (delete-indentation
+ nil (point) (1+ (line-beginning-position 2))))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first second" . " third \n fourth ")))
+ ;; Prefix argument overrides region.
+ (should-not (delete-indentation t (point-min) (point)))
+ (should (equal (simple-test--buffer-substrings)
+ '(" first second third" . " fourth ")))))
+
+(ert-deftest simple-delete-indentation-prefix ()
+ "Test `delete-indentation' with a fill prefix."
+ (with-temp-buffer
+ (insert "> first \n> second \n> third \n> fourth ")
+ (let ((fill-prefix ""))
+ (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("> first \n> second \n> third" . " > fourth ")))
+ (let ((fill-prefix "<"))
+ (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("> first \n> second" . " > third > fourth ")))
+ (let ((fill-prefix ">"))
+ (delete-indentation))
+ (should (equal (simple-test--buffer-substrings)
+ '("> first" . " second > third > fourth ")))))
;;; `delete-trailing-whitespace'
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 7465aac..c458eef 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -318,24 +318,6 @@ cf. Bug#25477."
(should (eq (string-to-char (symbol-name (gensym))) ?g))
(should (eq (string-to-char (symbol-name (gensym "X"))) ?X)))
-(ert-deftest subr-tests--proper-list-p ()
- "Test `proper-list-p' behavior."
- (dotimes (length 4)
- ;; Proper and dotted lists.
- (let ((list (make-list length 0)))
- (should (= (proper-list-p list) length))
- (should (not (proper-list-p (nconc list 0)))))
- ;; Circular lists.
- (dotimes (n (1+ length))
- (let ((circle (make-list (1+ length) 0)))
- (should (not (proper-list-p (nconc circle (nthcdr n circle))))))))
- ;; Atoms.
- (should (not (proper-list-p 0)))
- (should (not (proper-list-p "")))
- (should (not (proper-list-p [])))
- (should (not (proper-list-p (make-bool-vector 0 nil))))
- (should (not (proper-list-p (make-symbol "a")))))
-
(ert-deftest subr-tests--assq-delete-all ()
"Test `assq-delete-all' behavior."
(cl-flet ((new-list-fn
diff --git a/test/lisp/mail/rmail-tests.el b/test/lisp/wid-edit-tests.el
similarity index 51%
copy from test/lisp/mail/rmail-tests.el
copy to test/lisp/wid-edit-tests.el
index 00f4583..a4350e71 100644
--- a/test/lisp/mail/rmail-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -1,6 +1,6 @@
-;;; rmail-tests.el --- Test suite. -*- lexical-binding: t -*-
+;;; wid-edit-tests.el --- tests for wid-edit.el -*- lexical-binding: t -*-
-;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2019 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -18,18 +18,22 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
-(require 'ert)
-(require 'rmail)
-
-(ert-deftest rmail-autoload ()
- "Tests to see whether reftex-auc has been autoloaded"
- (should
- (fboundp 'rmail-edit-current-message))
- (should
- (autoloadp
- (symbol-function
- 'rmail-edit-current-message))))
-
-(provide 'rmail-tests)
-;; rmail-tests.el ends here
+(require 'ert)
+(require 'wid-edit)
+
+(ert-deftest widget-at ()
+ "Test `widget-at' behavior."
+ (with-temp-buffer
+ (should-not (widget-at))
+ (let ((marco (widget-create 'link "link widget"))
+ (polo (widget-at (1- (point)))))
+ (should (widgetp polo))
+ (should (eq marco polo)))
+ ;; Buttons and widgets are incompatible (bug#34506).
+ (insert-text-button "text button")
+ (should-not (widget-at (1- (point))))
+ (insert-button "overlay button")
+ (should-not (widget-at (1- (point))))))
+
+;;; wid-edit-tests.el ends here
diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js
deleted file mode 100644
index 7401939..0000000
--- a/test/manual/indent/js-jsx.js
+++ /dev/null
@@ -1,85 +0,0 @@
-// -*- mode: js-jsx; -*-
-
-var foo = <div></div>;
-
-return (
- <div>
- </div>
- <div>
- <div></div>
- <div>
- <div></div>
- </div>
- </div>
-);
-
-React.render(
- <div>
- <div></div>
- </div>,
- {
- a: 1
- },
- <div>
- <div></div>
- </div>
-);
-
-return (
- // Sneaky!
- <div></div>
-);
-
-return (
- <div></div>
- // Sneaky!
-);
-
-React.render(
- <input
- />,
- {
- a: 1
- }
-);
-
-return (
- <div>
- {array.map(function () {
- return {
- a: 1
- };
- })}
- </div>
-);
-
-return (
- <div attribute={array.map(function () {
- return {
- a: 1
- };
-
- return {
- a: 1
- };
-
- return {
- a: 1
- };
- })}>
- </div>
-);
-
-// Local Variables:
-// indent-tabs-mode: nil
-// js-indent-level: 2
-// End:
-
-// The following test has intentionally unclosed elements and should
-// be placed below all other tests to prevent awkward indentation.
-
-return (
- <div>
- {array.map(function () {
- return {
- a: 1
diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js
index 647d743..9658c95 100644
--- a/test/manual/indent/js.js
+++ b/test/manual/indent/js.js
@@ -160,6 +160,11 @@ foo.bar.baz(very => // A comment
snorf
);
+// Continuation of bug#25904; support broken arrow as N+1th arg
+map(arr, (val) =>
+ val
+)
+
// Local Variables:
// indent-tabs-mode: nil
// js-indent-level: 2
diff --git a/test/manual/indent/jsx-align-gt-with-lt.jsx
b/test/manual/indent/jsx-align-gt-with-lt.jsx
new file mode 100644
index 0000000..8eb1d6d
--- /dev/null
+++ b/test/manual/indent/jsx-align-gt-with-lt.jsx
@@ -0,0 +1,12 @@
+<element
+ attr=""
+ >
+</element>
+<input
+ />
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// js-jsx-align->-with-<: nil
+// End:
diff --git a/test/manual/indent/jsx-indent-level.jsx
b/test/manual/indent/jsx-indent-level.jsx
new file mode 100644
index 0000000..0a84b9e
--- /dev/null
+++ b/test/manual/indent/jsx-indent-level.jsx
@@ -0,0 +1,13 @@
+return (
+ <element>
+ <element>
+ Hello World!
+ </element>
+ </element>
+)
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 4
+// js-jsx-indent-level: 2
+// End:
diff --git a/test/manual/indent/jsx-quote.jsx b/test/manual/indent/jsx-quote.jsx
new file mode 100644
index 0000000..1b2c652
--- /dev/null
+++ b/test/manual/indent/jsx-quote.jsx
@@ -0,0 +1,16 @@
+// JSX text node values should be strings, but only JS string syntax
+// is considered, so quote marks delimit strings like normal, with
+// disastrous results (https://github.com/mooz/js2-mode/issues/409).
+function Bug() {
+ return <div>C'est Montréal</div>;
+}
+function Test(foo = /'/,
+ bar = 123) {}
+
+// This test is in a separate file because it can break other tests
+// when indenting the whole buffer (not sure why).
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
diff --git a/test/manual/indent/jsx-self-closing.jsx
b/test/manual/indent/jsx-self-closing.jsx
new file mode 100644
index 0000000..f8ea7a1
--- /dev/null
+++ b/test/manual/indent/jsx-self-closing.jsx
@@ -0,0 +1,13 @@
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
+
+// The following test goes below any comments to avoid including
+// misindented comments among the erroring lines.
+
+// Properly parse/indent code with a self-closing tag inside the
+// attribute of another self-closing tag.
+<div>
+ <div attr={() => <div attr="" />} />
+</div>
diff --git a/test/manual/indent/jsx-unclosed-1.jsx
b/test/manual/indent/jsx-unclosed-1.jsx
new file mode 100644
index 0000000..1f5c3fb
--- /dev/null
+++ b/test/manual/indent/jsx-unclosed-1.jsx
@@ -0,0 +1,13 @@
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
+
+// The following test goes below any comments to avoid including
+// misindented comments among the erroring lines.
+
+return (
+ <div>
+ {array.map(function () {
+ return {
+ a: 1
diff --git a/test/manual/indent/jsx-unclosed-2.jsx
b/test/manual/indent/jsx-unclosed-2.jsx
new file mode 100644
index 0000000..fb665b9
--- /dev/null
+++ b/test/manual/indent/jsx-unclosed-2.jsx
@@ -0,0 +1,65 @@
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
+
+// The following tests go below any comments to avoid including
+// misindented comments among the erroring lines.
+
+// Don’t misinterpret inequality operators as JSX.
+for (; i < length;) void 0
+if (foo > bar) void 0
+
+// Don’t misintrepet inequalities within JSX, either.
+<div>
+ {foo < bar}
+</div>
+
+// Don’t even misinterpret unary operators as JSX.
+if (foo < await bar) void 0
+while (await foo > bar) void 0
+
+<div>
+ {foo < await bar}
+</div>
+
+// Allow unary keyword names as null-valued JSX attributes.
+// (As if this will EVER happen…)
+<Foo yield>
+ <Bar void>
+ <Baz
+ zorp
+ typeof>
+ <Please do_n0t delete this_stupidTest >
+ How would we ever live without unary support
+ </Please>
+ </Baz>
+ </Bar>
+</Foo>
+
+// “-” is not allowed in a JSXBoundaryElement’s name.
+<ABC />
+ <A-B-C /> // Weirdly-indented “continued expression.”
+
+// “-” may be used in a JSXAttribute’s name.
+<Foo a-b-c=""
+ x-y-z="" />
+
+// Weird spaces should be tolerated.
+< div >
+ < div >
+ < div
+ attr=""
+ / >
+ < div
+ attr=""
+ / >
+ < / div>
+< / div >
+
+// Non-ASCII identifiers are acceptable.
+<Über>
+ <Québec διακριτικός sueño="">
+ Guten Tag!
+ </Québec>
+</Über>
diff --git a/test/manual/indent/jsx.jsx b/test/manual/indent/jsx.jsx
new file mode 100644
index 0000000..c200979
--- /dev/null
+++ b/test/manual/indent/jsx.jsx
@@ -0,0 +1,314 @@
+var foo = <div></div>;
+
+return (
+ <div>
+ </div>
+ <div>
+ <div></div>
+ <div>
+ <div></div>
+ </div>
+ </div>
+);
+
+React.render(
+ <div>
+ <div></div>
+ </div>,
+ {
+ a: 1
+ },
+ <div>
+ <div></div>
+ </div>
+);
+
+return (
+ // Sneaky!
+ <div></div>
+);
+
+return (
+ <div></div>
+ // Sneaky!
+);
+
+React.render(
+ <input
+ />,
+ {
+ a: 1
+ }
+);
+
+return (
+ <div>
+ {array.map(function () {
+ return {
+ a: 1
+ };
+ })}
+ </div>
+);
+
+return (
+ <div attribute={array.map(function () {
+ return {
+ a: 1
+ };
+
+ return {
+ a: 1
+ };
+
+ return {
+ a: 1
+ };
+ })}>
+ </div>
+);
+
+return (
+ <div attribute={{
+ a: 1, // Indent relative to “attribute” column.
+ b: 2
+ } && { // Dedent to “attribute” column.
+ a: 1,
+ b: 2
+ }} /> // Also dedent.
+);
+
+return (
+ <div attribute=
+ { // Indent properly on another line, too.
+ {
+ a: 1,
+ b: 2,
+ } && (
+ // Indent other forms, too.
+ a ? b :
+ c ? d :
+ e
+ )
+ } />
+)
+
+// JSXMemberExpression names are parsed/indented:
+<Foo.Bar>
+ <div>
+ <Foo.Bar>
+ Hello World!
+ </Foo.Bar>
+ <Foo.Bar>
+ <div>
+ </div>
+ </Foo.Bar>
+ </div>
+</Foo.Bar>
+
+// JSXOpeningFragment and JSXClosingFragment are parsed/indented:
+<>
+ <div>
+ <>
+ Hello World!
+ </>
+ <>
+ <div>
+ </div>
+ </>
+ </div>
+</>
+
+// Indent void expressions (no need for contextual parens / commas)
+// (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016).
+<div className="class-name">
+ <h2>Title</h2>
+ {array.map(() => {
+ return <Element />;
+ })}
+ {message}
+</div>
+// Another example of above issue
+// (https://github.com/mooz/js2-mode/issues/490).
+<App>
+ <div>
+ {variable1}
+ <Component/>
+ </div>
+</App>
+
+// Comments and arrows can break indentation (Bug#24896 /
+// https://github.com/mooz/js2-mode/issues/389).
+const Component = props => (
+ <FatArrow a={e => c}
+ b={123}>
+ </FatArrow>
+);
+const Component = props => (
+ <NoFatArrow a={123}
+ b={123}>
+ </NoFatArrow>
+);
+const Component = props => ( // Parse this comment, please.
+ <FatArrow a={e => c}
+ b={123}>
+ </FatArrow>
+);
+const Component = props => ( // Parse this comment, please.
+ <NoFatArrow a={123}
+ b={123}>
+ </NoFatArrow>
+);
+// Another example of above issue (Bug#30225).
+class {
+ render() {
+ return (
+ <select style={{paddingRight: "10px"}}
+ onChange={e => this.setState({value: e.target.value})}
+ value={this.state.value}>
+ <option>Hi</option>
+ </select>
+ );
+ }
+}
+
+// JSX attributes of an arrow function’s expression body’s JSX
+// expression should be indented with respect to the JSX opening
+// element (Bug#26001 /
+// https://github.com/mooz/js2-mode/issues/389#issuecomment-271869380).
+class {
+ render() {
+ const messages = this.state.messages.map(
+ message => <Message key={message.id}
+ text={message.text}
+ mine={message.mine} />
+ ); return messages;
+ }
+ render() {
+ const messages = this.state.messages.map(message =>
+ <Message key={message.timestamp}
+ text={message.text}
+ mine={message.mine} />
+ ); return messages;
+ }
+}
+
+// Users expect tag closers to align with the tag’s start; this is the
+// style used in the React docs, so it should be the default.
+// - https://github.com/mooz/js2-mode/issues/389#issuecomment-390766873
+// - https://github.com/mooz/js2-mode/issues/482
+// - Bug#32158
+const foo = (props) => (
+ <div>
+ <input
+ cat={i => i}
+ />
+ <button
+ className="square"
+ >
+ {this.state.value}
+ </button>
+ </div>
+);
+
+// Embedded JSX in parens breaks indentation
+// (https://github.com/mooz/js2-mode/issues/411).
+let a = (
+ <div>
+ {condition && <Component/>}
+ {condition && <Component/>}
+ <div/>
+ </div>
+)
+let b = (
+ <div>
+ {condition && (<Component/>)}
+ <div/>
+ </div>
+)
+let c = (
+ <div>
+ {condition && (<Component/>)}
+ {condition && "something"}
+ </div>
+)
+let d = (
+ <div>
+ {(<Component/>)}
+ {condition && "something"}
+ </div>
+)
+// Another example of the above issue (Bug#27000).
+function testA() {
+ return (
+ <div>
+ <div> { ( <div/> ) } </div>
+ </div>
+ );
+}
+function testB() {
+ return (
+ <div>
+ <div> { <div/> } </div>
+ </div>
+ );
+}
+// Another example of the above issue
+// (https://github.com/mooz/js2-mode/issues/451).
+class Classy extends React.Component {
+ render () {
+ return (
+ <div>
+ <ul className="tocListRoot">
+ { this.state.list.map((item) => {
+ return (<div />)
+ })}
+ </ul>
+ </div>
+ )
+ }
+}
+
+// Self-closing tags should be indented properly
+// (https://github.com/mooz/js2-mode/issues/459).
+export default ({ stars }) => (
+ <div className='overlay__container'>
+ <div className='overlay__header overlay--text'>
+ Congratulations!
+ </div>
+ <div className='overlay__reward'>
+ <Icon {...createIconProps(stars > 0)} size='large' />
+ <div className='overlay__reward__bottom'>
+ <Icon {...createIconProps(stars > 1)} size='small' />
+ <Icon {...createIconProps(stars > 2)} size='small' />
+ </div>
+ </div>
+ <div className='overlay__description overlay--text'>
+ You have created <large>1</large> reminder
+ </div>
+ </div>
+)
+
+// JS expressions should not break indentation
+// (https://github.com/mooz/js2-mode/issues/462).
+//
+// In the referenced issue, the user actually wanted indentation which
+// was simply different than Emacs’ SGML attribute indentation.
+// Nevertheless, his issue highlighted our inability to properly
+// indent code with JSX inside JSXExpressionContainers inside JSX.
+return (
+ <Router>
+ <Bar>
+ <Route exact path="/foo"
+ render={() => (
+ <div>nothing</div>
+ )} />
+ <Route exact path="/bar" />
+ </Bar>
+ </Router>
+)
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 449f00f..1e8b706 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -351,6 +351,9 @@
"-0x000000003ffffffffffffffe000000000000000 "))))
(ert-deftest test-group-name ()
+ ;; FIXME: Actually my GID in one of my systems has no associated entry
+ ;; in /etc/group so there's no name for it and `group-name' correctly
+ ;; returns nil!
(should (stringp (group-name (group-gid))))
(should-error (group-name 'foo))
(cond
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index d6cc99e..6ebab42 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -648,4 +648,22 @@
(should (equal (list (eq a b) n len)
(list t n len))))))))
+(ert-deftest test-proper-list-p ()
+ "Test `proper-list-p' behavior."
+ (dotimes (length 4)
+ ;; Proper and dotted lists.
+ (let ((list (make-list length 0)))
+ (should (= (proper-list-p list) length))
+ (should (not (proper-list-p (nconc list 0)))))
+ ;; Circular lists.
+ (dotimes (n (1+ length))
+ (let ((circle (make-list (1+ length) 0)))
+ (should (not (proper-list-p (nconc circle (nthcdr n circle))))))))
+ ;; Atoms.
+ (should (not (proper-list-p 0)))
+ (should (not (proper-list-p "")))
+ (should (not (proper-list-p [])))
+ (should (not (proper-list-p (make-bool-vector 0 nil))))
+ (should (not (proper-list-p (make-symbol "a")))))
+
(provide 'fns-tests)
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 04f91f4..542eec1 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -117,6 +117,14 @@
(should (equal (json-parse-string input :object-type 'plist)
'(:abc [9 :false] :def :null)))))
+(ert-deftest json-parse-string/array ()
+ (skip-unless (fboundp 'json-parse-string))
+ (let ((input "[\"a\", 1, [\"b\", 2]]"))
+ (should (equal (json-parse-string input)
+ ["a" 1 ["b" 2]]))
+ (should (equal (json-parse-string input :array-type 'list)
+ '("a" 1 ("b" 2))))))
+
(ert-deftest json-parse-string/string ()
(skip-unless (fboundp 'json-parse-string))
(should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)