[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/byte-switch bf7f7c0: Merge remote-tracking branch
|
From: |
Vibhav Pant |
|
Subject: |
[Emacs-diffs] feature/byte-switch bf7f7c0: Merge remote-tracking branch 'origin/master' into feature/byte-switch |
|
Date: |
Mon, 30 Jan 2017 13:06:02 +0000 (UTC) |
branch: feature/byte-switch
commit bf7f7c0d82a56ed1b76358657e74ca2833b19fe2
Merge: 25d38a0 9c4dfdd
Author: Vibhav Pant <address@hidden>
Commit: Vibhav Pant <address@hidden>
Merge remote-tracking branch 'origin/master' into feature/byte-switch
---
doc/lispref/internals.texi | 6 +-
doc/lispref/lists.texi | 33 +++
doc/lispref/processes.texi | 8 +
doc/lispref/threads.texi | 11 +
doc/misc/cl.texi | 2 +-
doc/misc/emacs-mime.texi | 4 +
doc/misc/gnus.texi | 34 +--
etc/DEBUG | 2 +-
etc/NEWS | 29 ++-
etc/refcards/ru-refcard.tex | 2 +-
lisp/battery.el | 3 +
lisp/calc/calc-misc.el | 2 +-
lisp/dired-aux.el | 2 +
lisp/emacs-lisp/backquote.el | 10 +
lisp/emacs-lisp/cl-generic.el | 15 +-
lisp/emacs-lisp/cl-lib.el | 143 ++---------
lisp/emacs-lisp/cl.el | 24 --
lisp/emacs-lisp/derived.el | 2 +
lisp/emacs-lisp/tabulated-list.el | 9 +-
lisp/ffap.el | 2 +-
lisp/files.el | 11 +-
lisp/gnus/gnus-art.el | 15 +-
lisp/gnus/gnus-msg.el | 9 +-
lisp/gnus/gnus-salt.el | 4 +-
lisp/gnus/gnus-start.el | 9 +-
lisp/gnus/gnus-sum.el | 28 ++-
lisp/gnus/gnus-topic.el | 2 +-
lisp/gnus/gnus.el | 4 -
lisp/gnus/message.el | 132 +++++-----
lisp/gnus/mml.el | 98 +++++---
lisp/gnus/nndoc.el | 20 +-
lisp/gnus/nnimap.el | 6 +-
lisp/help-fns.el | 40 +--
lisp/help-mode.el | 2 +-
lisp/hl-line.el | 3 +-
lisp/htmlfontify.el | 12 +-
lisp/info-look.el | 29 +++
lisp/mail/ietf-drums.el | 11 +
lisp/mail/rfc2047.el | 12 +-
lisp/net/eww.el | 71 ++++--
lisp/net/network-stream.el | 4 +
lisp/net/shr.el | 32 ++-
lisp/net/tramp.el | 6 +-
lisp/net/zeroconf.el | 6 +-
lisp/play/dunnet.el | 119 +++++----
lisp/progmodes/cc-engine.el | 48 ++--
lisp/progmodes/cc-mode.el | 3 +-
lisp/progmodes/hideshow.el | 2 +-
lisp/progmodes/js.el | 27 +--
lisp/progmodes/python.el | 20 +-
lisp/progmodes/sql.el | 2 +-
lisp/progmodes/vhdl-mode.el | 43 ++--
lisp/progmodes/xref.el | 4 +
lisp/recentf.el | 2 +-
lisp/shell.el | 13 +-
lisp/simple.el | 8 +-
lisp/subr.el | 120 +++++++++
lisp/term.el | 15 +-
lisp/textmodes/css-mode.el | 3 +-
lisp/textmodes/reftex-vars.el | 2 +
lisp/textmodes/rst.el | 15 +-
lisp/vc/diff-mode.el | 274 ++++++++-------------
lisp/vc/ediff-init.el | 46 ++--
lisp/xml.el | 6 +-
src/alloc.c | 114 ++++++---
src/atimer.c | 1 +
src/buffer.c | 13 +-
src/bytecode.c | 2 +-
src/callint.c | 2 +-
src/callproc.c | 16 +-
src/category.c | 2 +-
src/ccl.c | 2 +-
src/decompress.c | 2 +-
src/dired.c | 10 +-
src/editfns.c | 16 +-
src/emacs-module.c | 2 +-
src/eval.c | 40 +--
src/fileio.c | 73 +++---
src/filelock.c | 2 +-
src/fns.c | 405 ++++++++++++++-----------------
src/fontset.c | 8 +-
src/frame.c | 5 +-
src/gfilenotify.c | 8 +-
src/gnutls.c | 13 +-
src/image.c | 2 +-
src/indent.c | 6 +-
src/insdel.c | 12 +-
src/keyboard.c | 18 +-
src/keyboard.h | 2 +
src/keymap.c | 12 +-
src/lisp.h | 49 ++--
src/lread.c | 14 +-
src/macros.c | 2 +-
src/minibuf.c | 2 +-
src/print.c | 16 +-
src/process.c | 22 +-
src/profiler.c | 6 +-
src/regex.c | 7 +-
src/search.c | 49 ++--
src/syntax.c | 167 +++++++------
src/sysdep.c | 10 +-
src/textprop.c | 2 +-
src/thread.c | 61 +++--
src/w32fns.c | 8 +-
src/w32notify.c | 2 +-
src/w32proc.c | 2 +-
src/window.c | 7 +-
src/xdisp.c | 2 +-
src/xselect.c | 4 +-
src/xterm.c | 62 +----
test/lisp/abbrev-tests.el | 3 +-
test/lisp/emacs-lisp/cl-seq-tests.el | 6 +-
test/lisp/emacs-lisp/let-alist-tests.el | 5 +-
test/lisp/faces-tests.el | 9 +-
test/lisp/ffap-tests.el | 2 +-
test/lisp/filenotify-tests.el | 14 ++
test/lisp/htmlfontify-tests.el | 12 +
test/lisp/ibuffer-tests.el | 9 +
test/lisp/minibuffer-tests.el | 2 +-
test/lisp/net/dbus-tests.el | 3 +-
test/lisp/net/tramp-tests.el | 16 +-
test/lisp/progmodes/js-tests.el | 26 ++
test/lisp/progmodes/python-tests.el | 23 +-
test/lisp/simple-tests.el | 6 +-
test/lisp/textmodes/tildify-tests.el | 2 +-
test/lisp/xml-tests.el | 15 ++
test/src/eval-tests.el | 10 +
test/src/syntax-tests.el | 85 +++++++
test/src/thread-tests.el | 17 +-
129 files changed, 1861 insertions(+), 1367 deletions(-)
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 69d21be..663d0fd 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -672,7 +672,7 @@ usage: (or CONDITIONS...) */)
if (!NILP (val))
break;
args = XCDR (args);
- QUIT;
+ maybe_quit ();
@}
@end group
@@ -792,8 +792,8 @@ their addresses after performing Lisp evaluation. Lisp
evaluation can
occur via calls to @code{eval_sub} or @code{Feval}, either directly or
indirectly.
address@hidden @code{QUIT}, use in Lisp primitives
- Note the call to the @code{QUIT} macro inside the loop: this macro
address@hidden @code{maybe_quit}, use in Lisp primitives
+ Note the call to @code{maybe_quit} inside the loop: this function
checks whether the user pressed @kbd{C-g}, and if so, aborts the
processing. You should do that in any loop that can potentially
require a large number of iterations; in this case, the list of
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index bd7d85a..8eab281 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -362,6 +362,39 @@ This is the same as @code{(cdr (cdr @var{cons-cell}))}
or @code{(nthcdr 2 @var{cons-cell})}.
@end defun
address@hidden caaar
address@hidden caadr
address@hidden cadar
address@hidden caddr
address@hidden cdaar
address@hidden cdadr
address@hidden cddar
address@hidden cdddr
address@hidden caaaar
address@hidden caaadr
address@hidden caadar
address@hidden caaddr
address@hidden cadaar
address@hidden cadadr
address@hidden caddar
address@hidden cadddr
address@hidden cdaaar
address@hidden cdaadr
address@hidden cdadar
address@hidden cdaddr
address@hidden cddaar
address@hidden cddadr
address@hidden cdddar
address@hidden cddddr
+In addition to the above, 24 additional compositions of @code{car} and
address@hidden are defined as @address@hidden and @address@hidden,
+where each @address@hidden is either @code{a} or @code{d}. @code{cadr},
address@hidden, and @code{cadddr} pick out the second, third or fourth
+elements of a list, respectively. @file{cl-lib} provides the same
+under the names @code{cl-second}, @code{cl-third}, and
address@hidden @xref{List Functions,,, cl, Common Lisp
+Extensions}.
+
@defun butlast x &optional n
This function returns the list @var{x} with the last element,
or the last @var{n} elements, removed. If @var{n} is greater
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 014a0ae..58e04a3 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2414,6 +2414,14 @@ If address@hidden, the host's capability string.
The connection type: @samp{plain} or @samp{tls}.
@end table
address@hidden :shell-command @var{string-or-nil}
+If the connection @code{type} is @code{shell}, this parameter will be
+interpreted as a format-spec string that will be executed to make the
+connection. The specs available are @samp{%s} for the host name and
address@hidden for the port number. For instance, if you want to first ssh
+to @samp{gateway} before making a plain connection, then this
+parameter could be something like @samp{ssh gateway nc %s %p}.
+
@end table
@end defun
diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index d6cf99d..71742f5 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -127,6 +127,17 @@ Return a list of all the live thread objects. A new list
is returned
by each invocation.
@end defun
+When code run by a thread signals an error that is unhandled, the
+thread exits. Other threads can access the error form which caused
+the thread to exit using the following function.
+
address@hidden thread-last-error
+This function returns the last error form recorded when a thread
+exited due to an error. Each thread that exits abnormally overwrites
+the form stored by the previous thread's error with a new value, so
+only the last one can be accessed.
address@hidden defun
+
@node Mutexes
@section Mutexes
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 9e56a54..8baa0bd 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3694,7 +3694,7 @@ i.e., chains of cons cells.
@defun cl-caddr x
This function is equivalent to @code{(car (cdr (cdr @var{x})))}.
-Likewise, this package defines all 24 @address@hidden functions
+Likewise, this package aliases all 24 @address@hidden functions
where @var{xxx} is up to four @samp{a}s and/or @samp{d}s.
All of these functions are @code{setf}-able, and calls to them
are expanded inline by the byte-compiler for maximum efficiency.
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 771c078..b0cfbc9 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -654,6 +654,10 @@ Each tag can contain zero or more parameters on the form
but that's not necessary unless the value contains white space. So
@samp{filename=/home/user/#hello$^yes} is perfectly valid.
+If you want to talk about MML in a message, you need a way to
+``quote'' these tags. The way to do that is to include an exclamation
+point after the opening two characters; i. e. @samp{<#!part ...>}.
+
The following parameters have meaning in @acronym{MML}; parameters that have no
meaning are ignored. The @acronym{MML} parameter names are the same as the
@acronym{MIME} parameter names; the things in the parentheses say which
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 05159d4..ceeb42b 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10197,6 +10197,11 @@ Sort by lines (@code{gnus-summary-sort-by-lines}).
@findex gnus-summary-sort-by-chars
Sort by article length (@code{gnus-summary-sort-by-chars}).
address@hidden C-c C-s C-m C-m
address@hidden C-c C-s C-m C-m (Summary)
address@hidden gnus-summary-sort-by-marks
+Sort by article ``readedness'' marks (@code{gnus-summary-sort-by-marks}).
+
@item C-c C-s C-i
@kindex C-c C-s C-i (Summary)
@findex gnus-summary-sort-by-score
@@ -13515,7 +13520,8 @@ Close the connection (if any) to the server
@kindex D (Server)
@findex gnus-server-deny-server
Mark the current server as unreachable
-(@code{gnus-server-deny-server}).
+(@code{gnus-server-deny-server}). This will effectively disable the
+server.
@item M-o
@kindex M-o (Server)
@@ -21857,37 +21863,37 @@ In summary mode:
@table @kbd
address@hidden $ m
address@hidden $ m (Summary)
address@hidden G G m
address@hidden G G m (Summary)
@findex nnmairix-widget-search-from-this-article
Allows you to create a mairix query or group based on the current
message using graphical widgets (same as @code{nnmairix-widget-search})
(@code{nnmairix-widget-search-from-this-article}).
address@hidden $ g
address@hidden $ g (Summary)
address@hidden G G g
address@hidden G G g (Summary)
@findex nnmairix-create-search-group-from-message
Interactively creates a new search group with query based on the current
message, but uses the minibuffer instead of graphical widgets
(@code{nnmairix-create-search-group-from-message}).
address@hidden $ t
address@hidden $ t (Summary)
address@hidden G G t
address@hidden G G t (Summary)
@findex nnmairix-search-thread-this-article
Searches thread for the current article
(@code{nnmairix-search-thread-this-article}). This is effectively a
shortcut for calling @code{nnmairix-search} with @samp{m:msgid} of the
current article and enabled threads.
address@hidden $ f
address@hidden $ f (Summary)
address@hidden G G f
address@hidden G G f (Summary)
@findex nnmairix-search-from-this-article
Searches all messages from sender of the current article
(@code{nnmairix-search-from-this-article}). This is a shortcut for
calling @code{nnmairix-search} with @samp{f:From}.
address@hidden $ o
address@hidden $ o (Summary)
address@hidden G G o
address@hidden G G o (Summary)
@findex nnmairix-goto-original-article
(Only in @code{nnmairix} groups!) Tries determine the group this article
originally came from and displays the article in this group, so that,
@@ -21896,8 +21902,8 @@ parameters are applied
(@code{nnmairix-goto-original-article}). This
function will use the registry if available, but can also parse the
article file name as a fallback method.
address@hidden $ u
address@hidden $ u (Summary)
address@hidden G G u
address@hidden G G u (Summary)
@findex nnmairix-remove-tick-mark-original-article
Remove possibly existing tick mark from original article
(@code{nnmairix-remove-tick-mark-original-article}). (@pxref{nnmairix
@@ -22051,7 +22057,7 @@ activate the always-unread feature by using @kbd{G b r}
twice.
So far so good---but how do you remove the tick marks in the @code{nnmairix}
group? There are two options: You may simply use
address@hidden (bound to @kbd{$ u}) to remove
address@hidden (bound to @kbd{G G u}) to remove
tick marks from the original article. The other possibility is to set
@code{nnmairix-propagate-marks-to-nnmairix-groups} to @code{t}, but see the
above
comments about this option. If it works for you, the tick marks should
diff --git a/etc/DEBUG b/etc/DEBUG
index acb08c6..3719c3e 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -225,7 +225,7 @@ this command:
handle SIGINT stop nopass
After this 'handle' command, SIGINT will return control to GDB. If
-you want the C-g to cause a QUIT within Emacs as well, omit the 'nopass'.
+you want the C-g to cause a quit within Emacs as well, omit the 'nopass'.
See the GDB manual for more details about signal handling and the
'handle' command.
diff --git a/etc/NEWS b/etc/NEWS
index 051b97e..12ff21f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -116,7 +116,16 @@ dired buffer.
** Emacs now uses double buffering to reduce flicker when editing and
resizing graphical Emacs frames on the X Window System. This support
requires the DOUBLE-BUFFER extension, which major X servers have
-supported for many years.
+supported for many years. If your system has this extension, but an
+Emacs built with double buffering misbehaves on some displays you use,
+you can disable the feature by adding
+
+ '(inhibit-double-buffering . t)
+
+to default-frame-parameters. Or inject this parameter into the
+selected frame by evaluating this form:
+
+ (modify-frame-parameters nil '((inhibit-double-buffering . t)))
---
The group 'wp', whose label was "text", is now deprecated.
@@ -339,6 +348,16 @@ bound to 'Buffer-menu-unmark-all-buffers'.
*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and
'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'.
+** Gnus
+
+---
+*** The .newsrc file will now only be saved if the native select
+method is an NNTP select method.
+
++++
+*** A new command for sorting articles by readedness marks has been
+added: `C-c C-s C-m C-m'.
+
** Ibuffer
---
@@ -778,6 +797,11 @@ of an arbitrary function. This generalizes 'subr-arity'
for functions
that are not built-in primitives. We recommend using this new
function instead of 'subr-arity'.
+** New function 'region-bounds' can be used in the interactive spec
+to provide region boundaries (for rectangular regions more than one)
+to an interactively callable function as a single argument instead of
+two separate arguments region-beginning and region-end.
+
+++
** 'parse-partial-sexp' state has a new element. Element 10 is
non-nil when the last character scanned might be the first character
@@ -838,6 +862,9 @@ ABBR is a time zone abbreviation. The affected functions
are
collection).
+++
+** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp.
+
++++
** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
can be used for creation of temporary files of remote or mounted directories.
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index c961f7a..fad75dd 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -41,7 +41,7 @@
\setlength{\ColThreeWidth}{25mm}
\newcommand{\versionemacs}[0]{26} % version of Emacs this is for
-\newcommand{\cyear}[0]{2016} % copyright year
+\newcommand{\cyear}[0]{2017} % copyright year
\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill
\centerline{\footnotesize \copyright\ \cyear\ Free Software Foundation, Inc.
diff --git a/lisp/battery.el b/lisp/battery.el
index 71268e5..b1834f0 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -542,6 +542,9 @@ The following %-sequences are provided:
(t "N/A"))))))
+(declare-function dbus-get-property "dbus.el"
+ (bus service path interface property))
+
;;; `upowerd' interface.
(defsubst battery-upower-prop (pname &optional device)
(dbus-get-property
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 7b7a720..e6af092 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -623,7 +623,7 @@ loaded and the keystroke automatically re-typed."
(unwind-protect
(progn
(sit-for 2)
- (identity 1) ; this forces a call to QUIT; in bytecode.c.
+ (identity 1) ; This forces a call to maybe_quit in bytecode.c.
(setq okay t))
(progn
(delete-region savemax (point-max))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index cabcfcd..caa3b45 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -987,6 +987,8 @@ corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
output file. %i path(s) are relative, while %o is absolute.")
+(declare-function format-spec "format-spec.el" (format specification))
+
;;;###autoload
(defun dired-do-compress-to ()
"Compress selected files and directories to an archive.
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 94c561c..bb877dd 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -247,4 +247,14 @@ LEVEL is only used internally and indicates the nesting
level:
tail))
(t (cons 'list heads)))))
+
+;; Give `,' and `,@' documentation strings which can be examined by C-h f.
+(put '\, 'function-documentation
+ "See `\\=`' (also `pcase') for the usage of `,'.")
+(put '\, 'reader-construct t)
+
+(put '\,@ 'function-documentation
+ "See `\\=`' for the usage of `,@'.")
+(put '\,@ 'reader-construct t)
+
;;; backquote.el ends here
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8d141d7..6cc70c4 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -226,7 +226,13 @@ DEFAULT-BODY, if present, is used as the body of a default
method.
(when (eq 'setf (car-safe name))
(require 'gv)
(setq name (gv-setter (cadr name))))
- `(progn
+ `(prog1
+ (progn
+ (defalias ',name
+ (cl-generic-define ',name ',args ',(nreverse options))
+ ,(help-add-fundoc-usage doc args))
+ ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+ (nreverse methods)))
,@(mapcar (lambda (declaration)
(let ((f (cdr (assq (car declaration)
defun-declarations-alist))))
@@ -235,12 +241,7 @@ DEFAULT-BODY, if present, is used as the body of a default
method.
(t (message "Warning: Unknown defun property `%S' in %S"
(car declaration) name)
nil))))
- (cdr declarations))
- (defalias ',name
- (cl-generic-define ',name ',args ',(nreverse options))
- ,(help-add-fundoc-usage doc args))
- ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
- (nreverse methods)))))
+ (cdr declarations)))))
;;;###autoload
(defun cl-generic-define (name args options)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index b1db07f..5aa8f1b 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -413,125 +413,30 @@ Signal an error if X is not a list."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
(nth 9 x))
-(defun cl-caaar (x)
- "Return the `car' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (car x))))
-
-(defun cl-caadr (x)
- "Return the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (cdr x))))
-
-(defun cl-cadar (x)
- "Return the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (car x))))
-
-(defun cl-caddr (x)
- "Return the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (cdr x))))
-
-(defun cl-cdaar (x)
- "Return the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (car x))))
-
-(defun cl-cdadr (x)
- "Return the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (cdr x))))
-
-(defun cl-cddar (x)
- "Return the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (car x))))
-
-(defun cl-cdddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (cdr x))))
-
-(defun cl-caaaar (x)
- "Return the `car' of the `car' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (car (car x)))))
-
-(defun cl-caaadr (x)
- "Return the `car' of the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (car (cdr x)))))
-
-(defun cl-caadar (x)
- "Return the `car' of the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (cdr (car x)))))
-
-(defun cl-caaddr (x)
- "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (cdr (cdr x)))))
-
-(defun cl-cadaar (x)
- "Return the `car' of the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (car (car x)))))
-
-(defun cl-cadadr (x)
- "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (car (cdr x)))))
-
-(defun cl-caddar (x)
- "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (cdr (car x)))))
-
-(defun cl-cadddr (x)
- "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (cdr (cdr x)))))
-
-(defun cl-cdaaar (x)
- "Return the `cdr' of the `car' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (car (car x)))))
-
-(defun cl-cdaadr (x)
- "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (car (cdr x)))))
-
-(defun cl-cdadar (x)
- "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (cdr (car x)))))
-
-(defun cl-cdaddr (x)
- "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (cdr (cdr x)))))
-
-(defun cl-cddaar (x)
- "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (car (car x)))))
-
-(defun cl-cddadr (x)
- "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (car (cdr x)))))
-
-(defun cl-cdddar (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (cdr (car x)))))
-
-(defun cl-cddddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (cdr (cdr x)))))
+(defalias 'cl-caaar 'caaar)
+(defalias 'cl-caadr 'caadr)
+(defalias 'cl-cadar 'cadar)
+(defalias 'cl-caddr 'caddr)
+(defalias 'cl-cdaar 'cdaar)
+(defalias 'cl-cdadr 'cdadr)
+(defalias 'cl-cddar 'cddar)
+(defalias 'cl-cdddr 'cdddr)
+(defalias 'cl-caaaar 'caaaar)
+(defalias 'cl-caaadr 'caaadr)
+(defalias 'cl-caadar 'caadar)
+(defalias 'cl-caaddr 'caaddr)
+(defalias 'cl-cadaar 'cadaar)
+(defalias 'cl-cadadr 'cadadr)
+(defalias 'cl-caddar 'caddar)
+(defalias 'cl-cadddr 'cadddr)
+(defalias 'cl-cdaaar 'cdaaar)
+(defalias 'cl-cdaadr 'cdaadr)
+(defalias 'cl-cdadar 'cdadar)
+(defalias 'cl-cdaddr 'cdaddr)
+(defalias 'cl-cddaar 'cddaar)
+(defalias 'cl-cddadr 'cddadr)
+(defalias 'cl-cdddar 'cdddar)
+(defalias 'cl-cddddr 'cddddr)
;;(defun last* (x &optional n)
;; "Returns the last link in the list LIST.
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index e33a603..73eb9a4 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -258,30 +258,6 @@
copy-list
ldiff
list*
- cddddr
- cdddar
- cddadr
- cddaar
- cdaddr
- cdadar
- cdaadr
- cdaaar
- cadddr
- caddar
- cadadr
- cadaar
- caaddr
- caadar
- caaadr
- caaaar
- cdddr
- cddar
- cdadr
- cdaar
- caddr
- cadar
- caadr
- caaar
tenth
ninth
eighth
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 762c762..fffe972 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -216,6 +216,7 @@ No problems result if this variable is not bound.
(purecopy ,(format "Keymap for `%s'." child))))
,(if declare-syntax
`(progn
+ (defvar ,syntax)
(unless (boundp ',syntax)
(put ',syntax 'definition-name ',child)
(defvar ,syntax (make-syntax-table)))
@@ -224,6 +225,7 @@ No problems result if this variable is not bound.
(purecopy ,(format "Syntax table for `%s'." child))))))
,(if declare-abbrev
`(progn
+ (defvar ,abbrev)
(unless (boundp ',abbrev)
(put ',abbrev 'definition-name ',child)
(defvar ,abbrev
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index eadf79f..b6b49b1 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -412,8 +412,13 @@ of column descriptors."
(inhibit-read-only t))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
- (dotimes (n ncols)
- (setq x (tabulated-list-print-col n (aref cols n) x)))
+ (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
+ (or (bound-and-true-p tabulated-list--near-rows)
+ (list (or (tabulated-list-get-entry (point-at-bol 0))
+ cols)
+ cols))))
+ (dotimes (n ncols)
+ (setq x (tabulated-list-print-col n (aref cols n) x))))
(insert ?\n)
;; Ever so slightly faster than calling `put-text-property' twice.
(add-text-properties
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 068897b..d7222bf 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -171,7 +171,7 @@ this to nil will disable recognition of URLs that are not
well-formed, such as \"address@hidden" or \"<address@hidden>\"."
:type 'boolean
:group 'ffap
- :version "25.1")
+ :version "25.2") ; nil -> t
(defcustom ffap-ftp-default-user "anonymous"
"User name in FTP file names generated by `ffap-host-to-path'.
diff --git a/lisp/files.el b/lisp/files.el
index b57e35b..25392fd 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3723,7 +3723,8 @@ Return the new variables list."
(let* ((file-name (or (buffer-file-name)
;; Handle non-file buffers, too.
(expand-file-name default-directory)))
- (sub-file-name (if file-name
+ (sub-file-name (if (and file-name
+ (file-name-absolute-p file-name))
;; FIXME: Why not use file-relative-name?
(substring file-name (length root)))))
(condition-case err
@@ -6074,8 +6075,8 @@ See also `auto-save-file-name-p'."
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(if (and (memq system-type '(ms-dos windows-nt cygwin))
- ;; Don't modify remote (ange-ftp) filenames
- (not (string-match "^/address@hidden:" result)))
+ ;; Don't modify remote filenames
+ (not (file-remote-p result)))
(convert-standard-filename result)
result))))
@@ -6112,8 +6113,8 @@ See also `auto-save-file-name-p'."
((file-writable-p "/var/tmp/") "/var/tmp/")
("~/")))))
(if (and (memq system-type '(ms-dos windows-nt cygwin))
- ;; Don't modify remote (ange-ftp) filenames
- (not (string-match "^/address@hidden:" fname)))
+ ;; Don't modify remote filenames
+ (not (file-remote-p fname)))
;; The call to convert-standard-filename is in case
;; buffer-name includes characters not allowed by the
;; DOS/Windows filesystems. make-temp-file writes to the
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index e1af859..43e1231 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -251,7 +251,12 @@ This can also be a list of the above values."
(integer :value 200)
(number :value 4.0)
function
- (regexp :value ".*"))
+ (regexp :value ".*")
+ (repeat (choice (const nil)
+ (integer :value 200)
+ (number :value 4.0)
+ function
+ (regexp :value ".*"))))
:group 'gnus-article-signature)
(defcustom gnus-hidden-properties
@@ -6841,17 +6846,21 @@ then we display only bindings that start with that
prefix."
(let ((keymap (copy-keymap gnus-article-mode-map))
(map (copy-keymap gnus-article-send-map))
(sumkeys (where-is-internal 'gnus-article-read-summary-keys))
+ (summap (make-sparse-keymap))
parent agent draft)
(define-key keymap "S" map)
(define-key map [t] nil)
+ (define-key summap [t] 'undefined)
(with-current-buffer gnus-article-current-summary
+ (dolist (key sumkeys)
+ (define-key summap key (key-binding key (current-local-map))))
(set-keymap-parent
keymap
(if (setq parent (keymap-parent gnus-article-mode-map))
(prog1
(setq parent (copy-keymap parent))
- (set-keymap-parent parent (current-local-map)))
- (current-local-map)))
+ (set-keymap-parent parent summap))
+ summap))
(set-keymap-parent map (key-binding "S"))
(let (key def gnus-pick-mode)
(while sumkeys
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 1911117..a193ab4 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -546,7 +546,8 @@ instead."
(gnus-setup-message 'message
(message-mail to subject other-headers continue
nil yank-action send-actions return-action)))
- (setq gnus-newsgroup-name group-name))
+ (with-current-buffer buf
+ (setq gnus-newsgroup-name group-name)))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
@@ -1534,11 +1535,7 @@ If YANK is non-nil, include the original article."
(message-pop-to-buffer "*Gnus Bug*"))
(let ((message-this-is-mail t))
(message-setup `((To . ,gnus-maintainer)
- (Subject . "")
- (X-Debbugs-Package
- . ,(format "%s" gnus-bug-package))
- (X-Debbugs-Version
- . ,(format "%s" (gnus-continuum-version))))))
+ (Subject . ""))))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 5361c2b..7037328 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -131,9 +131,7 @@ It accepts the same format specs that
`gnus-summary-line-format' does."
(defvar gnus-pick-line-number 1)
(defun gnus-pick-line-number ()
"Return the current line number."
- (if (bobp)
- (setq gnus-pick-line-number 1)
- (incf gnus-pick-line-number)))
+ (incf gnus-pick-line-number))
(defun gnus-pick-start-reading (&optional catch-up)
"Start reading the picked articles.
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 47e33af..be46339 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2801,8 +2801,13 @@ If FORCE is non-nil, the .newsrc file is read."
(gnus-run-hooks 'gnus-save-newsrc-hook)
(if gnus-slave
(gnus-slave-save-newsrc)
- ;; Save .newsrc.
- (when gnus-save-newsrc-file
+ ;; Save .newsrc only if the select method is an NNTP method.
+ ;; The .newsrc file is for interoperability with other
+ ;; newsreaders, so saving non-NNTP groups there doesn't make
+ ;; much sense.
+ (when (and gnus-save-newsrc-file
+ (eq (car (gnus-server-to-method gnus-select-method))
+ 'nntp))
(gnus-message 8 "Saving %s..." gnus-current-startup-file)
(gnus-gnus-to-newsrc-format)
(gnus-message 8 "Saving %s...done" gnus-current-startup-file))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 72e902a..2631514 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1895,6 +1895,7 @@ increase the score of each group you read."
"\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
"\C-c\C-s\C-c" gnus-summary-sort-by-chars
+ "\C-c\C-s\C-m\C-m" gnus-summary-sort-by-marks
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\C-c\C-s\C-t" gnus-summary-sort-by-recipient
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
@@ -2748,6 +2749,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
["Sort by score" gnus-summary-sort-by-score t]
["Sort by lines" gnus-summary-sort-by-lines t]
["Sort by characters" gnus-summary-sort-by-chars t]
+ ["Sort by marks" gnus-summary-sort-by-marks t]
["Randomize" gnus-summary-sort-by-random t]
["Original sort" gnus-summary-sort-by-original t])
("Help"
@@ -3976,6 +3978,8 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
;; The group was successfully selected.
(t
(gnus-set-global-variables)
+ (when (boundp 'gnus-pick-line-number)
+ (setq gnus-pick-line-number 0))
(when (boundp 'spam-install-hooks)
(spam-initialize))
;; Save the active value in effect when the group was entered.
@@ -4037,6 +4041,9 @@ If SELECT-ARTICLES, only select those articles from
GROUP."
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(gnus-summary-auto-select-subject)
+ ;; Don't mark any articles as selected if we haven't done that.
+ (when no-article
+ (setq overlay-arrow-position nil))
;; Show first unread article if requested.
(if (and (not no-article)
(not no-display)
@@ -4941,6 +4948,16 @@ using some other form will lead to serious barfage."
(gnus-article-sort-by-chars
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-marks (h1 h2)
+ "Sort articles by octet length."
+ (< (gnus-article-mark (mail-header-number h1))
+ (gnus-article-mark (mail-header-number h2))))
+
+(defun gnus-thread-sort-by-marks (h1 h2)
+ "Sort threads by root article octet length."
+ (gnus-article-sort-by-marks
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(gnus-string<
@@ -11925,6 +11942,12 @@ Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'chars reverse))
+(defun gnus-summary-sort-by-mark (&optional reverse)
+ "Sort the summary buffer by article marks.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'marks reverse))
+
(defun gnus-summary-sort-by-original (&optional reverse)
"Sort the summary buffer using the default sorting method.
Argument REVERSE means reverse order."
@@ -11970,7 +11993,10 @@ save those articles instead.
The variable `gnus-default-article-saver' specifies the saver function.
If the optional second argument NOT-SAVED is non-nil, articles saved
-will not be marked as saved."
+will not be marked as saved.
+
+The `gnus-prompt-before-saving' variable says how prompting is
+performed."
(interactive "P")
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 8ab8f46..6d6e20d 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1564,7 +1564,7 @@ If UNINDENT, remove an indentation."
(parent (gnus-topic-parent-topic topic))
(grandparent (gnus-topic-parent-topic parent)))
(unless grandparent
- (error "Nothing to indent %s into" topic))
+ (error "Can't unindent %s further" topic))
(when topic
(gnus-topic-goto-topic topic)
(gnus-topic-kill-group)
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index ef6bd89..bbf85fe 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2654,10 +2654,6 @@ such as a mark that says whether an article is stored in
the cache
"address@hidden (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-bug-package
- "gnus"
- "The package to use in the bug submission.")
-
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)Group Buffer")
(gnus-summary-mode "(gnus)Summary Buffer")
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 4d4ba08..ce0dad9 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2286,13 +2286,15 @@ body, set `message-archive-note' to nil."
"Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(interactive
- (list ; Completion based on Gnus
- (completing-read "Followup To: "
- (if (boundp 'gnus-newsrc-alist)
- gnus-newsrc-alist)
- nil nil '("poster" . 0)
- (if (boundp 'gnus-group-history)
- 'gnus-group-history))))
+ (list ; Completion based on Gnus
+ (replace-regexp-in-string
+ "\\`.*:" ""
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history)))))
(message-remove-header "Follow[Uu]p-[Tt]o" t)
(message-goto-newsgroups)
(beginning-of-line)
@@ -2361,13 +2363,15 @@ been made to before the user asked for a Crosspost."
"Crossposts message and set Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(interactive
- (list ; Completion based on Gnus
- (completing-read "Followup To: "
- (if (boundp 'gnus-newsrc-alist)
- gnus-newsrc-alist)
- nil nil '("poster" . 0)
- (if (boundp 'gnus-group-history)
- 'gnus-group-history))))
+ (list ; Completion based on Gnus
+ (replace-regexp-in-string
+ "\\`.*:" ""
+ (completing-read "Followup To: "
+ (if (boundp 'gnus-newsrc-alist)
+ gnus-newsrc-alist)
+ nil nil '("poster" . 0)
+ (if (boundp 'gnus-group-history)
+ 'gnus-group-history)))))
(when (fboundp 'gnus-group-real-name)
(setq target-group (gnus-group-real-name target-group)))
(cond ((not (or (null target-group) ; new subject not empty
@@ -3108,18 +3112,29 @@ M-RET `message-newline-and-reformat' (break the line
and reformat)."
(looking-at "[ \t]*\n"))
(expand-abbrev))
(push-mark)
+ (message-goto-body-1))
+
+(defun message-goto-body-1 ()
+ "Go to the body and return point."
(goto-char (point-min))
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
+ ;; If the message is mangled, find the end of the headers the
+ ;; hard way.
+ (progn
+ ;; Skip past all headers and continuation lines.
+ (while (looking-at "[^:]+:\\|[\t ]+[^\t ]")
+ (forward-line 1))
+ ;; We're now at the first empty line, so perhaps move past it.
+ (when (and (eolp)
+ (not (eobp)))
+ (forward-line 1))
+ (point))))
(defun message-in-body-p ()
"Return t if point is in the message body."
(>= (point)
(save-excursion
- (goto-char (point-min))
- (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))
- (point))))
+ (message-goto-body-1))))
(defun message-goto-eoh ()
"Move point to the end of the headers."
@@ -3330,6 +3345,8 @@ of lines before the signature intact."
"Insert four newlines, and then reformat if inside quoted text.
Prefix arg means justify as well."
(interactive (list (if current-prefix-arg 'full)))
+ (unless (message-in-body-p)
+ (error "This command only works in the body of the message"))
(let (quoted point beg end leading-space bolp fill-paragraph-function)
(setq point (point))
(beginning-of-line)
@@ -4102,8 +4119,8 @@ It should typically alter the sending method in some way
or other."
(let ((inhibit-read-only t))
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
- (mml-secure-bcc-is-safe)
(run-hooks 'message-send-hook)
+ (mml-secure-bcc-is-safe)
(when message-confirm-send
(or (y-or-n-p "Send message? ")
(keyboard-quit)))
@@ -4539,6 +4556,9 @@ This function could be useful in `message-setup-hook'."
(forward-line 1)
(unless (y-or-n-p "Send anyway? ")
(error "Failed to send the message")))))
+ ;; Fold too-long header lines. They should be no longer than
+ ;; 998 octets long.
+ (message--fold-long-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(setq options message-options)
@@ -4635,6 +4655,14 @@ If you always want Gnus to send messages in one piece,
set
(setq message-options options)
(push 'mail message-sent-message-via)))
+(defun message--fold-long-headers ()
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (and (looking-at "[^:]+:")
+ (> (- (line-end-position) (point)) 998))
+ (mail-header-fold-field))
+ (forward-line 1)))
+
(defvar sendmail-program)
(defvar smtpmail-smtp-server)
(defvar smtpmail-smtp-service)
@@ -5380,16 +5408,13 @@ Otherwise, generate and save a value for
`canlock-password' first."
"Process Fcc headers in the current buffer."
(let ((case-fold-search t)
(buf (current-buffer))
- list file
- (mml-externalize-attachments message-fcc-externalize-attachments))
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (setq file (message-fetch-field "fcc" t)))
- (when file
- (set-buffer (get-buffer-create " *message temp*"))
- (erase-buffer)
+ (mml-externalize-attachments message-fcc-externalize-attachments)
+ (file (message-field-value "fcc" t))
+ list)
+ (when file
+ (with-temp-buffer
(insert-buffer-substring buf)
+ (message-clone-locals buf)
(message-encode-message-body)
(save-restriction
(message-narrow-to-headers)
@@ -5429,8 +5454,7 @@ Otherwise, generate and save a value for
`canlock-password' first."
(if (and (file-readable-p file) (mail-file-babyl-p file))
(rmail-output file 1 nil t)
(let ((mail-use-rfc822 t))
- (rmail-output file 1 t t))))))
- (kill-buffer (current-buffer))))))
+ (rmail-output file 1 t t))))))))))
(defun message-output (filename)
"Append this article to Unix/babyl mail file FILENAME."
@@ -5761,7 +5785,7 @@ give as trustworthy answer as possible."
(not (string-match message-bogus-system-names message-user-fqdn)))
;; `message-user-fqdn' seems to be valid
message-user-fqdn)
- ((and (string-match message-bogus-system-names sysname))
+ ((not (string-match message-bogus-system-names sysname))
;; `system-name' returned the right result.
sysname)
;; Try `mail-host-address'.
@@ -6644,29 +6668,27 @@ OTHER-HEADERS is an alist of header/value pairs.
CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
is a function used to switch to and display the mail buffer."
(interactive)
- (let ((message-this-is-mail t))
- (unless (message-mail-user-agent)
- (message-pop-to-buffer
- ;; Search for the existing message buffer if `continue' is non-nil.
- (let ((message-generate-new-buffers
- (when (or (not continue)
- (eq message-generate-new-buffers 'standard)
- (functionp message-generate-new-buffers))
- message-generate-new-buffers)))
- (message-buffer-name "mail" to))
- switch-function))
- (message-setup
- (nconc
- `((To . ,(or to "")) (Subject . ,(or subject "")))
- ;; C-h f compose-mail says that headers should be specified as
- ;; (string . value); however all the rest of message expects
- ;; headers to be symbols, not strings (eg message-header-format-alist).
- ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
- ;; We need to convert any string input, eg from rmail-start-mail.
- (dolist (h other-headers other-headers)
- (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
- yank-action send-actions continue switch-function
- return-action)))
+ (let ((message-this-is-mail t)
+ message-buffers)
+ ;; Search for the existing message buffer if `continue' is non-nil.
+ (if (and continue
+ (setq message-buffers (message-buffers)))
+ (pop-to-buffer (car message-buffers))
+ ;; Start a new buffer.
+ (unless (message-mail-user-agent)
+ (message-pop-to-buffer (message-buffer-name "mail" to) switch-function))
+ (message-setup
+ (nconc
+ `((To . ,(or to "")) (Subject . ,(or subject "")))
+ ;; C-h f compose-mail says that headers should be specified as
+ ;; (string . value); however all the rest of message expects
+ ;; headers to be symbols, not strings (eg message-header-format-alist).
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
+ ;; We need to convert any string input, eg from rmail-start-mail.
+ (dolist (h other-headers other-headers)
+ (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
+ yank-action send-actions continue switch-function
+ return-action))))
;;;###autoload
(defun message-news (&optional newsgroups subject)
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 6d13d89..3a31349 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -486,7 +486,8 @@ be \"related\" or \"alternate\"."
(equal (cdr (assq 'type (car cont))) "text/html"))
(setq cont (mml-expand-html-into-multipart-related (car cont))))
(prog1
- (mm-with-multibyte-buffer
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
(setq message-options options)
(cond
((and (consp (car cont))
@@ -605,28 +606,38 @@ be \"related\" or \"alternate\"."
(intern (downcase charset))))))
(if (and (not raw)
(member (car (split-string type "/")) '("text" "message")))
+ ;; We have a text-like MIME part, so we need to do
+ ;; charset encoding.
(progn
(with-temp-buffer
- (cond
- ((cdr (assq 'buffer cont))
- (insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and filename
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (let ((coding-system-for-read coding))
- (mm-insert-file-contents filename)))
- ((eq 'mml (car cont))
- (insert (cdr (assq 'contents cont))))
- (t
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (cdr (assq 'contents cont)))
- ;; Remove quotes from quoted tags.
- (goto-char (point-min))
- (while (re-search-forward
-
"<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)"
- nil t)
- (delete-region (+ (match-beginning 0) 2)
- (+ (match-beginning 0) 3))))))
+ (set-buffer-multibyte nil)
+ ;; First insert the data into the buffer.
+ (if (and filename
+ (not (equal (cdr (assq 'nofile cont)) "yes")))
+ (mm-insert-file-contents filename)
+ (insert
+ (with-temp-buffer
+ (cond
+ ((cdr (assq 'buffer cont))
+ (insert-buffer-substring (cdr (assq 'buffer cont))))
+ ((eq 'mml (car cont))
+ (insert (cdr (assq 'contents cont))))
+ (t
+ (insert (cdr (assq 'contents cont)))
+ ;; Remove quotes from quoted tags.
+ (goto-char (point-min))
+ (while (re-search-forward
+
"<#!+/?\\(part\\|multipart\\|external\\|mml\\|secure\\)"
+ nil t)
+ (delete-region (+ (match-beginning 0) 2)
+ (+ (match-beginning 0) 3)))))
+ (setq charset
+ (mm-coding-system-to-mime-charset
+ (detect-coding-region
+ (point-min) (point-max) t)))
+ (encode-coding-region (point-min) (point-max)
+ charset)
+ (buffer-string))))
(cond
((eq (car cont) 'mml)
(let ((mml-boundary (mml-compute-boundary cont))
@@ -667,21 +678,22 @@ be \"related\" or \"alternate\"."
;; insert a "; format=flowed" string unless the
;; user has already specified it.
(setq flowed (null (assq 'format cont)))))
- ;; Prefer `utf-8' for text/calendar parts.
- (if (or charset
- (not (string= type "text/calendar")))
- (setq charset (mm-encode-body charset))
- (let ((mm-coding-system-priorities
- (cons 'utf-8 mm-coding-system-priorities)))
- (setq charset (mm-encode-body))))
- (mm-disable-multibyte)
+ (unless charset
+ (setq charset
+ ;; Prefer `utf-8' for text/calendar parts.
+ (if (string= type "text/calendar")
+ 'utf-8
+ (mm-coding-system-to-mime-charset
+ (detect-coding-region
+ (point-min) (point-max) t)))))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
(setq coded (buffer-string)))
(mml-insert-mime-headers cont type charset encoding flowed)
(insert "\n")
(insert coded))
- (mm-with-unibyte-buffer
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
(cond
((cdr (assq 'buffer cont))
(insert (string-as-unibyte
@@ -690,11 +702,7 @@ be \"related\" or \"alternate\"."
((and filename
(not (equal (cdr (assq 'nofile cont)) "yes")))
(let ((coding-system-for-read mm-binary-coding-system))
- (mm-insert-file-contents filename nil nil nil nil t))
- (unless charset
- (setq charset (mm-coding-system-to-mime-charset
- (mm-find-buffer-file-coding-system
- filename)))))
+ (mm-insert-file-contents filename nil nil nil nil t)))
(t
(let ((contents (cdr (assq 'contents cont))))
(if (multibyte-string-p contents)
@@ -1244,6 +1252,7 @@ If not set, `default-directory' will be used."
(defun mml-minibuffer-read-file (prompt)
(let* ((completion-ignored-extensions nil)
+ (buffer-file-name nil)
(file (read-file-name prompt
(or mml-default-directory default-directory)
nil t)))
@@ -1378,12 +1387,23 @@ content-type, a string of the form \"type/subtype\".
DESCRIPTION
is a one-line description of the attachment. The DISPOSITION
specifies how the attachment is intended to be displayed. It can
be either \"inline\" (displayed automatically within the message
-body) or \"attachment\" (separate from the body)."
+body) or \"attachment\" (separate from the body).
+
+If given a prefix interactively, no prompting will be done for
+the TYPE, DESCRIPTION or DISPOSITION values. Instead defaults
+will be computed and used."
(interactive
(let* ((file (mml-minibuffer-read-file "Attach file: "))
- (type (mml-minibuffer-read-type file))
- (description (mml-minibuffer-read-description))
- (disposition (mml-minibuffer-read-disposition type nil file)))
+ (type (if current-prefix-arg
+ (or (mm-default-file-encoding file)
+ "application/octet-stream")
+ (mml-minibuffer-read-type file)))
+ (description (if current-prefix-arg
+ nil
+ (mml-minibuffer-read-description)))
+ (disposition (if current-prefix-arg
+ (mml-content-disposition type file)
+ (mml-minibuffer-read-disposition type nil file))))
(list file type description disposition)))
;; If in the message header, attach at the end and leave point unchanged.
(let ((head (unless (message-in-body-p) (point))))
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index ede118d..7f7db87 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -356,14 +356,18 @@ from the document.")
(setq nndoc-dissection-alist nil)
(with-current-buffer nndoc-current-buffer
(erase-buffer)
- (if (and (stringp nndoc-address)
- (string-match nndoc-binary-file-names nndoc-address))
- (let ((coding-system-for-read 'binary))
- (mm-insert-file-contents nndoc-address))
- (if (stringp nndoc-address)
- (nnheader-insert-file-contents nndoc-address)
- (insert-buffer-substring nndoc-address))
- (run-hooks 'nndoc-open-document-hook)))))
+ (condition-case error
+ (if (and (stringp nndoc-address)
+ (string-match nndoc-binary-file-names nndoc-address))
+ (let ((coding-system-for-read 'binary))
+ (mm-insert-file-contents nndoc-address))
+ (if (stringp nndoc-address)
+ (nnheader-insert-file-contents nndoc-address)
+ (insert-buffer-substring nndoc-address))
+ (run-hooks 'nndoc-open-document-hook))
+ (file-error
+ (nnheader-report 'nndoc "Couldn't open %s: %s"
+ group error))))))
;; Initialize the nndoc structures according to this new document.
(when (and nndoc-current-buffer
(not nndoc-dissection-alist))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 700e86a..2943c8d 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -67,7 +67,11 @@ back on `network'.")
(if (listp imap-shell-program)
(car imap-shell-program)
imap-shell-program)
- "ssh %s imapd"))
+ "ssh %s imapd")
+ "What command to execute to connect to an IMAP server.
+This will only be used if the connection type is `shell'. See
+the `open-network-stream' documentation for an explanation of
+the format.")
(defvoo nnimap-inbox nil
"The mail box where incoming mail arrives and should be split out of.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index fa16fa0..742c669 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -115,13 +115,15 @@ When called from lisp, FUNCTION may also be a function
object."
(if fn
(format "Describe function (default %s): " fn)
"Describe function: ")
- #'help--symbol-completion-table #'fboundp t nil nil
+ #'help--symbol-completion-table
+ (lambda (f) (or (fboundp f) (get f 'function-documentation)))
+ t nil nil
(and fn (symbol-name fn)))))
(unless (equal val "")
(setq fn (intern val)))
(unless (and fn (symbolp fn))
(user-error "You didn't specify a function symbol"))
- (unless (fboundp fn)
+ (unless (or (fboundp fn) (get fn 'function-documentation))
(user-error "Symbol's function definition is void: %s" fn))
(list fn)))
@@ -144,7 +146,9 @@ When called from lisp, FUNCTION may also be a function
object."
(save-excursion
(with-help-window (help-buffer)
- (prin1 function)
+ (if (get function 'reader-construct)
+ (princ function)
+ (prin1 function))
;; Use " is " instead of a colon so that
;; it is easier to get out the function name using forward-sexp.
(princ " is ")
@@ -469,7 +473,8 @@ suitable file is found, return nil."
(let ((fill-begin (point))
(high-usage (car high))
(high-doc (cdr high)))
- (insert high-usage "\n")
+ (unless (get function 'reader-construct)
+ (insert high-usage "\n"))
(fill-region fill-begin (point))
high-doc)))))
@@ -565,18 +570,21 @@ FILE is the file where FUNCTION was probably defined."
(or (and advised
(advice--cd*r (advice--symbol-function function)))
function))
- ;; Get the real definition.
+ ;; Get the real definition, if any.
(def (if (symbolp real-function)
- (or (symbol-function real-function)
- (signal 'void-function (list real-function)))
+ (cond ((symbol-function real-function))
+ ((get real-function 'function-documentation)
+ nil)
+ (t (signal 'void-function (list real-function))))
real-function))
- (aliased (or (symbolp def)
- ;; Advised & aliased function.
- (and advised (symbolp real-function)
- (not (eq 'autoload (car-safe def))))
- (and (subrp def)
- (not (string= (subr-name def)
- (symbol-name function))))))
+ (aliased (and def
+ (or (symbolp def)
+ ;; Advised & aliased function.
+ (and advised (symbolp real-function)
+ (not (eq 'autoload (car-safe def))))
+ (and (subrp def)
+ (not (string= (subr-name def)
+ (symbol-name function)))))))
(real-def (cond
((and aliased (not (subrp def)))
(let ((f real-function))
@@ -605,6 +613,8 @@ FILE is the file where FUNCTION was probably defined."
;; Print what kind of function-like object FUNCTION is.
(princ (cond ((or (stringp def) (vectorp def))
"a keyboard macro")
+ ((get function 'reader-construct)
+ "a reader construct")
;; Aliases are Lisp functions, so we need to check
;; aliases before functions.
(aliased
@@ -842,7 +852,7 @@ it is displayed along with the global value."
(terpri)
(pp val)
;; Remove trailing newline.
- (delete-char -1))
+ (and (= (char-before) ?\n) (delete-char -1)))
(let* ((sv (get variable 'standard-value))
(origval (and (consp sv)
(condition-case nil
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index a8d7294..3fb793e 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -328,7 +328,7 @@ Commands:
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
"[ \t\n]+\\)?"
;; Note starting with word-syntax character:
- "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]"))
+ "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
"Regexp matching doc string references to symbols.
The words preceding the quoted symbol can be used in doc strings to
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 4cf0573..38fe683 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -189,7 +189,8 @@ Specifically, when `hl-line-sticky-flag' is nil deactivate
all
such overlays in all buffers except the current one."
(let ((hlob hl-line-overlay-buffer)
(curbuf (current-buffer)))
- (when (and (not hl-line-sticky-flag)
+ (when (and (buffer-live-p hlob)
+ (not hl-line-sticky-flag)
(not (eq curbuf hlob))
(not (minibufferp)))
(with-current-buffer hlob
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 21aac1a..74393ff 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -365,9 +365,15 @@ commands in `hfy-etags-cmd-alist'."
(defun hfy-which-etags ()
"Return a string indicating which flavor of etags we are using."
- (let ((v (shell-command-to-string (concat hfy-etags-bin " --version"))))
- (cond ((string-match "exube" v) "exuberant ctags")
- ((string-match "GNU E" v) "emacs etags" )) ))
+ (with-temp-buffer
+ (condition-case nil
+ (when (eq (call-process hfy-etags-bin nil t nil "--version") 0)
+ (goto-char (point-min))
+ (cond
+ ((looking-at-p "exube") "exuberant ctags")
+ ((looking-at-p "GNU E") "emacs etags")))
+ ;; Return nil if the etags binary isn't executable (Bug#25468).
+ (file-error nil))))
(defcustom hfy-etags-cmd
;; We used to wrap this in a `eval-and-compile', but:
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 1f3c508..694bcb4 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -43,6 +43,7 @@
;;; Code:
(require 'info)
+(require 'subr-x)
(defgroup info-lookup nil
"Major mode sensitive help agent."
@@ -648,6 +649,26 @@ Return nil if there is nothing appropriate in the buffer
near point."
(buffer-substring-no-properties beg end)))))
(error nil)))
+(defun info-lookup-guess-gdb-script-symbol ()
+ "Get symbol at point in GDB script buffers."
+ (condition-case nil
+ (save-excursion
+ (back-to-indentation)
+ ;; Try to find the current line's full command in the index;
+ ;; and default to the longest subset that is found.
+ (when (looking-at "[-a-z]+\\(\\s-[-a-z]+\\)*")
+ (let ((str-list (split-string (match-string-no-properties 0)
+ "\\s-+" t))
+ (completions (info-lookup->completions 'symbol
+ 'gdb-script-mode)))
+ (catch 'result
+ (while str-list
+ (let ((str (string-join str-list " ")))
+ (when (assoc str completions)
+ (throw 'result str))
+ (nbutlast str-list)))))))
+ (error nil)))
+
;;;###autoload
(defun info-complete-symbol (&optional mode)
"Perform completion on symbol preceding point."
@@ -1051,6 +1072,14 @@ Return nil if there is nothing appropriate in the buffer
near point."
:mode 'help-mode
:regexp "[^][()`'‘’,:\" \t\n]+"
:other-modes '(emacs-lisp-mode))
+
+(info-lookup-maybe-add-help
+ :mode 'gdb-script-mode
+ :ignore-case nil
+ :regexp "\\([-a-z]+\\(\\s-+[-a-z]+\\)*\\)"
+ :doc-spec '(("(gdb)Command and Variable Index" nil
+ nil nil))
+ :parse-rule 'info-lookup-guess-gdb-script-symbol)
(provide 'info-look)
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index a3e53cf..fd793a2 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -192,6 +192,17 @@ the Content-Transfer-Encoding header of a mail."
(ietf-drums-init string)
(while (not (eobp))
(setq c (char-after))
+ ;; If we have an uneven number of quote characters,
+ ;; `forward-sexp' will fail. In these cases, just delete the
+ ;; final of these quote characters.
+ (when (and (eq c ?\")
+ (not
+ (save-excursion
+ (ignore-errors
+ (forward-sexp 1)
+ t))))
+ (delete-char 1)
+ (setq c (char-after)))
(cond
((or (eq c ? )
(eq c ?\t))
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 2a81609..bcbdc17 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -281,17 +281,7 @@ Should be called narrowed to the head of the message."
(encode-coding-region
(point-min) (point-max)
(mm-charset-to-coding-system
- (car message-posting-charset))))
- ;; No encoding necessary, but folding is nice
- (when nil
- (rfc2047-fold-region
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "^:")
- (when (looking-at ": ")
- (forward-char 2))
- (point))
- (point-max))))
+ (car message-posting-charset)))))
;; We found something that may perhaps be encoded.
(re-search-forward "^[^:]+: *" nil t)
(cond
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d421807..f7e0634 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -59,7 +59,7 @@
"Directory where files will downloaded."
:version "24.4"
:group 'eww
- :type 'string)
+ :type 'directory)
;;;###autoload
(defcustom eww-suggest-uris
@@ -81,7 +81,7 @@ duplicate entries (if any) removed."
"Directory where bookmark files will be stored."
:version "25.1"
:group 'eww
- :type 'string)
+ :type 'directory)
(defcustom eww-desktop-remove-duplicates t
"Whether to remove duplicates from the history when saving desktop data.
@@ -251,6 +251,29 @@ word(s) will be searched for via `eww-search-prefix'."
(if uris (format " (default %s)" (car uris)) "")
": ")))
(list (read-string prompt nil nil uris))))
+ (setq url (eww--dwim-expand-url url))
+ (pop-to-buffer-same-window
+ (if (eq major-mode 'eww-mode)
+ (current-buffer)
+ (get-buffer-create "*eww*")))
+ (eww-setup-buffer)
+ ;; Check whether the domain only uses "Highly Restricted" Unicode
+ ;; IDNA characters. If not, transform to punycode to indicate that
+ ;; there may be funny business going on.
+ (let ((parsed (url-generic-parse-url url)))
+ (unless (puny-highly-restrictive-domain-p (url-host parsed))
+ (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
+ (setq url (url-recreate-url parsed))))
+ (plist-put eww-data :url url)
+ (plist-put eww-data :title "")
+ (eww-update-header-line-format)
+ (let ((inhibit-read-only t))
+ (insert (format "Loading %s..." url))
+ (goto-char (point-min)))
+ (url-retrieve url 'eww-render
+ (list url nil (current-buffer))))
+
+(defun eww--dwim-expand-url (url)
(setq url (string-trim url))
(cond ((string-match-p "\\`file:/" url))
;; Don't mangle file: URLs at all.
@@ -275,26 +298,7 @@ word(s) will be searched for via `eww-search-prefix'."
(setq url (concat url "/"))))
(setq url (concat eww-search-prefix
(replace-regexp-in-string " " "+" url))))))
- (pop-to-buffer-same-window
- (if (eq major-mode 'eww-mode)
- (current-buffer)
- (get-buffer-create "*eww*")))
- (eww-setup-buffer)
- ;; Check whether the domain only uses "Highly Restricted" Unicode
- ;; IDNA characters. If not, transform to punycode to indicate that
- ;; there may be funny business going on.
- (let ((parsed (url-generic-parse-url url)))
- (unless (puny-highly-restrictive-domain-p (url-host parsed))
- (setf (url-host parsed) (puny-encode-domain (url-host parsed)))
- (setq url (url-recreate-url parsed))))
- (plist-put eww-data :url url)
- (plist-put eww-data :title "")
- (eww-update-header-line-format)
- (let ((inhibit-read-only t))
- (insert (format "Loading %s..." url))
- (goto-char (point-min)))
- (url-retrieve url 'eww-render
- (list url nil (current-buffer))))
+ url)
;;;###autoload (defalias 'browse-web 'eww)
@@ -351,16 +355,25 @@ Currently this means either text/html or
application/xhtml+xml."
"utf-8"))))
(data-buffer (current-buffer))
last-coding-system-used)
- ;; Save the https peer status.
(with-current-buffer buffer
- (plist-put eww-data :peer (plist-get status :peer)))
+ ;; Save the https peer status.
+ (plist-put eww-data :peer (plist-get status :peer))
+ ;; Make buffer listings more informative.
+ (setq list-buffers-directory url))
(unwind-protect
(progn
(cond
((and eww-use-external-browser-for-content-type
(string-match-p eww-use-external-browser-for-content-type
(car content-type)))
- (eww-browse-with-external-browser url))
+ (erase-buffer)
+ (insert "<title>Unsupported content type</title>")
+ (insert (format "<h1>Content-type %s is unsupported</h1>"
+ (car content-type)))
+ (insert (format "<a href=%S>Direct link to the document</a>"
+ url))
+ (goto-char (point-min))
+ (eww-display-html charset url nil point buffer encode))
((eww-html-p (car content-type))
(eww-display-html charset url nil point buffer encode))
((equal (car content-type) "application/pdf")
@@ -804,7 +817,10 @@ the like."
;;;###autoload
(defun eww-browse-url (url &optional new-window)
(when new-window
- (pop-to-buffer-same-window (generate-new-buffer "*eww*"))
+ (pop-to-buffer-same-window
+ (generate-new-buffer
+ (format "*eww-%s*" (url-host (url-generic-parse-url
+ (eww--dwim-expand-url url))))))
(eww-mode))
(eww url))
@@ -835,6 +851,8 @@ the like."
(erase-buffer)
(insert text)
(goto-char (plist-get elem :point))
+ ;; Make buffer listings more informative.
+ (setq list-buffers-directory (plist-get elem :url))
(eww-update-header-line-format))))
(defun eww-next-url ()
@@ -1483,6 +1501,7 @@ Differences in #targets are ignored."
(defun eww-download ()
"Download URL under point to `eww-download-directory'."
(interactive)
+ (access-file eww-download-directory "Download failed")
(let ((url (get-text-property (point) 'shr-url)))
(if (not url)
(message "No URL under point")
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 93e1bae..bf60eee 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -139,6 +139,10 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
+:shell-command is a format-spec string that can be used if :type
+is `shell'. It has two specs, %s for host and %p for port
+number. Example: \"ssh gateway nc %s %p\".
+
:tls-parameters is a list that should be supplied if you're
opening a TLS connection. The first element is the TLS
type (either `gnutls-x509pki' or `gnutls-anon'), and the
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e0bb3db..b7c4828 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -96,8 +96,9 @@ If nil, don't draw horizontal table lines."
(defcustom shr-width nil
"Frame width to use for rendering.
May either be an integer specifying a fixed width in characters,
-or nil, meaning that the full width of the window should be
-used."
+or nil, meaning that the full width of the window should be used.
+If `shr-use-fonts' is set, the mean character width is used to
+compute the pixel width, which is used instead."
:version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
(const :tag "Use the width of the window" nil))
@@ -978,7 +979,7 @@ element is the data blob and the second element is the
content-type."
(create-image data nil t :ascent 100
:format content-type))
((eq content-type 'image/svg+xml)
- (create-image data 'svg t :ascent 100))
+ (create-image data 'imagemagick t :ascent 100))
((eq size 'full)
(ignore-errors
(shr-rescale-image data content-type
@@ -1011,18 +1012,25 @@ element is the data blob and the second element is the
content-type."
image)
(insert (or alt ""))))
-(defun shr-rescale-image (data content-type width height)
+(defun shr-rescale-image (data content-type width height
+ &optional max-width max-height)
"Rescale DATA, if too big, to fit the current buffer.
-WIDTH and HEIGHT are the sizes given in the HTML data, if any."
+WIDTH and HEIGHT are the sizes given in the HTML data, if any.
+
+The size of the displayed image will not exceed
+MAX-WIDTH/MAX-HEIGHT. If not given, use the current window
+width/height instead."
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
(create-image data nil t :ascent 100)
(let* ((edges (window-inside-pixel-edges
(get-buffer-window (current-buffer))))
(max-width (truncate (* shr-max-image-proportion
- (- (nth 2 edges) (nth 0 edges)))))
+ (or max-width
+ (- (nth 2 edges) (nth 0 edges))))))
(max-height (truncate (* shr-max-image-proportion
- (- (nth 3 edges) (nth 1 edges)))))
+ (or max-height
+ (- (nth 3 edges) (nth 1 edges))))))
(scaling (image-compute-scaling-factor image-scaling-factor)))
(when (or (and width
(> width max-width))
@@ -1059,8 +1067,7 @@ Return a string with image data."
(when (ignore-errors
(url-cache-extract (url-cache-create-filename (shr-encode-url url)))
t)
- (when (or (search-forward "\n\n" nil t)
- (search-forward "\r\n\r\n" nil t))
+ (when (re-search-forward "\r?\n\r?\n" nil t)
(shr-parse-image-data)))))
(declare-function libxml-parse-xml-region "xml.c"
@@ -1079,9 +1086,12 @@ Return a string with image data."
obarray)))))))
;; SVG images may contain references to further images that we may
;; want to block. So special-case these by parsing the XML data
- ;; and remove the blocked bits.
- (when (eq content-type 'image/svg+xml)
+ ;; and remove anything that looks like a blocked bit.
+ (when (and shr-blocked-images
+ (eq content-type 'image/svg+xml))
(setq data
+ ;; Note that libxml2 doesn't parse everything perfectly,
+ ;; so glitches may occur during this transformation.
(shr-dom-to-xml
(libxml-parse-xml-region (point) (point-max)))))
(list data content-type)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3697d50..fc7fdd3 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4063,7 +4063,11 @@ this file, if that variable is non-nil."
(file-exists-p tramp-auto-save-directory))
(make-directory tramp-auto-save-directory t))
- (let ((system-type 'not-windows)
+ (let ((system-type
+ (if (and (stringp tramp-auto-save-directory)
+ (file-remote-p tramp-auto-save-directory))
+ 'not-windows
+ system-type))
(auto-save-file-name-transforms
(if (null tramp-auto-save-directory)
auto-save-file-name-transforms))
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index 37816bb..393f3a5 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -256,7 +256,7 @@ supported keys depend on the service type.")
"Returns all discovered Avahi service names as list."
(let (result)
(maphash
- (lambda (key value) (add-to-list 'result (zeroconf-service-name value)))
+ (lambda (_key value) (add-to-list 'result (zeroconf-service-name value)))
zeroconf-services-hash)
result))
@@ -264,7 +264,7 @@ supported keys depend on the service type.")
"Returns all discovered Avahi service types as list."
(let (result)
(maphash
- (lambda (key value) (add-to-list 'result (zeroconf-service-type value)))
+ (lambda (_key value) (add-to-list 'result (zeroconf-service-type value)))
zeroconf-services-hash)
result))
@@ -276,7 +276,7 @@ The service type is one of the returned values of
format of SERVICE."
(let (result)
(maphash
- (lambda (key value)
+ (lambda (_key value)
(when (equal type (zeroconf-service-type value))
(add-to-list 'result value)))
zeroconf-services-hash)
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 6cbd84a..ed5b4c6 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -50,7 +50,7 @@
(make-local-variable 'scroll-step)
(setq scroll-step 2))
-(defun dun-parse (arg)
+(defun dun-parse (_arg)
"Function called when return is pressed in interactive mode to parse line."
(interactive "*p")
(beginning-of-line)
@@ -210,13 +210,13 @@ disk bursts into flames, and disintegrates.")
(dun-score nil)
(setq dun-dead t))
-(defun dun-quit (args)
+(defun dun-quit (_args)
(dun-die nil))
;;; Print every object in player's inventory. Special case for the jar,
;;; as we must also print what is in it.
-(defun dun-inven (args)
+(defun dun-inven (_args)
(dun-mprinc "You currently have:")
(dun-mprinc "\n")
(dolist (curobj dun-inventory)
@@ -265,9 +265,9 @@ on your head.")
(defun dun-drop (obj)
(if dun-inbus
(dun-mprincl "You can't drop anything while on the bus.")
- (let (objnum ptr)
+ (let (objnum)
(when (setq objnum (dun-objnum-from-args-std obj))
- (if (not (setq ptr (member objnum dun-inventory)))
+ (if (not (member objnum dun-inventory))
(dun-mprincl "You don't have that.")
(progn
(dun-remove-obj-from-inven objnum)
@@ -412,10 +412,10 @@ For an explosive time, go to Fourth St. and Vermont.")
;;; We try to take an object that is untakable. Print a message
;;; depending on what it is.
-(defun dun-try-take (obj)
+(defun dun-try-take (_obj)
(dun-mprinc "You cannot take that."))
-(defun dun-dig (args)
+(defun dun-dig (_args)
(if dun-inbus
(dun-mprincl "Digging here reveals nothing.")
(if (not (member 0 dun-inventory))
@@ -557,7 +557,7 @@ with a bang. The key seems to have vanished!")
just try dropping it.")
(dun-mprincl"You can't put that there.")))))))))))
-(defun dun-type (args)
+(defun dun-type (_args)
(if (not (= dun-current-room computer-room))
(dun-mprincl "There is nothing here on which you could type.")
(if (not dun-computer)
@@ -567,40 +567,40 @@ just try dropping it.")
;;; Various movement directions
-(defun dun-n (args)
+(defun dun-n (_args)
(dun-move north))
-(defun dun-s (args)
+(defun dun-s (_args)
(dun-move south))
-(defun dun-e (args)
+(defun dun-e (_args)
(dun-move east))
-(defun dun-w (args)
+(defun dun-w (_args)
(dun-move west))
-(defun dun-ne (args)
+(defun dun-ne (_args)
(dun-move northeast))
-(defun dun-se (args)
+(defun dun-se (_args)
(dun-move southeast))
-(defun dun-nw (args)
+(defun dun-nw (_args)
(dun-move northwest))
-(defun dun-sw (args)
+(defun dun-sw (_args)
(dun-move southwest))
-(defun dun-up (args)
+(defun dun-up (_args)
(dun-move up))
-(defun dun-down (args)
+(defun dun-down (_args)
(dun-move down))
-(defun dun-in (args)
+(defun dun-in (_args)
(dun-move in))
-(defun dun-out (args)
+(defun dun-out (_args)
(dun-move out))
(defun dun-go (args)
@@ -774,7 +774,7 @@ engulf you, and you burn to death.")
huge rocks sliding down from the ceiling, and blocking your way out.\n")
(setq dun-current-room misty-room)))))
-(defun dun-long (args)
+(defun dun-long (_args)
(setq dun-mode "long"))
(defun dun-turn (obj)
@@ -867,7 +867,7 @@ as you release it, the passageway closes."))
(dun-mprincl "The button is now in the on position.")
(setq dun-black t))))))))
-(defun dun-swim (args)
+(defun dun-swim (_args)
(if (not (member dun-current-room (list lakefront-north lakefront-south)))
(dun-mprincl "I see no water!")
(if (not (member obj-life dun-inventory))
@@ -882,7 +882,7 @@ to swim.")
(setq dun-current-room lakefront-north)))))
-(defun dun-score (args)
+(defun dun-score (_args)
(if (not dun-endgame)
(let (total)
(setq total (dun-reg-score))
@@ -896,7 +896,7 @@ to swim.")
(dun-mprincl
"\n\nCongratulations. You have won. The wizard password is ‘moby’"))))
-(defun dun-help (args)
+(defun dun-help (_args)
(dun-mprincl
"Welcome to dunnet (2.02), by Ron Schnell (address@hidden - @RonnieSchnell).
Here is some useful information (read carefully because there are one
@@ -937,14 +937,14 @@ If you have questions or comments, please contact
address@hidden
My home page is http://www.driver-aces.com/ronnie.html
"))
-(defun dun-flush (args)
+(defun dun-flush (_args)
(if (not (= dun-current-room bathroom))
(dun-mprincl "I see nothing to flush.")
(dun-mprincl "Whoooosh!!")
(dun-put-objs-in-treas (nth urinal dun-room-objects))
(dun-replace dun-room-objects urinal nil)))
-(defun dun-piss (args)
+(defun dun-piss (_args)
(if (not (= dun-current-room bathroom))
(dun-mprincl "You can't do that here, don't even bother trying.")
(if (not dun-gottago)
@@ -956,7 +956,7 @@ My home page is http://www.driver-aces.com/ronnie.html
(list obj-URINE))))))
-(defun dun-sleep (args)
+(defun dun-sleep (_args)
(if (not (= dun-current-room bedroom))
(dun-mprincl
"You try to go to sleep while standing up here, but can't seem to do it.")
@@ -1012,12 +1012,12 @@ for a moment, then straighten yourself up.
(dun-mprincl "Your axe breaks it into a million pieces.")
(dun-remove-obj-from-room dun-current-room objnum)))))))))
-(defun dun-drive (args)
+(defun dun-drive (_args)
(if (not dun-inbus)
(dun-mprincl "You cannot drive when you aren't in a vehicle.")
(dun-mprincl "To drive while you are in the bus, just give a direction.")))
-(defun dun-superb (args)
+(defun dun-superb (_args)
(setq dun-mode 'dun-superb))
(defun dun-reg-score ()
@@ -1073,7 +1073,7 @@ for a moment, then straighten yourself up.
(setq i (1+ i)))
(setq dun-endgame-questions newques))))
-(defun dun-power (args)
+(defun dun-power (_args)
(if (not (= dun-current-room pc-area))
(dun-mprincl "That operation is not applicable here.")
(if (not dun-floppy)
@@ -1113,7 +1113,7 @@ for a moment, then straighten yourself up.
(dun-doverb dun-ignore dun-verblist (car rest) (cdr rest)))
(if (not (cdr (assq (intern verb) dun-verblist))) -1
(setq dun-numcmds (1+ dun-numcmds))
- (eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest)))))))
+ (funcall (cdr (assq (intern verb) dun-verblist)) rest)))))
;;; Function to take a string and change it into a list of lowercase words.
@@ -1221,11 +1221,10 @@ for a moment, then straighten yourself up.
;;; words in the command, except for the verb.
(defun dun-objnum-from-args (obj)
- (let (objnum)
- (setq obj (dun-firstword obj))
- (if (not obj)
- obj-special
- (setq objnum (cdr (assq (intern obj) dun-objnames))))))
+ (setq obj (dun-firstword obj))
+ (if (not obj)
+ obj-special
+ (cdr (assq (intern obj) dun-objnames))))
(defun dun-objnum-from-args-std (obj)
(let (result)
@@ -1251,7 +1250,7 @@ for a moment, then straighten yourself up.
;;; Given a unix style pathname, build a list of path components (recursive)
(defun dun-get-path (dirstring startlist)
- (let (slash pos)
+ (let (slash)
(if (= (length dirstring) 0)
startlist
(if (string= (substring dirstring 0 1) "/")
@@ -2480,7 +2479,7 @@ treasures for points?" "4" "four")
;;;; This section defines the UNIX emulation functions for dunnet.
;;;;
-(defun dun-unix-parse (args)
+(defun dun-unix-parse (_args)
(interactive "*p")
(beginning-of-line)
(let (beg esign)
@@ -2687,13 +2686,13 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970
..")
(dun-mprinc var)
(dun-mprinc ": Permission denied")
(setq nomore t))
- (eval (list 'dun-mprinc var))
+ (dun-mprinc var)
(dun-mprinc " ")))))))
(dun-mprinc "\n")))
(defun dun-ftp (args)
- (let (host username passwd ident newlist)
+ (let (host username ident newlist)
(if (not (car args))
(dun-mprincl "ftp: hostname required on command line.")
(setq host (intern (car args)))
@@ -2768,15 +2767,15 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970
..")
(dun-fascii 'nil)
(dun-mprincl "Unknown type.")))))
-(defun dun-bin (args)
+(defun dun-bin (_args)
(dun-mprincl "Type set to binary.")
(setq dun-ftptype 'binary))
-(defun dun-fascii (args)
+(defun dun-fascii (_args)
(dun-mprincl "Type set to ascii.")
(setq dun-ftptype 'ascii))
-(defun dun-ftpquit (args)
+(defun dun-ftpquit (_args)
(setq dun-exitf t))
(defun dun-send (args)
@@ -2831,18 +2830,18 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970
..")
(if (not foo)
(dun-mprincl "No such file."))))))
-(defun dun-ftphelp (args)
+(defun dun-ftphelp (_args)
(dun-mprincl
"Possible commands are:\nsend quit type ascii binary help"))
-(defun dun-uexit (args)
+(defun dun-uexit (_args)
(setq dungeon-mode 'dungeon)
(dun-mprincl "\nYou step back from the console.")
(define-key dun-mode-map "\r" 'dun-parse)
(if (not dun-batch-mode)
(dun-messages)))
-(defun dun-pwd (args)
+(defun dun-pwd (_args)
(dun-mprincl dun-cdpath))
(defun dun-uncompress (args)
@@ -3009,7 +3008,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
;;;; This section defines the DOS emulation functions for dunnet
;;;;
-(defun dun-dos-parse (args)
+(defun dun-dos-parse (_args)
(interactive "*p")
(beginning-of-line)
(let (beg)
@@ -3047,7 +3046,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(dun-mprincl (upcase args))))
(dun-mprincl "Must supply file name")))
-(defun dun-dos-invd (args)
+(defun dun-dos-invd (_args)
(sleep-for 1)
(dun-mprincl "Invalid drive specification"))
@@ -3084,11 +3083,11 @@ File not found")))
(if (not dun-batch-mode)
(dun-mprinc "\n")))
-(defun dun-dos-spawn (args)
+(defun dun-dos-spawn (_args)
(sleep-for 1)
(dun-mprincl "Cannot spawn subshell"))
-(defun dun-dos-exit (args)
+(defun dun-dos-exit (_args)
(setq dungeon-mode 'dungeon)
(dun-mprincl "\nYou power down the machine and step back.")
(define-key dun-mode-map "\r" 'dun-parse)
@@ -3106,7 +3105,7 @@ File not found")))
(dun-mprinc dun-combination)
(dun-mprinc ".\n"))
-(defun dun-dos-nil (args))
+(defun dun-dos-nil (_args))
;;;;
@@ -3177,9 +3176,7 @@ File not found")))
(defun dun-save-val (varname)
- (let (value)
- (setq varname (intern varname))
- (setq value (eval varname))
+ (let ((value (symbol-value (intern varname))))
(dun-minsert "(setq ")
(dun-minsert varname)
(dun-minsert " ")
@@ -3205,7 +3202,7 @@ File not found")))
(defun dun-do-logfile (type how)
- (let (ferror newscore)
+ (let (ferror)
(setq ferror nil)
(switch-to-buffer (get-buffer-create "*score*"))
(erase-buffer)
@@ -3231,8 +3228,8 @@ File not found")))
(dun-minsert (cadr (nth (abs room) dun-rooms)))
(dun-minsert ". score: ")
(if (> (dun-endgame-score) 0)
- (dun-minsert (setq newscore (+ 90 (dun-endgame-score))))
- (dun-minsert (setq newscore (dun-reg-score))))
+ (dun-minsert (+ 90 (dun-endgame-score)))
+ (dun-minsert (dun-reg-score)))
(dun-minsert " saves: ")
(dun-minsert dun-numsaves)
(dun-minsert " commands: ")
@@ -3318,7 +3315,7 @@ File not found")))
(goto-char (point-max))
(dun-mprinc "\n"))))
-(defun dungeon-nil (arg)
+(defun dungeon-nil (_arg)
"noop"
(interactive "*p")
nil)
@@ -3329,7 +3326,7 @@ File not found")))
(dun-mprinc "\n")
(dun-batch-loop))
-(unless (not noninteractive)
+(when noninteractive
(fset 'dun-mprinc 'dun-batch-mprinc)
(fset 'dun-mprincl 'dun-batch-mprincl)
(fset 'dun-vparse 'dun-batch-parse)
@@ -3343,8 +3340,8 @@ File not found")))
(provide 'dunnet)
-;;; dunnet.el ends here
-
;; Local Variables:
;; byte-compile-warnings: (not free-vars lexical)
;; End:
+
+;;; dunnet.el ends here
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e84c4ce..fd7aa50 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -313,7 +313,8 @@ comment at the start of cc-engine.el for more info."
(c-macro-is-genuine-p))
(progn
(setq c-macro-cache (cons (point) nil)
- c-macro-cache-start-pos here)
+ c-macro-cache-start-pos here
+ c-macro-cache-syntactic nil)
t)
(goto-char here)
nil))))))
@@ -344,7 +345,8 @@ comment at the start of cc-engine.el for more info."
(forward-char)
t)))
(when (car c-macro-cache)
- (setcdr c-macro-cache (point)))))
+ (setcdr c-macro-cache (point))
+ (setq c-macro-cache-syntactic nil))))
(defun c-syntactic-end-of-macro ()
;; Go to the end of a CPP directive, or a "safe" pos just before.
@@ -364,7 +366,8 @@ comment at the start of cc-engine.el for more info."
(goto-char c-macro-cache-syntactic)
(setq s (parse-partial-sexp here there))
(while (and (or (nth 3 s) ; in a string
- (nth 4 s)) ; in a comment (maybe at end of line comment)
+ (and (nth 4 s) ; in a comment (maybe at end of line
comment)
+ (not (eq (nth 7 s) 'syntax-table)))) ; Not a pseudo
comment
(> there here)) ; No infinite loops, please.
(setq there (1- (nth 8 s)))
(setq s (parse-partial-sexp here there)))
@@ -389,7 +392,8 @@ comment at the start of cc-engine.el for more info."
(> there here)) ; No infinite loops, please.
(setq here (1+ (nth 8 s)))
(setq s (parse-partial-sexp here there)))
- (when (nth 4 s)
+ (when (and (nth 4 s)
+ (not (eq (nth 7 s) 'syntax-table))) ; no pseudo comments.
(goto-char (1- (nth 8 s))))
(setq c-macro-cache-no-comment (point)))
(point)))
@@ -2407,7 +2411,9 @@ comment at the start of cc-engine.el for more info."
(s (parse-partial-sexp base here nil nil s))
ty)
(cond
- ((or (nth 3 s) (nth 4 s)) ; in a string or comment
+ ((or (nth 3 s)
+ (and (nth 4 s)
+ (not (eq (nth 7 s) 'syntax-table)))) ; in a string or
comment
(setq ty (cond
((nth 3 s) 'string)
((nth 7 s) 'c++)
@@ -2453,7 +2459,9 @@ comment at the start of cc-engine.el for more info."
(s (parse-partial-sexp base here nil nil s))
ty start)
(cond
- ((or (nth 3 s) (nth 4 s)) ; in a string or comment
+ ((or (nth 3 s)
+ (and (nth 4 s)
+ (not (eq (nth 7 s) 'syntax-table)))) ; in a string or
comment
(setq ty (cond
((nth 3 s) 'string)
((nth 7 s) 'c++)
@@ -2479,7 +2487,7 @@ comment at the start of cc-engine.el for more info."
(t (list s))))))))
-(defsubst c-state-pp-to-literal (from to &optional not-in-delimiter)
+(defun c-state-pp-to-literal (from to &optional not-in-delimiter)
;; Do a parse-partial-sexp from FROM to TO, returning either
;; (STATE TYPE (BEG . END)) if TO is in a literal; or
;; (STATE) otherwise,
@@ -2498,7 +2506,9 @@ comment at the start of cc-engine.el for more info."
(let ((s (parse-partial-sexp from to))
ty co-st)
(cond
- ((or (nth 3 s) (nth 4 s)) ; in a string or comment
+ ((or (nth 3 s)
+ (and (nth 4 s)
+ (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment
(setq ty (cond
((nth 3 s) 'string)
((nth 7 s) 'c++)
@@ -2560,7 +2570,8 @@ comment at the start of cc-engine.el for more info."
(cond
((nth 3 state) ; A string
(list (point) (nth 3 state) (nth 8 state)))
- ((nth 4 state) ; A comment
+ ((and (nth 4 state) ; A comment
+ (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment.
(list (point)
(if (eq (nth 7 state) 1) 'c++ 'c)
(nth 8 state)))
@@ -2697,7 +2708,7 @@ comment at the start of cc-engine.el for more info."
(widen)
(save-excursion
(let ((pos (c-state-safe-place here)))
- (car (cddr (c-state-pp-to-literal pos here)))))))
+ (car (cddr (c-state-pp-to-literal pos here)))))))
(defsubst c-state-lit-beg (pos)
;; Return the start of the literal containing POS, or POS itself.
@@ -2708,7 +2719,8 @@ comment at the start of cc-engine.el for more info."
;; Return a position outside of a string/comment/macro at or before POS.
;; STATE is the parse-partial-sexp state at POS.
(let ((res (if (or (nth 3 state) ; in a string?
- (nth 4 state)) ; in a comment?
+ (and (nth 4 state)
+ (not (eq (nth 7 state) 'syntax-table)))) ; in a
comment?
(nth 8 state)
pos)))
(save-excursion
@@ -3467,7 +3479,7 @@ comment at the start of cc-engine.el for more info."
((and (consp (car c-state-cache))
(> (cdar c-state-cache) here))
;; CASE 1: The top of the cache is a brace pair which now encloses
- ;; `here'. As good-pos, return the address. of the "{". Since we've no
+ ;; `here'. As good-pos, return the address of the "{". Since we've no
;; knowledge of what's inside these braces, we have no alternative but
;; to direct the caller to scan the buffer from the opening brace.
(setq pos (caar c-state-cache))
@@ -4952,7 +4964,8 @@ comment at the start of cc-engine.el for more info."
(lit-limits
(if lim
(let ((s (parse-partial-sexp lim (point))))
- (when (or (nth 3 s) (nth 4 s))
+ (when (or (nth 3 s)
+ (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))))
(cons (nth 8 s)
(progn (parse-partial-sexp (point) (point-max)
nil nil
@@ -5005,7 +5018,8 @@ point isn't in one. SAFE-POS, if non-nil, is a position
before point which is
a known \"safe position\", i.e. outside of any string or comment."
(if safe-pos
(let ((s (parse-partial-sexp safe-pos (point))))
- (and (or (nth 3 s) (nth 4 s))
+ (and (or (nth 3 s)
+ (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))))
(nth 8 s)))
(car (cddr (c-state-semi-pp-to-literal (point))))))
@@ -5106,7 +5120,8 @@ comment at the start of cc-engine.el for more info."
'syntax-table)) ; stop-comment
;; Gather details of the non-literal-bit - starting pos and size.
- (setq size (- (if (or (nth 4 s) (nth 3 s))
+ (setq size (- (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))
+ (nth 3 s))
(nth 8 s)
(point))
pos))
@@ -5114,7 +5129,8 @@ comment at the start of cc-engine.el for more info."
(setq stack (cons (cons pos size) stack)))
;; Move forward to the end of the comment/string.
- (if (or (nth 4 s) (nth 3 s))
+ (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))
+ (nth 3 s))
(setq s (parse-partial-sexp
(point)
start
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 7e3c6ba..e2969c6 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1068,7 +1068,8 @@ Note that the style variables are always made local to
the buffer."
(parse-partial-sexp pps-position (point) nil nil
pps-state)
pps-position (point))
(or (nth 3 pps-state) ; in a string?
- (nth 4 pps-state)))) ; in a comment?
+ (and (nth 4 pps-state)
+ (not (eq (nth 7 pps-state) 'syntax-table)))))) ; in
a comment?
(goto-char (match-beginning 1))
(setq mbeg (point))
(if (> (c-no-comment-end-of-macro) mbeg)
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 0e4e670..5328526 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -582,7 +582,7 @@ and then further adjusted to be at the end of the line."
(setq p (line-end-position)))
;; `q' is the point at the end of the block
(hs-forward-sexp mdata 1)
- (setq q (if (looking-back hs-block-end-regexp)
+ (setq q (if (looking-back hs-block-end-regexp nil)
(match-beginning 0)
(point)))
(when (and (< p q) (> (count-lines p q) 1))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 54df391..74dd4ad 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -574,8 +574,8 @@ then the \".\"s will be lined up:
(define-key keymap [(control ?c) (control ?j)] #'js-set-js-context)
(define-key keymap [(control meta ?x)] #'js-eval-defun)
(define-key keymap [(meta ?.)] #'js-find-symbol)
- (easy-menu-define nil keymap "Javascript Menu"
- '("Javascript"
+ (easy-menu-define nil keymap "JavaScript Menu"
+ '("JavaScript"
["Select New Mozilla Context..." js-set-js-context
(fboundp #'inferior-moz-process)]
["Evaluate Expression in Mozilla Context..." js-eval
@@ -1712,7 +1712,7 @@ This performs fontification according to
`js--class-styles'."
nil))))))
(defun js-syntax-propertize (start end)
- ;; Javascript allows immediate regular expression objects, written /.../.
+ ;; JavaScript allows immediate regular expression objects, written /.../.
(goto-char start)
(js-syntax-propertize-regexp end)
(funcall
@@ -1720,10 +1720,10 @@ This performs fontification according to
`js--class-styles'."
;; Distinguish /-division from /-regexp chars (and from /-comment-starter).
;; FIXME: Allow regexps after infix ops like + ...
;; https://developer.mozilla.org/en/JavaScript/Reference/Operators
- ;; We can probably just add +, -, !, <, >, %, ^, ~, |, &, ?, : at which
+ ;; We can probably just add +, -, <, >, %, ^, ~, ?, : at which
;; point I think only * and / would be missing which could also be added,
;; but need care to avoid affecting the // and */ comment markers.
- ("\\(?:^\\|[=([{,:;]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
+ ("\\(?:^\\|[=([{,:;|&!]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
(1 (ignore
(forward-char -1)
(when (or (not (memq (char-after (match-beginning 0)) '(?\s ?\t)))
@@ -2710,7 +2710,7 @@ current buffer. Pushes a mark onto the tag ring just like
;;; MozRepl integration
(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error))
-(define-error 'js-js-error "Javascript Error") ;; '(js-error error))
+(define-error 'js-js-error "JavaScript Error") ;; '(js-error error))
(defun js--wait-for-matching-output
(process regexp timeout &optional start)
@@ -3214,7 +3214,7 @@ with `js--js-encode-value'."
Inside the lexical scope of `with-js', `js?', `js!',
`js-new', `js-eval', `js-list', `js<', `js>', `js-get-service',
`js-create-instance', and `js-qi' are defined."
-
+ (declare (indent 0) (debug t))
`(progn
(js--js-enter-repl)
(unwind-protect
@@ -3391,7 +3391,7 @@ With argument, run even if no intervening GC has
happened."
(defun js-eval (js)
"Evaluate the JavaScript in JS and return JSON-decoded result."
- (interactive "MJavascript to evaluate: ")
+ (interactive "MJavaScript to evaluate: ")
(with-js
(let* ((content-window (js--js-content-window
(js--get-js-context)))
@@ -3431,11 +3431,8 @@ left-to-right."
(eq (cl-fifth window-info) 2))
do (push window-info windows))
- (cl-loop for window-info in windows
- for window = (cl-first window-info)
- collect (list (cl-second window-info)
- (cl-third window-info)
- window)
+ (cl-loop for (window title location) in windows
+ collect (list title location window)
for gbrowser = (js< window "gBrowser")
if (js-handle? gbrowser)
@@ -3668,7 +3665,7 @@ Change with `js-set-js-context'.")
(defun js-set-js-context (context)
"Set the JavaScript context to CONTEXT.
When called interactively, prompt for CONTEXT."
- (interactive (list (js--read-tab "Javascript Context: ")))
+ (interactive (list (js--read-tab "JavaScript Context: ")))
(setq js--js-context context))
(defun js--get-js-context ()
@@ -3682,7 +3679,7 @@ If one hasn't been set, or if it's stale, prompt for a
new one."
(`browser (not (js? (js< (cdr js--js-context)
"contentDocument"))))
(x (error "Unmatched case in js--get-js-context: %S" x))))
- (setq js--js-context (js--read-tab "Javascript Context: ")))
+ (setq js--js-context (js--read-tab "JavaScript Context: ")))
js--js-context))
(defun js--js-content-window (context)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d8262dd..90b5e4e 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4693,7 +4693,8 @@ likely an invalid python file."
(let ((dedenter-pos (python-info-dedenter-statement-p)))
(when dedenter-pos
(goto-char dedenter-pos)
- (let* ((pairs '(("elif" "elif" "if")
+ (let* ((cur-line (line-beginning-position))
+ (pairs '(("elif" "elif" "if")
("else" "if" "elif" "except" "for" "while")
("except" "except" "try")
("finally" "else" "except" "try")))
@@ -4709,7 +4710,22 @@ likely an invalid python file."
(let ((indentation (current-indentation)))
(when (and (not (memq indentation collected-indentations))
(or (not collected-indentations)
- (< indentation (apply #'min
collected-indentations))))
+ (< indentation (apply #'min
collected-indentations)))
+ ;; There must be no line with indentation
+ ;; smaller than `indentation' (except for
+ ;; blank lines) between the found opening
+ ;; block and the current line, otherwise it
+ ;; is not an opening block.
+ (save-excursion
+ (forward-line)
+ (let ((no-back-indent t))
+ (save-match-data
+ (while (and (< (point) cur-line)
+ (setq no-back-indent
+ (or (>
(current-indentation) indentation)
+
(python-info-current-line-empty-p))))
+ (forward-line)))
+ no-back-indent)))
(setq collected-indentations
(cons indentation collected-indentations))
(when (member (match-string-no-properties 0)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 7156348..8868343 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2790,7 +2790,7 @@ local variable."
;; Iterate until we've moved the desired number of stmt ends
(while (not (= (cl-signum arg) 0))
;; if we're looking at the terminator, jump by 2
- (if (or (and (> 0 arg) (looking-back term))
+ (if (or (and (> 0 arg) (looking-back term nil))
(and (< 0 arg) (looking-at term)))
(setq n 2)
(setq n 1))
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 0e8ff52..6c76d7e 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -126,6 +126,14 @@
;;; Code:
+(eval-when-compile (require 'cl))
+(eval-and-compile
+ ;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
+ ;; even for relatively simple cases such as used here. We only test <25
+ ;; because it's easier and sufficient.
+ (when (or (featurep 'xemacs) (< emacs-major-version 25))
+ (require 'cl)))
+
;; Emacs 21+ handling
(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep
'xemacs)))
"Non-nil if GNU Emacs 21, 22, ... is used.")
@@ -14314,7 +14322,7 @@ of PROJECT."
(vhdl-scan-directory-contents dir-name project nil
(format "(%s/%s) " act-dir num-dir)
(cdr dir-list))
- (add-to-list 'dir-list-tmp (file-name-directory dir-name))
+ (pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
(setq dir-list (cdr dir-list)
act-dir (1+ act-dir)))
(vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
@@ -16406,8 +16414,8 @@ component instantiation."
(if (or (member constant-name single-list)
(member constant-name multi-list))
(progn (setq single-list (delete constant-name single-list))
- (add-to-list 'multi-list constant-name))
- (add-to-list 'single-list constant-name))
+ (pushnew constant-name multi-list :test #'equal))
+ (pushnew constant-name single-list :test #'equal))
(unless (match-string 1)
(setq generic-alist (cdr generic-alist)))
(vhdl-forward-syntactic-ws))
@@ -16433,12 +16441,12 @@ component instantiation."
(member signal-name multi-out-list))
(setq single-out-list (delete signal-name single-out-list))
(setq multi-out-list (delete signal-name multi-out-list))
- (add-to-list 'local-list signal-name))
+ (pushnew signal-name local-list :test #'equal))
((member signal-name single-in-list)
(setq single-in-list (delete signal-name single-in-list))
- (add-to-list 'multi-in-list signal-name))
+ (pushnew signal-name multi-in-list :test #'equal))
((not (member signal-name multi-in-list))
- (add-to-list 'single-in-list signal-name)))
+ (pushnew signal-name single-in-list :test #'equal)))
;; output signal
(cond
((member signal-name local-list)
@@ -16447,17 +16455,18 @@ component instantiation."
(member signal-name multi-in-list))
(setq single-in-list (delete signal-name single-in-list))
(setq multi-in-list (delete signal-name multi-in-list))
- (add-to-list 'local-list signal-name))
+ (pushnew signal-name local-list :test #'equal))
((member signal-name single-out-list)
(setq single-out-list (delete signal-name single-out-list))
- (add-to-list 'multi-out-list signal-name))
+ (pushnew signal-name multi-out-list :test #'equal))
((not (member signal-name multi-out-list))
- (add-to-list 'single-out-list signal-name))))
+ (pushnew signal-name single-out-list :test #'equal))))
(unless (match-string 1)
(setq port-alist (cdr port-alist)))
(vhdl-forward-syntactic-ws))
(push (list inst-name (nreverse constant-alist)
- (nreverse signal-alist)) inst-alist))
+ (nreverse signal-alist))
+ inst-alist))
;; prepare signal insertion
(vhdl-goto-marker arch-decl-pos)
(forward-line 1)
@@ -16534,14 +16543,14 @@ component instantiation."
generic-end-pos
(vhdl-compose-insert-generic constant-entry)))
(setq generic-pos (point-marker))
- (add-to-list 'written-list constant-name))
+ (pushnew constant-name written-list :test #'equal))
(t
(vhdl-goto-marker
(vhdl-max-marker generic-inst-pos generic-pos))
(setq generic-end-pos
(vhdl-compose-insert-generic constant-entry))
(setq generic-inst-pos (point-marker))
- (add-to-list 'written-list constant-name))))
+ (pushnew constant-name written-list :test #'equal))))
(setq constant-alist (cdr constant-alist)))
(when (/= constant-temp-pos generic-inst-pos)
(vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
@@ -16560,14 +16569,14 @@ component instantiation."
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-in-pos (point-marker))
- (add-to-list 'written-list signal-name))
+ (pushnew signal-name written-list :test #'equal))
((member signal-name multi-out-list)
(vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
(setq port-end-pos
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-out-pos (point-marker))
- (add-to-list 'written-list signal-name))
+ (pushnew signal-name written-list :test #'equal))
((or (member signal-name single-in-list)
(member signal-name single-out-list))
(vhdl-goto-marker
@@ -16576,12 +16585,12 @@ component instantiation."
(vhdl-max-marker port-out-pos port-in-pos)))
(setq port-end-pos (vhdl-compose-insert-port signal-entry))
(setq port-inst-pos (point-marker))
- (add-to-list 'written-list signal-name))
+ (pushnew signal-name written-list :test #'equal))
((equal (upcase (nth 2 signal-entry)) "OUT")
(vhdl-goto-marker signal-pos)
(vhdl-compose-insert-signal signal-entry)
(setq signal-pos (point-marker))
- (add-to-list 'written-list signal-name)))
+ (pushnew signal-name written-list :test #'equal)))
(setq signal-alist (cdr signal-alist)))
(when (/= port-temp-pos port-inst-pos)
(vhdl-goto-marker
@@ -16932,7 +16941,7 @@ no project is defined."
"Remove duplicate elements from IN-LIST."
(let (out-list)
(while in-list
- (add-to-list 'out-list (car in-list))
+ (pushnew (car in-list) out-list :test #'equal)
(setq in-list (cdr in-list)))
out-list))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index d8098c5..a507755 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -918,6 +918,10 @@ IGNORES is a list of glob patterns."
(grep-compute-defaults)
(defvar grep-find-template)
(defvar grep-highlight-matches)
+ ;; 'grep -E -foo' results in 'grep: oo: No such file or directory'.
+ ;; while 'grep -e -foo' inexplicably doesn't.
+ (when (eq (aref regexp 0) ?-)
+ (setq regexp (concat "\\" regexp)))
(let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
grep-find-template t t))
(grep-highlight-matches nil)
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 2b1d22b..4f05739 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -82,7 +82,7 @@ See the command `recentf-save-list'."
recentf-mode
(recentf-load-list)))))
-(defcustom recentf-save-file-modes 384 ;; 0600
+(defcustom recentf-save-file-modes #o600
"Mode bits of recentf save file, as an integer, or nil.
If non-nil, after writing `recentf-save-file', set its mode bits to
this value. By default give R/W access only to the user who owns that
diff --git a/lisp/shell.el b/lisp/shell.el
index 133771a..c8a8555 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -544,11 +544,14 @@ control whether input and output cause the window to
scroll to the end of the
buffer."
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
- (set (make-local-variable 'paragraph-separate) "\\'")
- (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
- (set (make-local-variable 'font-lock-defaults) '(shell-font-lock-keywords t))
- (set (make-local-variable 'shell-dirstack) nil)
- (set (make-local-variable 'shell-last-dir) nil)
+ (setq-local paragraph-separate "\\'")
+ (setq-local paragraph-start comint-prompt-regexp)
+ (setq-local font-lock-defaults '(shell-font-lock-keywords t))
+ (setq-local shell-dirstack nil)
+ (setq-local shell-last-dir nil)
+ ;; People expect Shell mode to keep the last line of output at
+ ;; window bottom.
+ (setq-local scroll-conservatively 101)
(shell-dirtrack-mode 1)
;; By default, ansi-color applies faces using overlays. This is
diff --git a/lisp/simple.el b/lisp/simple.el
index f798cd4..441713a 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5410,11 +5410,15 @@ also checks the value of `use-empty-active-region'."
;; region is active when there's no mark.
(progn (cl-assert (mark)) t)))
+(defun region-bounds ()
+ "Return the boundaries of the region as a list of (START . END) positions."
+ (funcall region-extract-function 'bounds))
+
(defun region-noncontiguous-p ()
"Return non-nil if the region contains several pieces.
An example is a rectangular region handled as a list of
separate contiguous regions for each line."
- (> (length (funcall region-extract-function 'bounds)) 1))
+ (> (length (region-bounds)) 1))
(defvar redisplay-unhighlight-region-function
(lambda (rol) (when (overlayp rol) (delete-overlay rol))))
@@ -7568,7 +7572,7 @@ More precisely, a char with closeparen syntax is
self-inserted.")
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
-;; that happens in the QUIT macro at the C code level.
+;; that happens in the maybe_quit function at the C code level.
(defun keyboard-quit ()
"Signal a `quit' condition.
During execution of Lisp code, this character causes a quit directly.
diff --git a/lisp/subr.el b/lisp/subr.el
index 5377416..a6ba05c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -384,6 +384,126 @@ configuration."
(declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr x)))
+(defun caaar (x)
+ "Return the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (car (car x))))
+
+(defun caadr (x)
+ "Return the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (car (cdr x))))
+
+(defun cadar (x)
+ "Return the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (cdr (car x))))
+
+(defun caddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (cdr (cdr x))))
+
+(defun cdaar (x)
+ "Return the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (car (car x))))
+
+(defun cdadr (x)
+ "Return the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (car (cdr x))))
+
+(defun cddar (x)
+ "Return the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (cdr (car x))))
+
+(defun cdddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (cdr (cdr x))))
+
+(defun caaaar (x)
+ "Return the `car' of the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (car (car (car x)))))
+
+(defun caaadr (x)
+ "Return the `car' of the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (car (car (cdr x)))))
+
+(defun caadar (x)
+ "Return the `car' of the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (car (cdr (car x)))))
+
+(defun caaddr (x)
+ "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (car (cdr (cdr x)))))
+
+(defun cadaar (x)
+ "Return the `car' of the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (cdr (car (car x)))))
+
+(defun cadadr (x)
+ "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (cdr (car (cdr x)))))
+
+(defun caddar (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (cdr (cdr (car x)))))
+
+(defun cadddr (x)
+ "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (car (cdr (cdr (cdr x)))))
+
+(defun cdaaar (x)
+ "Return the `cdr' of the `car' of the `car' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (car (car (car x)))))
+
+(defun cdaadr (x)
+ "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (car (car (cdr x)))))
+
+(defun cdadar (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (car (cdr (car x)))))
+
+(defun cdaddr (x)
+ "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (car (cdr (cdr x)))))
+
+(defun cddaar (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (cdr (car (car x)))))
+
+(defun cddadr (x)
+ "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (cdr (car (cdr x)))))
+
+(defun cdddar (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (cdr (cdr (car x)))))
+
+(defun cddddr (x)
+ "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
+ (cdr (cdr (cdr (cdr x)))))
+
(defun last (list &optional n)
"Return the last link of LIST. Its car is the last element.
If LIST is nil, return nil.
diff --git a/lisp/term.el b/lisp/term.el
index 5259571..063a6ea 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -2901,15 +2901,16 @@ See `term-prompt-regexp'."
((eq char ?\017)) ; Shift In - ignored
((eq char ?\^G) ;; (terminfo: bel)
(beep t))
- ((and (eq char ?\032)
- (not handled-ansi-message))
+ ((eq char ?\032)
(let ((end (string-match "\r?\n" str i)))
(if end
- (funcall term-command-hook
- (decode-coding-string
- (prog1 (substring str (1+ i) end)
- (setq i (1- (match-end 0))))
- locale-coding-system))
+ (progn
+ (unless handled-ansi-message
+ (funcall term-command-hook
+ (decode-coding-string
+ (substring str (1+ i) end)
+ locale-coding-system)))
+ (setq i (1- (match-end 0))))
(setq term-terminal-parameter (substring str i))
(setq term-terminal-state 4)
(setq i str-length))))
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index dfe1cf0..c81c3f6 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -27,7 +27,6 @@
;;; Todo:
-;; - electric ; and }
;; - filling code with auto-fill-mode
;; - fix font-lock errors with multi-line selectors
@@ -667,6 +666,8 @@ cannot be completed sensibly: `custom-ident',
;; Variables.
(,(concat "--" css-ident-re) (0 font-lock-variable-name-face))
;; Selectors.
+ ;; Allow plain ":root" as a selector.
+ ("^[ \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
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 63abd04..03da584 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -164,6 +164,8 @@ distribution. Mixed-case symbols are convenience aliases.")
(?U . "\\autocite*[][]{%l}")
(?a . "\\citeauthor{%l}")
(?A . "\\citeauthor*{%l}")
+ (?i . "\\citetitle{%l}")
+ (?I . "\\citetitle*{%l}")
(?y . "\\citeyear{%l}")
(?Y . "\\citeyear*{%l}")
(?n . "\\nocite{%l}")))
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 06f969d..261e98e 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -109,7 +109,7 @@
(def-edebug-spec push
(&or [form symbolp] [form gv-place]))
-;; Correct wrong declaration. This still doesn't support dotted desctructuring
+;; Correct wrong declaration. This still doesn't support dotted destructuring
;; though.
(def-edebug-spec cl-lambda-list
(([&rest cl-macro-arg]
@@ -1006,7 +1006,7 @@ BEG-UND are the starting points of the overline or
underline,
respectively. They may be nil if the respective thing is missing.
BEG-TXT is the beginning of the title line or the transition and
must be given. The end of the line is used as the end point. TXT
-is the title text or nil. If TXT is given the indendation of the
+is the title text or nil. If TXT is given the indentation of the
line containing BEG-TXT is used as indentation. Match group 0 is
derived from the remaining information."
(cl-check-type beg-txt integer-or-marker)
@@ -1845,8 +1845,7 @@ Uses and sets `rst-all-ttls-cache'."
HDRS reflects the order in which the headers appear in the
buffer. Return a `rst-Hdr' list representing the hierarchy of
headers in the buffer. Indentation is unified."
- (let (ado2indents) ; Asscociates `rst-Ado' with the set of indents seen for
- ; it.
+ (let (ado2indents) ; Associates `rst-Ado' with the set of indents seen for
it.
(dolist (hdr hdrs)
(let* ((ado (rst-Hdr-ado hdr))
(indent (rst-Hdr-indent hdr))
@@ -2451,7 +2450,7 @@ also arranged by `rst-insert-list-new-tag'."
(defun rst-insert-list-continue (ind tag tab prefer-roman)
;; testcover: ok.
"Insert a new list tag after the current line according to style.
-Style is defined by indentaton IND, TAG and suffix TAB. If
+Style is defined by indentation IND, TAG and suffix TAB. If
PREFER-ROMAN roman numbering is preferred over using letters."
(end-of-line)
(insert
@@ -2551,8 +2550,8 @@ roman numerical list, just use a prefix to set
PREFER-ROMAN."
"Return the positions of begs in region BEG to END.
RST-RE-BEG is a `rst-re' argument and matched at the beginning of
a line. Return a list of (POINT . COLUMN) where POINT gives the
-point after indentaton and COLUMN gives its column. The list is
-ordererd by POINT."
+point after indentation and COLUMN gives its column. The list is
+ordered by POINT."
(let (r)
(save-match-data
(save-excursion
@@ -2963,7 +2962,7 @@ error if there is no working link at the given position."
(unless link-buf
(setq link-buf (current-buffer)))
;; Do not catch errors from `rst-toc-get-link' because otherwise the error is
- ;; suppressed and invisible in interactve use.
+ ;; suppressed and invisible in interactive use.
(let ((mrkr (rst-toc-get-link link-buf link-pnt)))
(condition-case nil
(rst-toc-mode-return kill)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 9dfcd94..e609ca9 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -498,22 +498,57 @@ See
http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html";)
;; The return value is used by easy-mmode-define-navigation.
(goto-char (or end (point-max)))))
+;; "index ", "old mode", "new mode", "new file mode" and
+;; "deleted file mode" are output by git-diff.
+(defconst diff-file-junk-re
+ (concat "Index: \\|=\\{20,\\}\\|" ; SVN
+ "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\)
mode\\|=== modified file"))
+
+;; If point is in a diff header, then return beginning
+;; of hunk position otherwise return nil.
+(defun diff--at-diff-header-p ()
+ "Return non-nil if point is inside a diff header."
+ (let ((regexp-hunk diff-hunk-header-re)
+ (regexp-file diff-file-header-re)
+ (regexp-junk diff-file-junk-re)
+ (orig (point)))
+ (catch 'headerp
+ (save-excursion
+ (forward-line 0)
+ (when (looking-at regexp-hunk) ; Hunk header.
+ (throw 'headerp (point)))
+ (forward-line -1)
+ (when (re-search-forward regexp-file (point-at-eol 4) t) ; File header.
+ (forward-line 0)
+ (throw 'headerp (point)))
+ (goto-char orig)
+ (forward-line 0)
+ (when (looking-at regexp-junk) ; Git diff junk.
+ (while (and (looking-at regexp-junk)
+ (not (bobp)))
+ (forward-line -1))
+ (re-search-forward regexp-file nil t)
+ (forward-line 0)
+ (throw 'headerp (point)))) nil)))
+
(defun diff-beginning-of-hunk (&optional try-harder)
"Move back to the previous hunk beginning, and return its position.
If point is in a file header rather than a hunk, advance to the
next hunk if TRY-HARDER is non-nil; otherwise signal an error."
(beginning-of-line)
- (if (looking-at diff-hunk-header-re)
+ (if (looking-at diff-hunk-header-re) ; At hunk header.
(point)
- (forward-line 1)
- (condition-case ()
- (re-search-backward diff-hunk-header-re)
- (error
- (unless try-harder
- (error "Can't find the beginning of the hunk"))
- (diff-beginning-of-file-and-junk)
- (diff-hunk-next)
- (point)))))
+ (let ((pos (diff--at-diff-header-p))
+ (regexp diff-hunk-header-re))
+ (cond (pos ; At junk diff header.
+ (if try-harder
+ (goto-char pos)
+ (error "Can't find the beginning of the hunk")))
+ ((re-search-backward regexp nil t)) ; In the middle of a hunk.
+ ((re-search-forward regexp nil t) ; At first hunk header.
+ (forward-line 0)
+ (point))
+ (t (error "Can't find the beginning of the hunk"))))))
(defun diff-unified-hunk-p ()
(save-excursion
@@ -551,124 +586,26 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an
error."
;; Define diff-{hunk,file}-{prev,next}
(easy-mmode-define-navigation
- diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk
diff-restrict-view)
+ diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view
+ (when diff-auto-refine-mode
+ (unless (prog1 diff--auto-refine-data
+ (setq diff--auto-refine-data
+ (cons (current-buffer) (point-marker))))
+ (run-at-time 0.0 nil
+ (lambda ()
+ (when diff--auto-refine-data
+ (let ((buffer (car diff--auto-refine-data))
+ (point (cdr diff--auto-refine-data)))
+ (setq diff--auto-refine-data nil)
+ (with-local-quit
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char point)
+ (diff-refine-hunk))))))))))))
(easy-mmode-define-navigation
- diff--internal-file diff-file-header-re "file" diff-end-of-file)
-
-(defun diff--wrap-navigation (skip-hunk-start
- what orig
- header-re goto-start-func count)
- "Wrap diff-{hunk,file}-{next,prev} for more intuitive behavior.
-Override the default diff-{hunk,file}-{next,prev} implementation
-by skipping any lines that are associated with this hunk/file but
-precede the hunk-start marker. For instance, a diff file could
-contain
-
-diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
-index 923de9a..6b1c24f 100644
---- a/lisp/vc/diff-mode.el
-+++ b/lisp/vc/diff-mode.el
-@@ -590,6 +590,22 @@
-.......
-
-If a point is on 'index', then the point is considered to be in
-this first hunk. Move the point to the @@... marker before
-executing the default diff-hunk-next/prev implementation to move
-to the NEXT marker."
- (if (not skip-hunk-start)
- (funcall orig count)
-
- (let ((start (point)))
- (funcall goto-start-func)
-
- ;; Trap the error.
- (condition-case nil
- (funcall orig count)
- (error nil))
-
- (when (not (looking-at header-re))
- (goto-char start)
- (user-error (format "No %s" what)))
-
- ;; We successfully moved to the next/prev hunk/file. Apply the
- ;; auto-refinement if needed
- (when diff-auto-refine-mode
- (unless (prog1 diff--auto-refine-data
- (setq diff--auto-refine-data
- (cons (current-buffer) (point-marker))))
- (run-at-time 0.0 nil
- (lambda ()
- (when diff--auto-refine-data
- (let ((buffer (car diff--auto-refine-data))
- (point (cdr diff--auto-refine-data)))
- (setq diff--auto-refine-data nil)
- (with-local-quit
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (save-excursion
- (goto-char point)
- (diff-refine-hunk))))))))))))))
-
-;; These functions all take a skip-hunk-start argument which controls
-;; whether we skip pre-hunk-start text or not. In interactive uses we
-;; always want to do this, but the simple behavior is still necessary
-;; to, for example, avoid an infinite loop:
-;;
-;; diff-hunk-next calls
-;; diff--wrap-navigation calls
-;; diff-bounds-of-hunk calls
-;; diff-beginning-of-hunk calls
-;; diff-hunk-next
-;;
-;; Here the outer diff-hunk-next has skip-hunk-start set to t, but the
-;; inner one does not, which breaks the loop.
-(defun diff-hunk-prev (&optional count skip-hunk-start)
- "Go to the previous COUNT'th hunk."
- (interactive (list (prefix-numeric-value current-prefix-arg) t))
- (diff--wrap-navigation
- skip-hunk-start
- "prev hunk"
- 'diff--internal-hunk-prev
- diff-hunk-header-re
- (lambda () (goto-char (car (diff-bounds-of-hunk))))
- count))
-
-(defun diff-hunk-next (&optional count skip-hunk-start)
- "Go to the next COUNT'th hunk."
- (interactive (list (prefix-numeric-value current-prefix-arg) t))
- (diff--wrap-navigation
- skip-hunk-start
- "next hunk"
- 'diff--internal-hunk-next
- diff-hunk-header-re
- (lambda () (goto-char (car (diff-bounds-of-hunk))))
- count))
-
-(defun diff-file-prev (&optional count skip-hunk-start)
- "Go to the previous COUNT'th file."
- (interactive (list (prefix-numeric-value current-prefix-arg) t))
- (diff--wrap-navigation
- skip-hunk-start
- "prev file"
- 'diff--internal-file-prev
- diff-file-header-re
- (lambda () (goto-char (car (diff-bounds-of-file)))
(diff--internal-hunk-next))
- count))
-
-(defun diff-file-next (&optional count skip-hunk-start)
- "Go to the next COUNT'th file."
- (interactive (list (prefix-numeric-value current-prefix-arg) t))
- (diff--wrap-navigation
- skip-hunk-start
- "next file"
- 'diff--internal-file-next
- diff-file-header-re
- (lambda () (goto-char (car (diff-bounds-of-file)))
(diff--internal-hunk-next))
- count))
-
-
-
+ diff-file diff-file-header-re "file" diff-end-of-file)
(defun diff-bounds-of-hunk ()
"Return the bounds of the diff hunk at point.
@@ -679,13 +616,12 @@ point is in a file header, return the bounds of the next
hunk."
(let ((pos (point))
(beg (diff-beginning-of-hunk t))
(end (diff-end-of-hunk)))
- (cond ((> end pos)
+ (cond ((>= end pos)
(list beg end))
;; If this hunk ends above POS, consider the next hunk.
((re-search-forward diff-hunk-header-re nil t)
(list (match-beginning 0) (diff-end-of-hunk)))
- ;; There's no next hunk, so just take the one we have.
- (t (list beg end))))))
+ (t (error "No hunk found"))))))
(defun diff-bounds-of-file ()
"Return the bounds of the file segment at point.
@@ -731,12 +667,8 @@ If the prefix ARG is given, restrict the view to the
current file instead."
hunk-bounds))
(inhibit-read-only t))
(apply 'kill-region bounds)
- (goto-char (car bounds))))
-
-;; "index ", "old mode", "new mode", "new file mode" and
-;; "deleted file mode" are output by git-diff.
-(defconst diff-file-junk-re
- "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|===
modified file")
+ (goto-char (car bounds))
+ (diff-beginning-of-hunk t)))
(defun diff-beginning-of-file-and-junk ()
"Go to the beginning of file-related diff-info.
@@ -771,7 +703,7 @@ data such as \"Index: ...\" and such."
(setq prevfile nextfile))
(if (and previndex (numberp prevfile) (< previndex prevfile))
(setq prevfile previndex))
- (if (numberp prevfile)
+ (if (and (numberp prevfile) (<= prevfile start))
(progn
(goto-char prevfile)
;; Now skip backward over the leading junk we may have before the
@@ -789,7 +721,8 @@ data such as \"Index: ...\" and such."
"Kill current file's hunks."
(interactive)
(let ((inhibit-read-only t))
- (apply 'kill-region (diff-bounds-of-file))))
+ (apply 'kill-region (diff-bounds-of-file)))
+ (diff-beginning-of-hunk t))
(defun diff-kill-junk ()
"Kill spurious empty diffs."
@@ -1373,7 +1306,7 @@ See `after-change-functions' for the meaning of BEG, END
and LEN."
;; it's safer not to do it on big changes, e.g. when yanking a big
;; diff, or when the user edits the header, since we might then
;; screw up perfectly correct values. --Stef
- (diff-beginning-of-hunk)
+ (diff-beginning-of-hunk t)
(let* ((style (if (looking-at "\\*\\*\\*") 'context))
(start (line-beginning-position (if (eq style 'context) 3 2)))
(mid (if (eq style 'context)
@@ -1764,9 +1697,8 @@ SRC and DST are the two variants of text as returned by
`diff-hunk-text'.
SWITCHED is non-nil if the patch is already applied.
NOPROMPT, if non-nil, means not to prompt the user."
(save-excursion
- (let* ((hunk-bounds (diff-bounds-of-hunk))
- (other (diff-xor other-file diff-jump-to-old-file))
- (char-offset (- (point) (goto-char (car hunk-bounds))))
+ (let* ((other (diff-xor other-file diff-jump-to-old-file))
+ (char-offset (- (point) (diff-beginning-of-hunk t)))
;; Check that the hunk is well-formed. Otherwise diff-mode and
;; the user may disagree on what constitutes the hunk
;; (e.g. because an empty line truncates the hunk mid-course),
@@ -1775,7 +1707,7 @@ NOPROMPT, if non-nil, means not to prompt the user."
;; Suppress check when NOPROMPT is non-nil (Bug#3033).
(_ (unless noprompt (diff-sanity-check-hunk)))
(hunk (buffer-substring
- (point) (cadr hunk-bounds)))
+ (point) (save-excursion (diff-end-of-hunk) (point))))
(old (diff-hunk-text hunk reverse char-offset))
(new (diff-hunk-text hunk (not reverse) char-offset))
;; Find the location specification.
@@ -1838,6 +1770,7 @@ the value of this variable when given an appropriate
prefix argument).
With a prefix argument, REVERSE the hunk."
(interactive "P")
+ (diff-beginning-of-hunk t)
(pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched)
;; Sometimes we'd like to have the following behavior: if
;; REVERSE go to the new file, otherwise go to the old.
@@ -1883,15 +1816,8 @@ With a prefix argument, REVERSE the hunk."
;; Display BUF in a window
(set-window-point (display-buffer buf) (+ (car pos) (cdr new)))
(diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
-
- ;; Advance to the next hunk with skip-hunk-start set to t
- ;; because we want the behavior of moving to the next logical
- ;; hunk, not the original behavior where were would sometimes
- ;; stay on the current hunk. This is the behavior we get when
- ;; navigating through hunks interactively, and we want it when
- ;; applying hunks too (see http://debbugs.gnu.org/17544).
(when diff-advance-after-apply-hunk
- (diff-hunk-next nil t))))))
+ (diff-hunk-next))))))
(defun diff-test-hunk (&optional reverse)
@@ -1972,15 +1898,14 @@ For use in `add-log-current-defun-function'."
(defun diff-ignore-whitespace-hunk ()
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
- (let* ((hunk-bounds (diff-bounds-of-hunk))
- (char-offset (- (point) (goto-char (car hunk-bounds))))
+ (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
(opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
(inhibit-read-only t)
(hunk (delete-and-extract-region
- (point) (cadr hunk-bounds)))
+ (point) (save-excursion (diff-end-of-hunk) (point))))
(lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1.
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2"))
@@ -2062,35 +1987,48 @@ For use in `add-log-current-defun-function'."
(declare-function smerge-refine-subst "smerge-mode"
(beg1 end1 beg2 end2 props-c &optional preproc props-r
props-a))
+(defun diff--forward-while-leading-char (char bound)
+ "Move point until reaching a line not starting with CHAR.
+Return new point, if it was moved."
+ (let ((pt nil))
+ (while (and (< (point) bound) (eql (following-char) char))
+ (forward-line 1)
+ (setq pt (point)))
+ pt))
+
(defun diff-refine-hunk ()
"Highlight changes of hunk at point at a finer granularity."
(interactive)
(require 'smerge-mode)
(save-excursion
- (let* ((hunk-bounds (diff-bounds-of-hunk))
- (style (progn (goto-char (car hunk-bounds))
- (diff-hunk-style))) ;Skips the hunk header as well.
+ (diff-beginning-of-hunk t)
+ (let* ((start (point))
+ (style (diff-hunk-style)) ;Skips the hunk header as well.
(beg (point))
- (end (cadr hunk-bounds))
(props-c '((diff-mode . fine) (face diff-refine-changed)))
(props-r '((diff-mode . fine) (face diff-refine-removed)))
- (props-a '((diff-mode . fine) (face diff-refine-added))))
+ (props-a '((diff-mode . fine) (face diff-refine-added)))
+ ;; Be careful to go back to `start' so diff-end-of-hunk gets
+ ;; to read the hunk header's line info.
+ (end (progn (goto-char start) (diff-end-of-hunk) (point))))
(remove-overlays beg end 'diff-mode 'fine)
(goto-char beg)
(pcase style
(`unified
- (while (re-search-forward
- (eval-when-compile
- (let ((no-LF-at-eol-re "\\(?:\\\\.*\n\\)?"))
- (concat "^\\(?:-.*\n\\)+" no-LF-at-eol-re
- "\\(\\)"
- "\\(?:\\+.*\n\\)+" no-LF-at-eol-re)))
- end t)
- (smerge-refine-subst (match-beginning 0) (match-end 1)
- (match-end 1) (match-end 0)
- nil 'diff-refine-preproc props-r props-a)))
+ (while (re-search-forward "^-" end t)
+ (let ((beg-del (progn (beginning-of-line) (point)))
+ beg-add end-add)
+ (when (and (diff--forward-while-leading-char ?- end)
+ ;; Allow for "\ No newline at end of file".
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq beg-add (point)))
+ (diff--forward-while-leading-char ?+ end)
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq end-add (point))))
+ (smerge-refine-subst beg-del beg-add beg-add end-add
+ nil 'diff-refine-preproc props-r
props-a)))))
(`context
(let* ((middle (save-excursion (re-search-forward "^---")))
(other middle))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 95568b2..0235926 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -150,6 +150,26 @@ It needs to be killed when we quit the session.")
(defsubst ediff-get-symbol-from-alist (buf-type alist)
(cdr (assoc buf-type alist)))
+;; Vector of differences between the variants. Each difference is
+;; represented by a vector of two overlays plus a vector of fine diffs,
+;; plus a no-fine-diffs flag. The first overlay spans the
+;; difference region in the A buffer and the second overlays the diff in
+;; the B buffer. If a difference section is empty, the corresponding
+;; overlay's endpoints coincide.
+;;
+;; The precise form of a Difference Vector for one buffer is:
+;; [diff diff diff ...]
+;; where each diff has the form:
+;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff]
+;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...]
+;; no-fine-diffs-flag says if there are fine differences.
+;; state-of-difference is A, B, C, or nil, indicating which buffer is
+;; different from the other two (used only in 3-way jobs.
+(ediff-defvar-local ediff-difference-vector-A nil "")
+(ediff-defvar-local ediff-difference-vector-B nil "")
+(ediff-defvar-local ediff-difference-vector-C nil "")
+(ediff-defvar-local ediff-difference-vector-Ancestor nil "")
+;; A-list of diff vector types associated with buffer types
(defconst ediff-difference-vector-alist
'((A . ediff-difference-vector-A)
(B . ediff-difference-vector-B)
@@ -642,32 +662,6 @@ shown in brighter colors."
;;buffer-read-only
mode-line-format))
-;; Vector of differences between the variants. Each difference is
-;; represented by a vector of two overlays plus a vector of fine diffs,
-;; plus a no-fine-diffs flag. The first overlay spans the
-;; difference region in the A buffer and the second overlays the diff in
-;; the B buffer. If a difference section is empty, the corresponding
-;; overlay's endpoints coincide.
-;;
-;; The precise form of a Difference Vector for one buffer is:
-;; [diff diff diff ...]
-;; where each diff has the form:
-;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff]
-;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...]
-;; no-fine-diffs-flag says if there are fine differences.
-;; state-of-difference is A, B, C, or nil, indicating which buffer is
-;; different from the other two (used only in 3-way jobs.
-(ediff-defvar-local ediff-difference-vector-A nil "")
-(ediff-defvar-local ediff-difference-vector-B nil "")
-(ediff-defvar-local ediff-difference-vector-C nil "")
-(ediff-defvar-local ediff-difference-vector-Ancestor nil "")
-;; A-list of diff vector types associated with buffer types
-(defconst ediff-difference-vector-alist
- '((A . ediff-difference-vector-A)
- (B . ediff-difference-vector-B)
- (C . ediff-difference-vector-C)
- (Ancestor . ediff-difference-vector-Ancestor)))
-
;; [ status status status ...]
;; Each status: [state-of-merge state-of-ancestor]
;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
diff --git a/lisp/xml.el b/lisp/xml.el
index cd801be..be2ac96 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -646,8 +646,10 @@ surpassed `xml-entity-expansion-limit'"))))
(defun xml-parse-attlist (&optional xml-ns)
"Return the attribute-list after point.
Leave point at the first non-blank character after the tag."
- (let ((attlist ())
- end-pos name)
+ (let* ((attlist ())
+ (symbol-qnames (eq (car-safe xml-ns) 'symbol-qnames))
+ (xml-ns (if symbol-qnames (cdr xml-ns) xml-ns))
+ end-pos name)
(skip-syntax-forward " ")
(while (looking-at (eval-when-compile
(concat "\\(" xml-name-re "\\)\\s-*=\\s-*")))
diff --git a/src/alloc.c b/src/alloc.c
index 1a6d4e2..dd2b688 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2872,45 +2872,15 @@ usage: (list &rest OBJECTS) */)
DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
doc: /* Return a newly created list of length LENGTH, with each element
being INIT. */)
- (register Lisp_Object length, Lisp_Object init)
+ (Lisp_Object length, Lisp_Object init)
{
- register Lisp_Object val;
- register EMACS_INT size;
-
+ Lisp_Object val = Qnil;
CHECK_NATNUM (length);
- size = XFASTINT (length);
- val = Qnil;
- while (size > 0)
+ for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
{
val = Fcons (init, val);
- --size;
-
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
-
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
-
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
-
- if (size > 0)
- {
- val = Fcons (init, val);
- --size;
- }
- }
- }
- }
-
- QUIT;
+ maybe_quit ();
}
return val;
@@ -5464,6 +5434,37 @@ make_pure_vector (ptrdiff_t len)
return new;
}
+/* Copy all contents and parameters of TABLE to a new table allocated
+ from pure space, return the purified table. */
+static struct Lisp_Hash_Table *
+purecopy_hash_table (struct Lisp_Hash_Table *table) {
+ eassert (NILP (table->weak));
+ eassert (!NILP (table->pure));
+
+ struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
+ struct hash_table_test pure_test = table->test;
+
+ /* Purecopy the hash table test. */
+ pure_test.name = purecopy (table->test.name);
+ pure_test.user_hash_function = purecopy (table->test.user_hash_function);
+ pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
+
+ pure->test = pure_test;
+ pure->header = table->header;
+ pure->weak = purecopy (Qnil);
+ pure->rehash_size = purecopy (table->rehash_size);
+ pure->rehash_threshold = purecopy (table->rehash_threshold);
+ pure->hash = purecopy (table->hash);
+ pure->next = purecopy (table->next);
+ pure->next_free = purecopy (table->next_free);
+ pure->index = purecopy (table->index);
+ pure->count = table->count;
+ pure->key_and_value = purecopy (table->key_and_value);
+ pure->pure = purecopy (table->pure);
+
+ return pure;
+}
+
DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
doc: /* Make a copy of object OBJ in pure storage.
Recursively copies contents of vectors and cons cells.
@@ -5472,14 +5473,22 @@ Does not copy symbols. Copies strings without text
properties. */)
{
if (NILP (Vpurify_flag))
return obj;
- else if (MARKERP (obj) || OVERLAYP (obj)
- || HASH_TABLE_P (obj) || SYMBOLP (obj))
+ else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
/* Can't purify those. */
return obj;
else
return purecopy (obj);
}
+struct pinned_object
+{
+ Lisp_Object object;
+ struct pinned_object *next;
+};
+
+/* Pinned objects are marked before every GC cycle. */
+static struct pinned_object *pinned_objects;
+
static Lisp_Object
purecopy (Lisp_Object obj)
{
@@ -5507,7 +5516,27 @@ purecopy (Lisp_Object obj)
obj = make_pure_string (SSDATA (obj), SCHARS (obj),
SBYTES (obj),
STRING_MULTIBYTE (obj));
- else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+ else if (HASH_TABLE_P (obj))
+ {
+ struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
+ /* We cannot purify hash tables which haven't been defined with
+ :purecopy as non-nil or are weak - they aren't guaranteed to
+ not change. */
+ if (!NILP (table->weak) || NILP (table->pure))
+ {
+ /* Instead, the hash table is added to the list of pinned objects,
+ and is marked before GC. */
+ struct pinned_object *o = xmalloc (sizeof *o);
+ o->object = obj;
+ o->next = pinned_objects;
+ pinned_objects = o;
+ return obj; /* Don't hash cons it. */
+ }
+
+ struct Lisp_Hash_Table *h = purecopy_hash_table (table);
+ XSET_HASH_TABLE (obj, h);
+ }
+ else if (COMPILEDP (obj) || VECTORP (obj))
{
struct Lisp_Vector *objp = XVECTOR (obj);
ptrdiff_t nbytes = vector_nbytes (objp);
@@ -5724,6 +5753,16 @@ compact_undo_list (Lisp_Object list)
}
static void
+mark_pinned_objects (void)
+{
+ struct pinned_object *pobj;
+ for (pobj = pinned_objects; pobj; pobj = pobj->next)
+ {
+ mark_object (pobj->object);
+ }
+}
+
+static void
mark_pinned_symbols (void)
{
struct symbol_block *sblk;
@@ -5843,6 +5882,7 @@ garbage_collect_1 (void *end)
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
+ mark_pinned_objects ();
mark_pinned_symbols ();
mark_terminals ();
mark_kboards ();
diff --git a/src/atimer.c b/src/atimer.c
index 7f09980..5feb1f6 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -20,6 +20,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include "lisp.h"
+#include "keyboard.h"
#include "syssignal.h"
#include "systime.h"
#include "atimer.h"
diff --git a/src/buffer.c b/src/buffer.c
index fde23ca..c00cc40 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -415,19 +415,16 @@ followed by the rest of the buffers. */)
}
/* Like Fassoc, but use Fstring_equal to compare
- (which ignores text properties),
- and don't ever QUIT. */
+ (which ignores text properties), and don't ever quit. */
static Lisp_Object
-assoc_ignore_text_properties (register Lisp_Object key, Lisp_Object list)
+assoc_ignore_text_properties (Lisp_Object key, Lisp_Object list)
{
- register Lisp_Object tail;
+ Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- register Lisp_Object elt, tem;
- elt = XCAR (tail);
- tem = Fstring_equal (Fcar (elt), key);
- if (!NILP (tem))
+ Lisp_Object elt = XCAR (tail);
+ if (!NILP (Fstring_equal (Fcar (elt), key)))
return elt;
}
return Qnil;
diff --git a/src/bytecode.c b/src/bytecode.c
index f4540e9..288d78e 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -681,7 +681,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
{
quitcounter = 1;
maybe_gc ();
- QUIT;
+ maybe_quit ();
}
pc += op;
NEXT;
diff --git a/src/callint.c b/src/callint.c
index 565fac8..d964548 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -794,7 +794,7 @@ invoke it. If KEYS is omitted or nil, the return value of
}
unbind_to (speccount, Qnil);
- QUIT;
+ maybe_quit ();
args[0] = Qfuncall_interactively;
args[1] = function;
diff --git a/src/callproc.c b/src/callproc.c
index 90c15de..301ccf3 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,11 @@ call_process_cleanup (Lisp_Object buffer)
{
kill (-synch_process_pid, SIGINT);
message1 ("Waiting for process to die...(type C-g again to kill it
instantly)");
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
wait_for_termination (synch_process_pid, 0, 1);
synch_process_pid = 0;
- immediate_quit = 0;
+ immediate_quit = false;
message1 ("Waiting for process to die...done");
}
#endif /* !MSDOS */
@@ -726,8 +726,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
process_coding.src_multibyte = 0;
}
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
if (0 <= fd0)
{
@@ -769,7 +769,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
}
/* Now NREAD is the total amount of data in the buffer. */
- immediate_quit = 0;
+ immediate_quit = false;
if (!nread)
;
@@ -843,7 +843,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
display_on_the_fly = true;
}
immediate_quit = true;
- QUIT;
+ maybe_quit ();
}
give_up: ;
@@ -860,7 +860,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
wait_for_termination (pid, &status, fd0 < 0);
#endif
- immediate_quit = 0;
+ immediate_quit = false;
/* Don't kill any children that the subprocess may have left behind
when exiting. */
diff --git a/src/category.c b/src/category.c
index e5d261c..ff287a4 100644
--- a/src/category.c
+++ b/src/category.c
@@ -67,7 +67,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object
category_set)
make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil));
+ Qnil, Qnil));
h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
i = hash_lookup (h, category_set, &hash);
if (i >= 0)
diff --git a/src/ccl.c b/src/ccl.c
index c172fc6..90bd2f4 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1993,7 +1993,7 @@ programs. */)
: 0);
ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
- QUIT;
+ maybe_quit ();
if (ccl.status != CCL_STAT_SUCCESS)
error ("Error in CCL program at %dth code", ccl.ic);
diff --git a/src/decompress.c b/src/decompress.c
index f6628d5..a53a66d 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -186,7 +186,7 @@ This function can be called only in unibyte buffers. */)
decompressed = avail_out - stream.avail_out;
insert_from_gap (decompressed, decompressed, 0);
unwind_data.nbytes += decompressed;
- QUIT;
+ maybe_quit ();
}
while (inflate_status == Z_OK);
diff --git a/src/dired.c b/src/dired.c
index bf10f17..52e81fb 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -139,7 +139,7 @@ read_dirent (DIR *dir, Lisp_Object dirname)
#endif
report_file_error ("Reading directory", dirname);
}
- QUIT;
+ maybe_quit ();
}
}
@@ -248,13 +248,13 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
bool wanted = (NILP (match)
|| re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
- immediate_quit = 0;
+ immediate_quit = false;
if (wanted)
{
@@ -508,7 +508,7 @@ file_name_completion (Lisp_Object file, Lisp_Object
dirname, bool all_flag,
ptrdiff_t len = dirent_namelen (dp);
bool canexclude = 0;
- QUIT;
+ maybe_quit ();
if (len < SCHARS (encoded_file)
|| (scmp (dp->d_name, SSDATA (encoded_file),
SCHARS (encoded_file))
diff --git a/src/editfns.c b/src/editfns.c
index bee3bbc..82c6abb 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2695,7 +2695,7 @@ called interactively, INHERIT is t. */)
string[i] = str[i % len];
while (n > stringlen)
{
- QUIT;
+ maybe_quit ();
if (!NILP (inherit))
insert_and_inherit (string, stringlen);
else
@@ -3053,6 +3053,7 @@ determines whether case is significant or ignored. */)
i2 = begp2;
i1_byte = buf_charpos_to_bytepos (bp1, i1);
i2_byte = buf_charpos_to_bytepos (bp2, i2);
+ immediate_quit = true;
while (i1 < endp1 && i2 < endp2)
{
@@ -3060,8 +3061,6 @@ determines whether case is significant or ignored. */)
characters, not just the bytes. */
int c1, c2;
- QUIT;
-
if (! NILP (BVAR (bp1, enable_multibyte_characters)))
{
c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
@@ -3093,14 +3092,17 @@ determines whether case is significant or ignored. */)
c1 = char_table_translate (trt, c1);
c2 = char_table_translate (trt, c2);
}
- if (c1 < c2)
- return make_number (- 1 - chars);
- if (c1 > c2)
- return make_number (chars + 1);
+ if (c1 != c2)
+ {
+ immediate_quit = false;
+ return make_number (c1 < c2 ? -1 - chars : chars + 1);
+ }
chars++;
}
+ immediate_quit = false;
+
/* The strings match as far as they go.
If one is shorter, that one is less. */
if (chars < endp1 - begp1)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e22c7dc..69fa5c8 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1016,7 +1016,7 @@ syms_of_module (void)
= make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil);
+ Qnil, Qnil);
Funintern (Qmodule_refs_hash, Qnil);
DEFSYM (Qmodule_environments, "module-environments");
diff --git a/src/eval.c b/src/eval.c
index 1f8d409..62d4af1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -856,10 +856,9 @@ usage: (let* VARLIST BODY...) */)
lexenv = Vinternal_interpreter_environment;
- varlist = XCAR (args);
- while (CONSP (varlist))
+ for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
{
- QUIT;
+ maybe_quit ();
elt = XCAR (varlist);
if (SYMBOLP (elt))
@@ -893,9 +892,8 @@ usage: (let* VARLIST BODY...) */)
}
else
specbind (var, val);
-
- varlist = XCDR (varlist);
}
+ CHECK_LIST_END (varlist, XCAR (args));
val = Fprogn (XCDR (args));
return unbind_to (count, val);
@@ -917,6 +915,7 @@ usage: (let VARLIST BODY...) */)
USE_SAFE_ALLOCA;
varlist = XCAR (args);
+ CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
elt = Flength (varlist);
@@ -926,7 +925,7 @@ usage: (let VARLIST BODY...) */)
for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
{
- QUIT;
+ maybe_quit ();
elt = XCAR (varlist);
if (SYMBOLP (elt))
temps [argnum++] = Qnil;
@@ -979,7 +978,7 @@ usage: (while TEST BODY...) */)
body = XCDR (args);
while (!NILP (eval_sub (test)))
{
- QUIT;
+ maybe_quit ();
prog_ignore (body);
}
@@ -1012,7 +1011,7 @@ definitions to shadow the loaded ones for use in file
byte-compilation. */)
until we get a symbol that is not an alias. */
while (SYMBOLP (def))
{
- QUIT;
+ maybe_quit ();
sym = def;
tem = Fassq (sym, environment);
if (NILP (tem))
@@ -1132,7 +1131,7 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
unblock_input_to (catch->interrupt_input_blocked);
- immediate_quit = 0;
+ immediate_quit = false;
do
{
@@ -1451,7 +1450,7 @@ static Lisp_Object find_handler_clause (Lisp_Object,
Lisp_Object);
static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
Lisp_Object data);
-void
+static void
process_quit_flag (void)
{
Lisp_Object flag = Vquit_flag;
@@ -1463,6 +1462,15 @@ process_quit_flag (void)
quit ();
}
+void
+maybe_quit (void)
+{
+ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+ process_quit_flag ();
+ else if (pending_signals)
+ process_pending_signals ();
+}
+
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
This function does not return.
@@ -1506,10 +1514,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
Lisp_Object string;
Lisp_Object real_error_symbol
= (NILP (error_symbol) ? Fcar (data) : error_symbol);
- register Lisp_Object clause = Qnil;
+ Lisp_Object clause = Qnil;
struct handler *h;
- immediate_quit = 0;
+ immediate_quit = false;
if (gc_in_progress || waiting_for_input)
emacs_abort ();
@@ -2127,7 +2135,7 @@ eval_sub (Lisp_Object form)
if (!CONSP (form))
return form;
- QUIT;
+ maybe_quit ();
maybe_gc ();
@@ -2713,7 +2721,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
Lisp_Object val;
ptrdiff_t count;
- QUIT;
+ maybe_quit ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
@@ -2958,7 +2966,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
bool previous_optional_or_rest = false;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
- QUIT;
+ maybe_quit ();
next = XCAR (syms_left);
if (!SYMBOLP (next))
@@ -3096,7 +3104,7 @@ lambda_arity (Lisp_Object fun)
if (EQ (XCAR (fun), Qclosure))
{
fun = XCDR (fun); /* Drop `closure'. */
- CHECK_LIST_CONS (fun, fun);
+ CHECK_CONS (fun);
}
syms_left = XCDR (fun);
if (CONSP (syms_left))
diff --git a/src/fileio.c b/src/fileio.c
index be52d0f..a46cfc7 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -316,7 +316,7 @@ use the standard functions without calling themselves
recursively. */)
}
}
- QUIT;
+ maybe_quit ();
}
return result;
}
@@ -1960,9 +1960,9 @@ permissions. */)
report_file_error ("Copying permissions to", newname);
}
#else /* not WINDOWSNT */
- immediate_quit = 1;
+ immediate_quit = true;
ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
- immediate_quit = 0;
+ immediate_quit = false;
if (ifd < 0)
report_file_error ("Opening input file", file);
@@ -2024,8 +2024,8 @@ permissions. */)
oldsize = out_st.st_size;
}
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
if (clone_file (ofd, ifd))
newsize = st.st_size;
@@ -2047,7 +2047,7 @@ permissions. */)
if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
report_file_error ("Truncating output file", newname);
- immediate_quit = 0;
+ immediate_quit = false;
#ifndef MSDOS
/* Preserve the original file permissions, and if requested, also its
@@ -2682,7 +2682,7 @@ DEFUN ("file-writable-p", Ffile_writable_p,
Sfile_writable_p, 1, 1, 0,
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
doc: /* Access file FILENAME, and get an error if that does not work.
-The second argument STRING is used in the error message.
+The second argument STRING is prepended to the error message.
If there is no error, returns nil. */)
(Lisp_Object filename, Lisp_Object string)
{
@@ -2815,7 +2815,17 @@ really is a readable and searchable directory. */)
if (!NILP (handler))
{
Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
- errno = 0;
+
+ /* Set errno in case the handler failed. EACCES might be a lie
+ (e.g., the directory might not exist, or be a regular file),
+ but at least it does TRT in the "usual" case of an existing
+ directory that is not accessible by the current user, and
+ avoids reporting "Success" for a failed operation. Perhaps
+ someday we can fix this in a better way, by improving
+ file-accessible-directory-p's API; see Bug#25419. */
+ if (!EQ (r, Qt))
+ errno = EACCES;
+
return r;
}
@@ -3393,13 +3403,13 @@ read_non_regular (Lisp_Object state)
{
int nbytes;
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
nbytes = emacs_read (XSAVE_INTEGER (state, 0),
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ XSAVE_INTEGER (state, 1)),
XSAVE_INTEGER (state, 2));
- immediate_quit = 0;
+ immediate_quit = false;
/* Fast recycle this object for the likely next call. */
free_misc (state);
return make_number (nbytes);
@@ -3858,8 +3868,8 @@ by calling `format-decode', which see. */)
report_file_error ("Setting file position", orig_filename);
}
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
/* Count how many chars at the start of the file
match the text at the beginning of the buffer. */
while (1)
@@ -3910,7 +3920,7 @@ by calling `format-decode', which see. */)
goto handled;
}
immediate_quit = true;
- QUIT;
+ maybe_quit ();
/* Count how many chars at the end of the file
match the text at the end of the buffer. But, if we have
already found that decoding is necessary, don't waste time. */
@@ -3967,7 +3977,7 @@ by calling `format-decode', which see. */)
if (nread == 0)
break;
}
- immediate_quit = 0;
+ immediate_quit = false;
if (! giveup_match_end)
{
@@ -4065,11 +4075,11 @@ by calling `format-decode', which see. */)
quitting while reading a huge file. */
/* Allow quitting out of the actual I/O. */
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
this = emacs_read (fd, read_buf + unprocessed,
READ_BUF_SIZE - unprocessed);
- immediate_quit = 0;
+ immediate_quit = false;
if (this <= 0)
break;
@@ -4284,13 +4294,13 @@ by calling `format-decode', which see. */)
/* Allow quitting out of the actual I/O. We don't make text
part of the buffer until all the reading is done, so a C-g
here doesn't do any harm. */
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
this = emacs_read (fd,
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ inserted),
trytry);
- immediate_quit = 0;
+ immediate_quit = false;
}
if (this <= 0)
@@ -4602,7 +4612,7 @@ by calling `format-decode', which see. */)
}
}
- QUIT;
+ maybe_quit ();
p = XCDR (p);
}
@@ -4992,7 +5002,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
}
}
- immediate_quit = 1;
+ immediate_quit = true;
if (STRINGP (start))
ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
@@ -5016,7 +5026,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
save_errno = errno;
}
- immediate_quit = 0;
+ immediate_quit = false;
/* fsync is not crucial for temporary files. Nor for auto-save
files, since they might lose some work anyway. */
@@ -5142,19 +5152,26 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
if (! ok)
report_file_errno ("Write error", filename, save_errno);
+ bool auto_saving_into_visited_file =
+ auto_saving
+ && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
+ BVAR (current_buffer, auto_save_file_name)));
if (visiting)
{
SAVE_MODIFF = MODIFF;
XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
bset_filename (current_buffer, visit_file);
update_mode_lines = 14;
+ if (auto_saving_into_visited_file)
+ unlock_file (lockname);
}
else if (quietly)
{
- if (auto_saving
- && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
- BVAR (current_buffer,
auto_save_file_name))))
- SAVE_MODIFF = MODIFF;
+ if (auto_saving_into_visited_file)
+ {
+ SAVE_MODIFF = MODIFF;
+ unlock_file (lockname);
+ }
return Qnil;
}
diff --git a/src/filelock.c b/src/filelock.c
index 886ab61..de65c52 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -505,7 +505,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
/* readlinkat saw a non-symlink, but emacs_open saw a symlink.
The former must have been removed and replaced by the latter.
Try again. */
- QUIT;
+ maybe_quit ();
}
return nbytes;
diff --git a/src/fns.c b/src/fns.c
index 00fa658..5769eac 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "intervals.h"
#include "window.h"
+#include "puresize.h"
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
Lisp_Object *restrict, Lisp_Object *restrict);
@@ -84,17 +85,23 @@ See Info node `(elisp)Random Numbers' for more details. */)
}
/* Heuristic on how many iterations of a tight loop can be safely done
- before it's time to do a QUIT. This must be a power of 2. */
+ before it's time to do a quit. This must be a power of 2. It
+ is nice but not necessary for it to equal USHRT_MAX + 1. */
enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-/* Random data-structure functions. */
+/* Process a quit, but do it only rarely, for efficiency. "Rarely"
+ means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
+ whichever is smaller. Use *QUIT_COUNT to count this. */
static void
-CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
+rarely_quit (unsigned short int *quit_count)
{
- CHECK_TYPE (NILP (x), Qlistp, y);
+ if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
+ maybe_quit ();
}
+/* Random data-structure functions. */
+
DEFUN ("length", Flength, Slength, 1, 1, 0,
doc: /* Return the length of vector, list or string SEQUENCE.
A byte-code function object is also allowed.
@@ -126,7 +133,7 @@ To get the number of bytes, use `string-bytes'. */)
{
if (MOST_POSITIVE_FIXNUM < i)
error ("List too long");
- QUIT;
+ maybe_quit ();
}
sequence = XCDR (sequence);
}
@@ -172,7 +179,7 @@ which is at least the number of distinct elements. */)
halftail = XCDR (halftail);
if ((lolen & (QUIT_COUNT_HEURISTIC - 1)) == 0)
{
- QUIT;
+ maybe_quit ();
if (lolen == 0)
hilen += UINTMAX_MAX + 1.0;
}
@@ -1202,17 +1209,12 @@ are shared, however.
Elements of ALIST that are not conses are also shared. */)
(Lisp_Object alist)
{
- register Lisp_Object tem;
-
- CHECK_LIST (alist);
if (NILP (alist))
return alist;
- alist = concat (1, &alist, Lisp_Cons, 0);
- for (tem = alist; CONSP (tem); tem = XCDR (tem))
+ alist = concat (1, &alist, Lisp_Cons, false);
+ for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem))
{
- register Lisp_Object car;
- car = XCAR (tem);
-
+ Lisp_Object car = XCAR (tem);
if (CONSP (car))
XSETCAR (tem, Fcons (XCAR (car), XCDR (car)));
}
@@ -1356,16 +1358,22 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
doc: /* Take cdr N times on LIST, return the result. */)
(Lisp_Object n, Lisp_Object list)
{
- EMACS_INT i, num;
CHECK_NUMBER (n);
- num = XINT (n);
- for (i = 0; i < num && !NILP (list); i++)
+ EMACS_INT num = XINT (n);
+ Lisp_Object tail = list;
+ immediate_quit = true;
+ for (EMACS_INT i = 0; i < num; i++)
{
- QUIT;
- CHECK_LIST_CONS (list, list);
- list = XCDR (list);
+ if (! CONSP (tail))
+ {
+ immediate_quit = false;
+ CHECK_LIST_END (tail, list);
+ return Qnil;
+ }
+ tail = XCDR (tail);
}
- return list;
+ immediate_quit = false;
+ return tail;
}
DEFUN ("nth", Fnth, Snth, 2, 2, 0,
@@ -1392,66 +1400,61 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
DEFUN ("member", Fmember, Smember, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done
with `equal'.
The value is actually the tail of LIST whose car is ELT. */)
- (register Lisp_Object elt, Lisp_Object list)
+ (Lisp_Object elt, Lisp_Object list)
{
- register Lisp_Object tail;
- for (tail = list; !NILP (tail); tail = XCDR (tail))
+ unsigned short int quit_count = 0;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- register Lisp_Object tem;
- CHECK_LIST_CONS (tail, list);
- tem = XCAR (tail);
- if (! NILP (Fequal (elt, tem)))
+ if (! NILP (Fequal (elt, XCAR (tail))))
return tail;
- QUIT;
+ rarely_quit (&quit_count);
}
+ CHECK_LIST_END (tail, list);
return Qnil;
}
DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done
with `eq'.
The value is actually the tail of LIST whose car is ELT. */)
- (register Lisp_Object elt, Lisp_Object list)
+ (Lisp_Object elt, Lisp_Object list)
{
- while (1)
+ immediate_quit = true;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- if (!CONSP (list) || EQ (XCAR (list), elt))
- break;
-
- list = XCDR (list);
- if (!CONSP (list) || EQ (XCAR (list), elt))
- break;
-
- list = XCDR (list);
- if (!CONSP (list) || EQ (XCAR (list), elt))
- break;
-
- list = XCDR (list);
- QUIT;
+ if (EQ (XCAR (tail), elt))
+ {
+ immediate_quit = false;
+ return tail;
+ }
}
-
- CHECK_LIST (list);
- return list;
+ immediate_quit = false;
+ CHECK_LIST_END (tail, list);
+ return Qnil;
}
DEFUN ("memql", Fmemql, Smemql, 2, 2, 0,
doc: /* Return non-nil if ELT is an element of LIST. Comparison done
with `eql'.
The value is actually the tail of LIST whose car is ELT. */)
- (register Lisp_Object elt, Lisp_Object list)
+ (Lisp_Object elt, Lisp_Object list)
{
- register Lisp_Object tail;
-
if (!FLOATP (elt))
return Fmemq (elt, list);
- for (tail = list; !NILP (tail); tail = XCDR (tail))
+ immediate_quit = true;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- register Lisp_Object tem;
- CHECK_LIST_CONS (tail, list);
- tem = XCAR (tail);
+ Lisp_Object tem = XCAR (tail);
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
- return tail;
- QUIT;
+ {
+ immediate_quit = false;
+ return tail;
+ }
}
+ immediate_quit = false;
+ CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1461,44 +1464,29 @@ The value is actually the first element of LIST whose
car is KEY.
Elements of LIST that are not conses are ignored. */)
(Lisp_Object key, Lisp_Object list)
{
- while (1)
- {
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && EQ (XCAR (XCAR (list)), key)))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && EQ (XCAR (XCAR (list)), key)))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && EQ (XCAR (XCAR (list)), key)))
- break;
-
- list = XCDR (list);
- QUIT;
- }
-
- return CAR (list);
+ immediate_quit = true;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
+ {
+ immediate_quit = false;
+ return XCAR (tail);
+ }
+ immediate_quit = true;
+ CHECK_LIST_END (tail, list);
+ return Qnil;
}
/* Like Fassq but never report an error and do not allow quits.
- Use only on lists known never to be circular. */
+ Use only on objects known to be non-circular lists. */
Lisp_Object
assq_no_quit (Lisp_Object key, Lisp_Object list)
{
- while (CONSP (list)
- && (!CONSP (XCAR (list))
- || !EQ (XCAR (XCAR (list)), key)))
- list = XCDR (list);
-
- return CAR_SAFE (list);
+ for (; ! NILP (list); list = XCDR (list))
+ if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key))
+ return XCAR (list);
+ return Qnil;
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
@@ -1506,81 +1494,52 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
The value is actually the first element of LIST whose car equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
- Lisp_Object car;
-
- while (1)
+ unsigned short int quit_count = 0;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && (car = XCAR (XCAR (list)),
- EQ (car, key) || !NILP (Fequal (car, key)))))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && (car = XCAR (XCAR (list)),
- EQ (car, key) || !NILP (Fequal (car, key)))))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && (car = XCAR (XCAR (list)),
- EQ (car, key) || !NILP (Fequal (car, key)))))
- break;
-
- list = XCDR (list);
- QUIT;
+ Lisp_Object car = XCAR (tail);
+ if (CONSP (car)
+ && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
+ return car;
+ rarely_quit (&quit_count);
}
-
- return CAR (list);
+ CHECK_LIST_END (tail, list);
+ return Qnil;
}
/* Like Fassoc but never report an error and do not allow quits.
- Use only on lists known never to be circular. */
+ Use only on objects known to be non-circular lists. */
Lisp_Object
assoc_no_quit (Lisp_Object key, Lisp_Object list)
{
- while (CONSP (list)
- && (!CONSP (XCAR (list))
- || (!EQ (XCAR (XCAR (list)), key)
- && NILP (Fequal (XCAR (XCAR (list)), key)))))
- list = XCDR (list);
-
- return CONSP (list) ? XCAR (list) : Qnil;
+ for (; ! NILP (list); list = XCDR (list))
+ {
+ Lisp_Object car = XCAR (list);
+ if (CONSP (car)
+ && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
+ return car;
+ }
+ return Qnil;
}
DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
The value is actually the first element of LIST whose cdr is KEY. */)
- (register Lisp_Object key, Lisp_Object list)
+ (Lisp_Object key, Lisp_Object list)
{
- while (1)
- {
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && EQ (XCDR (XCAR (list)), key)))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && EQ (XCDR (XCAR (list)), key)))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && EQ (XCDR (XCAR (list)), key)))
- break;
-
- list = XCDR (list);
- QUIT;
- }
-
- return CAR (list);
+ immediate_quit = true;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
+ {
+ immediate_quit = false;
+ return XCAR (tail);
+ }
+ immediate_quit = true;
+ CHECK_LIST_END (tail, list);
+ return Qnil;
}
DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
@@ -1588,35 +1547,18 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
The value is actually the first element of LIST whose cdr equals KEY. */)
(Lisp_Object key, Lisp_Object list)
{
- Lisp_Object cdr;
-
- while (1)
+ unsigned short int quit_count = 0;
+ Lisp_Object tail;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
{
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && (cdr = XCDR (XCAR (list)),
- EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && (cdr = XCDR (XCAR (list)),
- EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
- break;
-
- list = XCDR (list);
- if (!CONSP (list)
- || (CONSP (XCAR (list))
- && (cdr = XCDR (XCAR (list)),
- EQ (cdr, key) || !NILP (Fequal (cdr, key)))))
- break;
-
- list = XCDR (list);
- QUIT;
+ Lisp_Object car = XCAR (tail);
+ if (CONSP (car)
+ && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
+ return car;
+ rarely_quit (&quit_count);
}
-
- return CAR (list);
+ CHECK_LIST_END (tail, list);
+ return Qnil;
}
DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
@@ -1754,12 +1696,11 @@ changing the value of a sequence `foo'. */)
}
else
{
+ unsigned short int quit_count = 0;
Lisp_Object tail, prev;
- for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
+ for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
{
- CHECK_LIST_CONS (tail, seq);
-
if (!NILP (Fequal (elt, XCAR (tail))))
{
if (NILP (prev))
@@ -1769,8 +1710,9 @@ changing the value of a sequence `foo'. */)
}
else
prev = tail;
- QUIT;
+ rarely_quit (&quit_count);
}
+ CHECK_LIST_END (tail, seq);
}
return seq;
@@ -1788,16 +1730,17 @@ This function may destructively modify SEQ to produce
the value. */)
return Freverse (seq);
else if (CONSP (seq))
{
+ unsigned short int quit_count = 0;
Lisp_Object prev, tail, next;
- for (prev = Qnil, tail = seq; !NILP (tail); tail = next)
+ for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
{
- QUIT;
- CHECK_LIST_CONS (tail, tail);
+ rarely_quit (&quit_count);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
}
+ CHECK_LIST_END (tail, seq);
seq = prev;
}
else if (VECTORP (seq))
@@ -1838,9 +1781,10 @@ See also the function `nreverse', which is used more
often. */)
return Qnil;
else if (CONSP (seq))
{
+ unsigned short int quit_count = 0;
for (new = Qnil; CONSP (seq); seq = XCDR (seq))
{
- QUIT;
+ rarely_quit (&quit_count);
new = Fcons (XCAR (seq), new);
}
CHECK_LIST_END (seq, seq);
@@ -2130,28 +2074,28 @@ If PROP is already a property on the list, its value is
set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
- (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val)
+ (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- register Lisp_Object tail, prev;
- Lisp_Object newcell;
- prev = Qnil;
- for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
+ immediate_quit = true;
+ Lisp_Object prev = Qnil;
+ for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (EQ (prop, XCAR (tail)))
{
+ immediate_quit = false;
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
- QUIT;
}
- newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR
(prev))));
+ immediate_quit = true;
+ Lisp_Object newcell
+ = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
return newcell;
- else
- Fsetcdr (XCDR (prev), newcell);
+ Fsetcdr (XCDR (prev), newcell);
return plist;
}
@@ -2174,6 +2118,7 @@ corresponding to the given PROP, or nil if PROP is not
one of the properties on the list. */)
(Lisp_Object plist, Lisp_Object prop)
{
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = plist;
@@ -2182,8 +2127,7 @@ one of the properties on the list. */)
{
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
-
- QUIT;
+ rarely_quit (&quit_count);
}
CHECK_LIST_END (tail, prop);
@@ -2199,12 +2143,11 @@ If PROP is already a property on the list, its value is
set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
- (Lisp_Object plist, register Lisp_Object prop, Lisp_Object val)
+ (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- register Lisp_Object tail, prev;
- Lisp_Object newcell;
- prev = Qnil;
- for (tail = plist; CONSP (tail) && CONSP (XCDR (tail));
+ unsigned short int quit_count = 0;
+ Lisp_Object prev = Qnil;
+ for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (! NILP (Fequal (prop, XCAR (tail))))
@@ -2214,13 +2157,12 @@ The PLIST is modified by side effects. */)
}
prev = tail;
- QUIT;
+ rarely_quit (&quit_count);
}
- newcell = list2 (prop, val);
+ Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
- else
- Fsetcdr (XCDR (prev), newcell);
+ Fsetcdr (XCDR (prev), newcell);
return plist;
}
@@ -2293,8 +2235,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int
depth, bool props,
}
}
+ unsigned short int quit_count = 0;
tail_recurse:
- QUIT;
+ rarely_quit (&quit_count);
if (EQ (o1, o2))
return 1;
if (XTYPE (o1) != XTYPE (o2))
@@ -2483,14 +2426,12 @@ Only the last argument is not altered, and need not be
a list.
usage: (nconc &rest LISTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t argnum;
- register Lisp_Object tail, tem, val;
+ unsigned short int quit_count = 0;
+ Lisp_Object val = Qnil;
- val = tail = Qnil;
-
- for (argnum = 0; argnum < nargs; argnum++)
+ for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
{
- tem = args[argnum];
+ Lisp_Object tem = args[argnum];
if (NILP (tem)) continue;
if (NILP (val))
@@ -2498,14 +2439,19 @@ usage: (nconc &rest LISTS) */)
if (argnum + 1 == nargs) break;
- CHECK_LIST_CONS (tem, tem);
+ CHECK_CONS (tem);
- while (CONSP (tem))
+ immediate_quit = true;
+ Lisp_Object tail;
+ do
{
tail = tem;
tem = XCDR (tail);
- QUIT;
}
+ while (CONSP (tem));
+
+ immediate_quit = false;
+ rarely_quit (&quit_count);
tem = args[argnum + 1];
Fsetcdr (tail, tem);
@@ -2927,12 +2873,13 @@ property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
(Lisp_Object plist, Lisp_Object prop)
{
+ immediate_quit = true;
while (CONSP (plist) && !EQ (XCAR (plist), prop))
{
plist = XCDR (plist);
plist = CDR (plist);
- QUIT;
}
+ immediate_quit = false;
return plist;
}
@@ -3804,12 +3751,17 @@ allocate_hash_table (void)
(table size) is >= REHASH_THRESHOLD.
WEAK specifies the weakness of the table. If non-nil, it must be
- one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
+ one of the symbols `key', `value', `key-or-value', or `key-and-value'.
+
+ If PURECOPY is non-nil, the table can be copied to pure storage via
+ `purecopy' when Emacs is being dumped. Such tables can no longer be
+ changed after purecopy. */
Lisp_Object
make_hash_table (struct hash_table_test test,
Lisp_Object size, Lisp_Object rehash_size,
- Lisp_Object rehash_threshold, Lisp_Object weak)
+ Lisp_Object rehash_threshold, Lisp_Object weak,
+ Lisp_Object pure)
{
struct Lisp_Hash_Table *h;
Lisp_Object table;
@@ -3850,6 +3802,7 @@ make_hash_table (struct hash_table_test test,
h->hash = Fmake_vector (size, Qnil);
h->next = Fmake_vector (size, Qnil);
h->index = Fmake_vector (make_number (index_size), Qnil);
+ h->pure = pure;
/* Set up the free list. */
for (i = 0; i < sz - 1; ++i)
@@ -4514,10 +4467,15 @@ key, value, one of key or value, or both key and value,
depending on
WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
is nil.
+:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
+to pure storage when Emacs is being dumped, making the contents of the
+table read only. Any further changes to purified tables will result
+in an error.
+
usage: (make-hash-table &rest KEYWORD-ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object test, size, rehash_size, rehash_threshold, weak;
+ Lisp_Object test, size, rehash_size, rehash_threshold, weak, pure;
struct hash_table_test testdesc;
ptrdiff_t i;
USE_SAFE_ALLOCA;
@@ -4551,6 +4509,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
testdesc.cmpfn = cmpfn_user_defined;
}
+ /* See if there's a `:purecopy PURECOPY' argument. */
+ i = get_key_arg (QCpurecopy, nargs, args, used);
+ pure = i ? args[i] : Qnil;
/* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used);
size = i ? args[i] : Qnil;
@@ -4592,7 +4553,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
signal_error ("Invalid argument list", args[i]);
SAFE_FREE ();
- return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
+ return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
+ pure);
}
@@ -4671,7 +4633,9 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0,
doc: /* Clear hash table TABLE and return it. */)
(Lisp_Object table)
{
- hash_clear (check_hash_table (table));
+ struct Lisp_Hash_Table *h = check_hash_table (table);
+ CHECK_IMPURE (table, h);
+ hash_clear (h);
/* Be compatible with XEmacs. */
return table;
}
@@ -4695,9 +4659,10 @@ VALUE. In any case, return VALUE. */)
(Lisp_Object key, Lisp_Object value, Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
+ CHECK_IMPURE (table, h);
+
ptrdiff_t i;
EMACS_UINT hash;
-
i = hash_lookup (h, key, &hash);
if (i >= 0)
set_hash_value_slot (h, i, value);
@@ -4713,6 +4678,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0,
(Lisp_Object key, Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
+ CHECK_IMPURE (table, h);
hash_remove_from_table (h, key);
return Qnil;
}
@@ -5083,6 +5049,7 @@ syms_of_fns (void)
DEFSYM (Qequal, "equal");
DEFSYM (QCtest, ":test");
DEFSYM (QCsize, ":size");
+ DEFSYM (QCpurecopy, ":purecopy");
DEFSYM (QCrehash_size, ":rehash-size");
DEFSYM (QCrehash_threshold, ":rehash-threshold");
DEFSYM (QCweakness, ":weakness");
diff --git a/src/fontset.c b/src/fontset.c
index 33d1d24..850558b 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1677,11 +1677,10 @@ FONT-SPEC is a vector, a cons, or a string. See the
documentation of
`set-fontset-font' for the meaning. */)
(Lisp_Object name, Lisp_Object fontlist)
{
- Lisp_Object fontset;
+ Lisp_Object fontset, tail;
int id;
CHECK_STRING (name);
- CHECK_LIST (fontlist);
name = Fdowncase (name);
id = fs_query_fontset (name, 0);
@@ -1714,11 +1713,11 @@ FONT-SPEC is a vector, a cons, or a string. See the
documentation of
Fset_char_table_range (fontset, Qt, Qnil);
}
- for (; CONSP (fontlist); fontlist = XCDR (fontlist))
+ for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt, script;
- elt = XCAR (fontlist);
+ elt = XCAR (tail);
script = Fcar (elt);
elt = Fcdr (elt);
if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
@@ -1727,6 +1726,7 @@ FONT-SPEC is a vector, a cons, or a string. See the
documentation of
else
Fset_fontset_font (name, script, elt, Qnil, Qappend);
}
+ CHECK_LIST_END (tail, fontlist);
return name;
}
diff --git a/src/frame.c b/src/frame.c
index 2c2c1e1..d0f653f 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -2691,9 +2691,7 @@ list, but are otherwise ignored. */)
(Lisp_Object frame, Lisp_Object alist)
{
struct frame *f = decode_live_frame (frame);
- register Lisp_Object prop, val;
-
- CHECK_LIST (alist);
+ Lisp_Object prop, val;
/* I think this should be done with a hook. */
#ifdef HAVE_WINDOW_SYSTEM
@@ -3142,6 +3140,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object
alist)
for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
size++;
+ CHECK_LIST_END (tail, alist);
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (parms, 2 * size);
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index 6ec5c64..285a253 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -178,20 +178,18 @@ will be reported only in case of the `moved' event. */)
if (NILP (Ffile_exists_p (file)))
report_file_error ("File does not exist", file);
- CHECK_LIST (flags);
-
if (!FUNCTIONP (callback))
wrong_type_argument (Qinvalid_function, callback);
- /* Create GFile name. */
- gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
-
/* Assemble flags. */
if (!NILP (Fmember (Qwatch_mounts, flags)))
gflags |= G_FILE_MONITOR_WATCH_MOUNTS;
if (!NILP (Fmember (Qsend_moved, flags)))
gflags |= G_FILE_MONITOR_SEND_MOVED;
+ /* Create GFile name. */
+ gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file)));
+
/* Enable watch. */
monitor = g_file_monitor (gfile, gflags, NULL, &gerror);
g_object_unref (gfile);
diff --git a/src/gnutls.c b/src/gnutls.c
index 735d2e3..d0d7f2d 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -390,7 +390,7 @@ gnutls_try_handshake (struct Lisp_Process *proc)
{
ret = gnutls_handshake (state);
emacs_gnutls_handle_error (state, ret);
- QUIT;
+ maybe_quit ();
}
while (ret < 0
&& gnutls_error_is_fatal (ret) == 0
@@ -582,8 +582,17 @@ emacs_gnutls_handle_error (gnutls_session_t session, int
err)
if (gnutls_error_is_fatal (err))
{
+ int level = 1;
+ /* Mostly ignore "The TLS connection was non-properly
+ terminated" message which just means that the peer closed the
+ connection. */
+#ifdef HAVE_GNUTLS3
+ if (err == GNUTLS_E_PREMATURE_TERMINATION)
+ level = 3;
+#endif
+
+ GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
ret = 0;
- GNUTLS_LOG2 (1, max_log_level, "fatal error:", str);
}
else
{
diff --git a/src/image.c b/src/image.c
index 39677d2..ad0143b 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4020,7 +4020,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object,
const char *, int,
return make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil);
+ Qnil, Qnil);
}
static void
diff --git a/src/indent.c b/src/indent.c
index 3444995..23951a1 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,8 +1200,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
continuation_glyph_width = 0; /* In the fringe. */
#endif
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
/* It's just impossible to be too paranoid here. */
eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
@@ -1694,7 +1694,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
/* Nonzero if have just continued a line */
val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
- immediate_quit = 0;
+ immediate_quit = false;
return &val_compute_motion;
}
diff --git a/src/insdel.c b/src/insdel.c
index b93606c..3f933b0 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -129,7 +129,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
Change BYTEPOS to be where we have actually moved the gap to.
Note that this cannot happen when we are called to make the
gap larger or smaller, since make_gap_larger and
- make_gap_smaller prevent QUIT by setting inhibit-quit. */
+ make_gap_smaller set inhibit-quit. */
if (QUITP)
{
bytepos = new_s1;
@@ -151,7 +151,7 @@ gap_left (ptrdiff_t charpos, ptrdiff_t bytepos, bool newgap)
GPT = charpos;
eassert (charpos <= bytepos);
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- QUIT;
+ maybe_quit ();
}
/* Move the gap to a position greater than the current GPT.
@@ -185,7 +185,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
Change BYTEPOS to be where we have actually moved the gap to.
Note that this cannot happen when we are called to make the
gap larger or smaller, since make_gap_larger and
- make_gap_smaller prevent QUIT by setting inhibit-quit. */
+ make_gap_smaller set inhibit-quit. */
if (QUITP)
{
bytepos = new_s1;
@@ -204,7 +204,7 @@ gap_right (ptrdiff_t charpos, ptrdiff_t bytepos)
GPT_BYTE = bytepos;
eassert (charpos <= bytepos);
if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
- QUIT;
+ maybe_quit ();
}
/* If the selected window's old pointm is adjacent or covered by the
@@ -464,7 +464,7 @@ make_gap_larger (ptrdiff_t nbytes_added)
enlarge_buffer_text (current_buffer, nbytes_added);
- /* Prevent quitting in gap_left. We cannot allow a QUIT there,
+ /* Prevent quitting in gap_left. We cannot allow a quit there,
because that would leave the buffer text in an inconsistent
state, with 2 gap holes instead of just one. */
tem = Vinhibit_quit;
@@ -512,7 +512,7 @@ make_gap_smaller (ptrdiff_t nbytes_removed)
if (GAP_SIZE - nbytes_removed < GAP_BYTES_MIN)
nbytes_removed = GAP_SIZE - GAP_BYTES_MIN;
- /* Prevent quitting in gap_right. We cannot allow a QUIT there,
+ /* Prevent quitting in gap_right. We cannot allow a quit there,
because that would leave the buffer text in an inconsistent
state, with 2 gap holes instead of just one. */
tem = Vinhibit_quit;
diff --git a/src/keyboard.c b/src/keyboard.c
index 6aad0ac..d41603b 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -87,7 +87,7 @@ char const DEV_TTY[] = "/dev/tty";
volatile int interrupt_input_blocked;
/* True means an input interrupt or alarm signal has arrived.
- The QUIT macro checks this. */
+ The maybe_quit function checks this. */
volatile bool pending_signals;
#define KBD_BUFFER_SIZE 4096
@@ -1416,7 +1416,7 @@ command_loop_1 (void)
if (!NILP (Vquit_flag))
{
Vexecuting_kbd_macro = Qt;
- QUIT; /* Make some noise. */
+ maybe_quit (); /* Make some noise. */
/* Will return since macro now empty. */
}
}
@@ -3591,7 +3591,7 @@ kbd_buffer_store_buffered_event (union
buffered_input_event *event,
if (immediate_quit && NILP (Vinhibit_quit))
{
immediate_quit = false;
- QUIT;
+ maybe_quit ();
}
}
}
@@ -7426,7 +7426,7 @@ menu_bar_items (Lisp_Object old)
USE_SAFE_ALLOCA;
/* In order to build the menus, we need to call the keymap
- accessors. They all call QUIT. But this function is called
+ accessors. They all call maybe_quit. But this function is called
during redisplay, during which a quit is fatal. So inhibit
quitting while building the menus.
We do this instead of specbind because (1) errors will clear it anyway
@@ -7987,7 +7987,7 @@ tool_bar_items (Lisp_Object reuse, int *nitems)
*nitems = 0;
/* In order to build the menus, we need to call the keymap
- accessors. They all call QUIT. But this function is called
+ accessors. They all call maybe_quit. But this function is called
during redisplay, during which a quit is fatal. So inhibit
quitting while building the menus. We do this instead of
specbind because (1) errors will clear it anyway and (2) this
@@ -9806,7 +9806,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object
continue_echo,
if (!NILP (prompt))
CHECK_STRING (prompt);
- QUIT;
+ maybe_quit ();
specbind (Qinput_method_exit_on_first_char,
(NILP (cmd_loop) ? Qt : Qnil));
@@ -9840,7 +9840,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object
continue_echo,
if (i == -1)
{
Vquit_flag = Qt;
- QUIT;
+ maybe_quit ();
}
return unbind_to (count,
@@ -10278,7 +10278,7 @@ clear_waiting_for_input (void)
If we have a frame on the controlling tty, we assume that the
SIGINT was generated by C-g, so we call handle_interrupt.
- Otherwise, tell QUIT to kill Emacs. */
+ Otherwise, tell maybe_quit to kill Emacs. */
static void
handle_interrupt_signal (int sig)
@@ -10289,7 +10289,7 @@ handle_interrupt_signal (int sig)
{
/* If there are no frames there, let's pretend that we are a
well-behaving UN*X program and quit. We must not call Lisp
- in a signal handler, so tell QUIT to exit when it is
+ in a signal handler, so tell maybe_quit to exit when it is
safe. */
Vquit_flag = Qkill_emacs;
}
diff --git a/src/keyboard.h b/src/keyboard.h
index 7cd41ae..2219c01 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -486,6 +486,8 @@ extern bool kbd_buffer_events_waiting (void);
extern void add_user_signal (int, const char *);
extern int tty_read_avail_input (struct terminal *, struct input_event *);
+extern bool volatile pending_signals;
+extern void process_pending_signals (void);
extern struct timespec timer_check (void);
extern void mark_kboards (void);
diff --git a/src/keymap.c b/src/keymap.c
index 9e75947..9caf55f 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -523,7 +523,7 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx,
retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
}
}
- QUIT;
+ maybe_quit ();
}
return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
@@ -877,7 +877,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object
idx, Lisp_Object def)
should be inserted before it. */
goto keymap_end;
- QUIT;
+ maybe_quit ();
}
keymap_end:
@@ -1250,7 +1250,7 @@ recognize the default bindings, just as
`read-key-sequence' does. */)
if (!CONSP (keymap))
return make_number (idx);
- QUIT;
+ maybe_quit ();
}
}
@@ -2466,7 +2466,7 @@ where_is_internal (Lisp_Object definition, Lisp_Object
keymaps,
non-ascii prefixes like `C-down-mouse-2'. */
continue;
- QUIT;
+ maybe_quit ();
data.definition = definition;
data.noindirect = noindirect;
@@ -3173,7 +3173,7 @@ describe_map (Lisp_Object map, Lisp_Object prefix,
for (tail = map; CONSP (tail); tail = XCDR (tail))
{
- QUIT;
+ maybe_quit ();
if (VECTORP (XCAR (tail))
|| CHAR_TABLE_P (XCAR (tail)))
@@ -3426,7 +3426,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix,
Lisp_Object args,
int range_beg, range_end;
Lisp_Object val;
- QUIT;
+ maybe_quit ();
if (i == stop)
{
diff --git a/src/lisp.h b/src/lisp.h
index e774756..91c430f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -310,7 +310,6 @@ error !;
# define lisp_h_XLI(o) (o)
# define lisp_h_XIL(i) (i)
#endif
-#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y)
#define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x)
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
@@ -367,7 +366,6 @@ error !;
#if DEFINE_KEY_OPS_AS_MACROS
# define XLI(o) lisp_h_XLI (o)
# define XIL(i) lisp_h_XIL (i)
-# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
@@ -1997,6 +1995,10 @@ struct Lisp_Hash_Table
hash table size to reduce collisions. */
Lisp_Object index;
+ /* Non-nil if the table can be purecopied. Any changes the table after
+ purecopy will result in an error. */
+ Lisp_Object pure;
+
/* 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
a special way (e.g. because of weakness). */
@@ -2751,9 +2753,9 @@ CHECK_LIST (Lisp_Object x)
}
INLINE void
-(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y)
+CHECK_LIST_END (Lisp_Object x, Lisp_Object y)
{
- lisp_h_CHECK_LIST_CONS (x, y);
+ CHECK_TYPE (NILP (x), Qlistp, y);
}
INLINE void
@@ -3121,34 +3123,25 @@ struct handler
extern Lisp_Object memory_signal_data;
-/* Check quit-flag and quit if it is non-nil.
- Typing C-g does not directly cause a quit; it only sets Vquit_flag.
- So the program needs to do QUIT at times when it is safe to quit.
- Every loop that might run for a long time or might not exit
- ought to do QUIT at least once, at a safe place.
- Unless that is impossible, of course.
- But it is very desirable to avoid creating loops where QUIT is impossible.
+/* Check quit-flag and quit if it is non-nil. Typing C-g does not
+ directly cause a quit; it only sets Vquit_flag. So the program
+ needs to call maybe_quit at times when it is safe to quit. Every
+ loop that might run for a long time or might not exit ought to call
+ maybe_quit at least once, at a safe place. Unless that is
+ impossible, of course. But it is very desirable to avoid creating
+ loops where maybe_quit is impossible.
- Exception: if you set immediate_quit to true,
- then the handler that responds to the C-g does the quit itself.
- This is a good thing to do around a loop that has no side effects
- and (in particular) cannot call arbitrary Lisp code.
+ Exception: if you set immediate_quit, the handler that responds to
+ the C-g does the quit itself. This is a good thing to do around a
+ loop that has no side effects and (in particular) cannot call
+ arbitrary Lisp code.
If quit-flag is set to `kill-emacs' the SIGINT handler has received
- a request to exit Emacs when it is safe to do. */
-
-extern void process_pending_signals (void);
-extern bool volatile pending_signals;
+ a request to exit Emacs when it is safe to do.
-extern void process_quit_flag (void);
-#define QUIT \
- do { \
- if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
- process_quit_flag (); \
- else if (pending_signals) \
- process_pending_signals (); \
- } while (false)
+ When not quitting, process any pending signals. */
+extern void maybe_quit (void);
/* True if ought to quit now. */
@@ -3375,7 +3368,7 @@ extern void sweep_weak_hash_tables (void);
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object);
+ Lisp_Object, Lisp_Object, Lisp_Object);
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT);
diff --git a/src/lread.c b/src/lread.c
index 284fd1a..1780692 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -451,7 +451,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
while (c == EOF && ferror (instream) && errno == EINTR)
{
unblock_input ();
- QUIT;
+ maybe_quit ();
block_input ();
clearerr (instream);
c = getc (instream);
@@ -1702,14 +1702,14 @@ build_load_history (Lisp_Object filename, bool entire)
Fcons (newelt, XCDR (tem))));
tem2 = XCDR (tem2);
- QUIT;
+ maybe_quit ();
}
}
}
else
prev = tail;
tail = XCDR (tail);
- QUIT;
+ maybe_quit ();
}
/* If we're loading an entire file, cons the new assoc onto the
@@ -2599,7 +2599,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
Lisp_Object val = Qnil;
/* The size is 2 * number of allowed keywords to
make-hash-table. */
- Lisp_Object params[10];
+ Lisp_Object params[12];
Lisp_Object ht;
Lisp_Object key = Qnil;
int param_count = 0;
@@ -2636,6 +2636,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
if (!NILP (params[param_count + 1]))
param_count += 2;
+ params[param_count] = QCpurecopy;
+ params[param_count + 1] = Fplist_get (tmp, Qpurecopy);
+ if (!NILP (params[param_count + 1]))
+ param_count += 2;
+
/* This is the hash table data. */
data = Fplist_get (tmp, Qdata);
@@ -4849,6 +4854,7 @@ that are loaded before your customizations are read! */);
DEFSYM (Qdata, "data");
DEFSYM (Qtest, "test");
DEFSYM (Qsize, "size");
+ DEFSYM (Qpurecopy, "purecopy");
DEFSYM (Qweakness, "weakness");
DEFSYM (Qrehash_size, "rehash-size");
DEFSYM (Qrehash_threshold, "rehash-threshold");
diff --git a/src/macros.c b/src/macros.c
index 3b29cc6..f0ffda3 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -325,7 +325,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC
returns nil. */)
executing_kbd_macro_iterations = ++success_count;
- QUIT;
+ maybe_quit ();
}
while (--repeat
&& (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro)));
diff --git a/src/minibuf.c b/src/minibuf.c
index d44bb44..1bbe276 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1865,7 +1865,7 @@ single string, rather than a cons cell whose car is a
string. */)
case_fold);
if (EQ (tem, Qt))
return elt;
- QUIT;
+ maybe_quit ();
}
return Qnil;
}
diff --git a/src/print.c b/src/print.c
index dfaa489..db3d00f 100644
--- a/src/print.c
+++ b/src/print.c
@@ -279,7 +279,7 @@ printchar (unsigned int ch, Lisp_Object fun)
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (ch, str);
- QUIT;
+ maybe_quit ();
if (NILP (fun))
{
@@ -1352,7 +1352,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
40))];
- QUIT;
+ maybe_quit ();
/* Detect circularities and truncate them. */
if (NILP (Vprint_circle))
@@ -1446,7 +1446,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
- QUIT;
+ maybe_quit ();
if (multibyte
? (CHAR_BYTE8_P (c) && (c = CHAR_TO_BYTE8 (c), true))
@@ -1550,7 +1550,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
- QUIT;
+ maybe_quit ();
if (escapeflag)
{
@@ -1707,7 +1707,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
for (i = 0; i < size_in_chars; i++)
{
- QUIT;
+ maybe_quit ();
c = bool_vector_uchar_data (obj)[i];
if (c == '\n' && print_escape_newlines)
print_c_string ("\\n", printcharfun);
@@ -1818,6 +1818,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
print_object (h->rehash_threshold, printcharfun, escapeflag);
}
+ if (!NILP (h->pure))
+ {
+ print_c_string (" purecopy ", printcharfun);
+ print_object (h->pure, printcharfun, escapeflag);
+ }
+
print_c_string (" data ", printcharfun);
/* Print the data here as a plist. */
diff --git a/src/process.c b/src/process.c
index ab9657b..dbd4358 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,8 +3431,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
break;
}
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
ret = connect (s, sa, addrlen);
xerrno = errno;
@@ -3459,7 +3459,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
retry_select:
FD_ZERO (&fdset);
FD_SET (s, &fdset);
- QUIT;
+ maybe_quit ();
sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
if (sc == -1)
{
@@ -3481,7 +3481,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
}
#endif /* !WINDOWSNT */
- immediate_quit = 0;
+ immediate_quit = false;
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count;
@@ -3539,7 +3539,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
#endif
}
- immediate_quit = 0;
+ immediate_quit = false;
if (s < 0)
{
@@ -4012,8 +4012,8 @@ usage: (make-network-process &rest ARGS) */)
struct addrinfo *res, *lres;
int ret;
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
struct addrinfo hints;
memset (&hints, 0, sizeof hints);
@@ -4034,7 +4034,7 @@ usage: (make-network-process &rest ARGS) */)
#else
error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
- immediate_quit = 0;
+ immediate_quit = false;
for (lres = res; lres; lres = lres->ai_next)
addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
@@ -5020,7 +5020,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
since we want to return C-g as an input character.
Otherwise, do pending quit if requested. */
if (read_kbd >= 0)
- QUIT;
+ maybe_quit ();
else if (pending_signals)
process_pending_signals ();
@@ -5748,7 +5748,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
{
/* Prevent input_pending from remaining set if we quit. */
clear_input_pending ();
- QUIT;
+ maybe_quit ();
}
return got_some_output;
@@ -7486,7 +7486,7 @@ wait_reading_process_output (intmax_t time_limit, int
nsecs, int read_kbd,
since we want to return C-g as an input character.
Otherwise, do pending quit if requested. */
if (read_kbd >= 0)
- QUIT;
+ maybe_quit ();
/* Exit now if the cell we're waiting for became non-nil. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
diff --git a/src/profiler.c b/src/profiler.c
index efc0cb3..a223a7e 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -48,7 +48,7 @@ make_log (EMACS_INT heap_size, EMACS_INT max_stack_depth)
make_number (heap_size),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil);
+ Qnil, Qnil);
struct Lisp_Hash_Table *h = XHASH_TABLE (log);
/* What is special about our hash-tables is that the keys are pre-filled
@@ -174,8 +174,8 @@ record_backtrace (log_t *log, EMACS_INT count)
some global flag so that some Elisp code can offload its
data elsewhere, so as to avoid the eviction code.
There are 2 ways to do that, AFAICT:
- - Set a flag checked in QUIT, such that QUIT can then call
- Fprofiler_cpu_log and stash the full log for later use.
+ - Set a flag checked in maybe_quit, such that maybe_quit can then
+ call Fprofiler_cpu_log and stash the full log for later use.
- Set a flag check in post-gc-hook, so that Elisp code can call
profiler-cpu-log. That gives us more flexibility since that
Elisp code can then do all kinds of fun stuff like write
diff --git a/src/regex.c b/src/regex.c
index db3f0c1..f6e67af 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1729,12 +1729,9 @@ typedef struct
/* Explicit quit checking is needed for Emacs, which uses polling to
process input events. */
#ifdef emacs
-# define IMMEDIATE_QUIT_CHECK \
- do { \
- if (immediate_quit) QUIT; \
- } while (0)
+# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0)
#else
-# define IMMEDIATE_QUIT_CHECK ((void)0)
+# define IMMEDIATE_QUIT_CHECK ((void) 0)
#endif
/* Structure to manage work area for range table. */
diff --git a/src/search.c b/src/search.c
index d304510..f54f44c 100644
--- a/src/search.c
+++ b/src/search.c
@@ -276,8 +276,9 @@ looking_at_1 (Lisp_Object string, bool posix)
posix,
!NILP (BVAR (current_buffer,
enable_multibyte_characters)));
- immediate_quit = 1;
- QUIT; /* Do a pending quit right away, to avoid
paradoxical behavior */
+ /* Do a pending quit right away, to avoid paradoxical behavior */
+ immediate_quit = true;
+ maybe_quit ();
/* Get pointers and sizes of the two strings
that make up the visible portion of the buffer. */
@@ -310,7 +311,7 @@ looking_at_1 (Lisp_Object string, bool posix)
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL),
ZV_BYTE - BEGV_BYTE);
- immediate_quit = 0;
+ immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -398,7 +399,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string,
Lisp_Object start,
? BVAR (current_buffer, case_canon_table) : Qnil),
posix,
STRING_MULTIBYTE (string));
- immediate_quit = 1;
+ immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
@@ -406,7 +407,7 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string,
Lisp_Object start,
SBYTES (string) - pos_byte,
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL));
- immediate_quit = 0;
+ immediate_quit = false;
/* Set last_thing_searched only when match data is changed. */
if (NILP (Vinhibit_changing_match_data))
@@ -470,13 +471,13 @@ fast_string_match_internal (Lisp_Object regexp,
Lisp_Object string,
bufp = compile_pattern (regexp, 0, table,
0, STRING_MULTIBYTE (string));
- immediate_quit = 1;
+ immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
SBYTES (string), 0,
SBYTES (string), 0);
- immediate_quit = 0;
+ immediate_quit = false;
return val;
}
@@ -497,9 +498,9 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
bufp = compile_pattern (regexp, 0,
Vascii_canon_table, 0,
0);
- immediate_quit = 1;
+ immediate_quit = true;
val = re_search (bufp, string, len, 0, len, 0);
- immediate_quit = 0;
+ immediate_quit = false;
return val;
}
@@ -560,7 +561,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
- immediate_quit = 1;
+ immediate_quit = true;
#ifdef REL_ALLOC
/* Prevent ralloc.c from relocating the current buffer while
searching it. */
@@ -571,7 +572,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos,
ptrdiff_t pos_byte,
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
- immediate_quit = 0;
+ immediate_quit = false;
return len;
}
@@ -703,7 +704,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = 0;
+ immediate_quit = false;
while (start < end && result)
{
ptrdiff_t lim1;
@@ -809,7 +810,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = 0;
+ immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
@@ -832,7 +833,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = 0;
+ immediate_quit = false;
while (start > end && result)
{
ptrdiff_t lim1;
@@ -917,7 +918,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (++count >= 0)
{
- immediate_quit = 0;
+ immediate_quit = false;
if (bytepos)
*bytepos = ceiling_byte + prev + 1;
return BYTE_TO_CHAR (ceiling_byte + prev + 1);
@@ -929,7 +930,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
}
}
- immediate_quit = 0;
+ immediate_quit = false;
if (shortage)
*shortage = count * direction;
if (bytepos)
@@ -1196,10 +1197,10 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
trt, posix,
!NILP (BVAR (current_buffer,
enable_multibyte_characters)));
- immediate_quit = 1; /* Quit immediately if user types ^G,
+ immediate_quit = true; /* Quit immediately if user types ^G,
because letting this function finish
can take too long. */
- QUIT; /* Do a pending quit right away,
+ maybe_quit (); /* Do a pending quit right away,
to avoid paradoxical behavior */
/* Get pointers and sizes of the two strings
that make up the visible portion of the buffer. */
@@ -1267,7 +1268,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
else
{
- immediate_quit = 0;
+ immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -1312,7 +1313,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
else
{
- immediate_quit = 0;
+ immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -1320,7 +1321,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
n--;
}
- immediate_quit = 0;
+ immediate_quit = false;
#ifdef REL_ALLOC
r_alloc_inhibit_buffer_relocation (0);
#endif
@@ -1927,7 +1928,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
< 0)
return (n * (0 - direction));
/* First we do the part we can by pointers (maybe nothing) */
- QUIT;
+ maybe_quit ();
pat = base_pat;
limit = pos_byte - dirlen + direction;
if (direction > 0)
@@ -3274,7 +3275,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = 0;
+ immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
@@ -3286,7 +3287,7 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
}
}
- immediate_quit = 0;
+ immediate_quit = false;
if (shortage)
*shortage = count;
if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index 84147a2..f9e4093 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1426,8 +1426,8 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
int ch0, ch1;
Lisp_Object func, pos;
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
SETUP_SYNTAX_TABLE (from, count);
@@ -1437,7 +1437,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
{
if (from == end)
{
- immediate_quit = 0;
+ immediate_quit = false;
return 0;
}
UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -1487,7 +1487,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
{
if (from == beg)
{
- immediate_quit = 0;
+ immediate_quit = false;
return 0;
}
DEC_BOTH (from, from_byte);
@@ -1536,7 +1536,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
count++;
}
- immediate_quit = 0;
+ immediate_quit = false;
return from;
}
@@ -1921,7 +1921,7 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
}
- immediate_quit = 1;
+ immediate_quit = true;
/* This code may look up syntax tables using functions that rely on the
gl_state object. To make sure this object is not out of date,
let's initialize it manually.
@@ -2064,7 +2064,7 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
}
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = 0;
+ immediate_quit = false;
SAFE_FREE ();
return make_number (PT - start_point);
@@ -2138,7 +2138,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p, *endp, *stop;
- immediate_quit = 1;
+ immediate_quit = true;
SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
if (forwardp)
@@ -2224,7 +2224,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
done:
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = 0;
+ immediate_quit = false;
return make_number (PT - start_point);
}
@@ -2412,8 +2412,8 @@ between them, return t; otherwise return nil. */)
count1 = XINT (count);
stop = count1 > 0 ? ZV : BEGV;
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
from = PT;
from_byte = PT_BYTE;
@@ -2429,7 +2429,7 @@ between them, return t; otherwise return nil. */)
if (from == stop)
{
SET_PT_BOTH (from, from_byte);
- immediate_quit = 0;
+ immediate_quit = false;
return Qnil;
}
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2463,7 +2463,7 @@ between them, return t; otherwise return nil. */)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
- immediate_quit = 0;
+ immediate_quit = false;
DEC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
@@ -2474,7 +2474,7 @@ between them, return t; otherwise return nil. */)
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
- immediate_quit = 0;
+ immediate_quit = false;
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2494,7 +2494,7 @@ between them, return t; otherwise return nil. */)
if (from <= stop)
{
SET_PT_BOTH (BEGV, BEGV_BYTE);
- immediate_quit = 0;
+ immediate_quit = false;
return Qnil;
}
@@ -2587,7 +2587,7 @@ between them, return t; otherwise return nil. */)
else if (code != Swhitespace || quoted)
{
leave:
- immediate_quit = 0;
+ immediate_quit = false;
INC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
@@ -2598,7 +2598,7 @@ between them, return t; otherwise return nil. */)
}
SET_PT_BOTH (from, from_byte);
- immediate_quit = 0;
+ immediate_quit = false;
return Qt;
}
@@ -2640,8 +2640,8 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
from_byte = CHAR_TO_BYTE (from);
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
SETUP_SYNTAX_TABLE (from, count);
while (count > 0)
@@ -2801,7 +2801,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = 0;
+ immediate_quit = false;
return Qnil;
/* End of object reached */
@@ -2984,7 +2984,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = 0;
+ immediate_quit = false;
return Qnil;
done2:
@@ -2992,7 +2992,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
}
- immediate_quit = 0;
+ immediate_quit = false;
XSETFASTINT (val, from);
return val;
@@ -3092,6 +3092,36 @@ the prefix syntax flag (p). */)
return Qnil;
}
+
+/* If the character at FROM_BYTE is the second part of a 2-character
+ comment opener based on PREV_FROM_SYNTAX, update STATE and return
+ true. */
+static bool
+in_2char_comment_start (struct lisp_parse_state *state,
+ int prev_from_syntax,
+ ptrdiff_t prev_from,
+ ptrdiff_t from_byte)
+{
+ int c1, syntax;
+ if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
+ && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
+ syntax = SYNTAX_WITH_FLAGS (c1),
+ SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
+ {
+ /* Record the comment style we have entered so that only
+ the comment-end sequence of the same style actually
+ terminates the comment section. */
+ state->comstyle
+ = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
+ bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
+ | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
+ state->incomment = comnested ? 1 : -1;
+ state->comstr_start = prev_from;
+ return true;
+ }
+ return false;
+}
+
/* Parse forward from FROM / FROM_BYTE to END,
assuming that FROM has state STATE,
and return a description of the state of the parse at END.
@@ -3107,8 +3137,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
int commentstop)
{
enum syntaxcode code;
- int c1;
- bool comnested;
struct level { ptrdiff_t last, prev; };
struct level levelstart[100];
struct level *curlevel = levelstart;
@@ -3122,7 +3150,6 @@ scan_sexps_forward (struct lisp_parse_state *state,
ptrdiff_t prev_from; /* Keep one character before FROM. */
ptrdiff_t prev_from_byte;
int prev_from_syntax, prev_prev_from_syntax;
- int syntax;
bool boundary_stop = commentstop == -1;
bool nofence;
bool found;
@@ -3146,8 +3173,8 @@ do { prev_from = from; \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
- immediate_quit = 1;
- QUIT;
+ immediate_quit = true;
+ maybe_quit ();
depth = state->depth;
start_quoted = state->quoted;
@@ -3187,53 +3214,31 @@ do { prev_from = from; \
}
else if (start_quoted)
goto startquoted;
+ else if ((from < end)
+ && (in_2char_comment_start (state, prev_from_syntax,
+ prev_from, from_byte)))
+ {
+ INC_FROM;
+ prev_from_syntax = Smax; /* the syntax has already been "used up". */
+ goto atcomment;
+ }
while (from < end)
{
- if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
- && (c1 = FETCH_CHAR (from_byte),
- syntax = SYNTAX_WITH_FLAGS (c1),
- SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
- {
- /* Record the comment style we have entered so that only
- the comment-end sequence of the same style actually
- terminates the comment section. */
- state->comstyle
- = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
- comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
- | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
- state->incomment = comnested ? 1 : -1;
- state->comstr_start = prev_from;
- INC_FROM;
- prev_from_syntax = Smax; /* the syntax has already been
- "used up". */
- code = Scomment;
- }
- else
+ INC_FROM;
+
+ if ((from < end)
+ && (in_2char_comment_start (state, prev_from_syntax,
+ prev_from, from_byte)))
{
INC_FROM;
- code = prev_from_syntax & 0xff;
- if (code == Scomment_fence)
- {
- /* Record the comment style we have entered so that only
- the comment-end sequence of the same style actually
- terminates the comment section. */
- state->comstyle = ST_COMMENT_STYLE;
- state->incomment = -1;
- state->comstr_start = prev_from;
- code = Scomment;
- }
- else if (code == Scomment)
- {
- state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax,
0);
- state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED
(prev_from_syntax) ?
- 1 : -1);
- state->comstr_start = prev_from;
- }
+ prev_from_syntax = Smax; /* the syntax has already been "used up". */
+ goto atcomment;
}
if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
continue;
+ code = prev_from_syntax & 0xff;
switch (code)
{
case Sescape:
@@ -3252,24 +3257,15 @@ do { prev_from = from; \
symstarted:
while (from < end)
{
- int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
-
- if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
- && (syntax = SYNTAX_WITH_FLAGS (symchar),
- SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
+ if (in_2char_comment_start (state, prev_from_syntax,
+ prev_from, from_byte))
{
- state->comstyle
- = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
- comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
- | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
- state->incomment = comnested ? 1 : -1;
- state->comstr_start = prev_from;
INC_FROM;
- prev_from_syntax = Smax;
- code = Scomment;
+ prev_from_syntax = Smax; /* the syntax has already been
"used up". */
goto atcomment;
}
+ int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
switch (SYNTAX (symchar))
{
case Scharquote:
@@ -3290,8 +3286,19 @@ do { prev_from = from; \
curlevel->prev = curlevel->last;
break;
- case Scomment_fence: /* Can't happen because it's handled above. */
+ case Scomment_fence:
+ /* Record the comment style we have entered so that only
+ the comment-end sequence of the same style actually
+ terminates the comment section. */
+ state->comstyle = ST_COMMENT_STYLE;
+ state->incomment = -1;
+ state->comstr_start = prev_from;
+ goto atcomment;
case Scomment:
+ state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
+ state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
+ 1 : -1);
+ state->comstr_start = prev_from;
atcomment:
if (commentstop || boundary_stop) goto done;
startincomment:
@@ -3425,7 +3432,7 @@ do { prev_from = from; \
state->levelstarts);
state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
|| state->quoted) ? prev_from_syntax : Smax;
- immediate_quit = 0;
+ immediate_quit = false;
}
/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index 4316c21..e172dc0 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -391,10 +391,10 @@ get_child_status (pid_t child, int *status, int options,
bool interruptible)
if (errno != EINTR)
emacs_abort ();
- /* Note: the MS-Windows emulation of waitpid calls QUIT
+ /* Note: the MS-Windows emulation of waitpid calls maybe_quit
internally. */
if (interruptible)
- QUIT;
+ maybe_quit ();
}
/* If successful and status is requested, tell wait_reading_process_output
@@ -2383,7 +2383,7 @@ emacs_open (const char *file, int oflags, int mode)
oflags |= O_BINARY;
oflags |= O_CLOEXEC;
while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR)
- QUIT;
+ maybe_quit ();
if (! O_CLOEXEC && 0 <= fd)
fcntl (fd, F_SETFD, FD_CLOEXEC);
return fd;
@@ -2516,7 +2516,7 @@ emacs_read (int fildes, void *buf, ptrdiff_t nbyte)
while ((rtnval = read (fildes, buf, nbyte)) == -1
&& (errno == EINTR))
- QUIT;
+ maybe_quit ();
return (rtnval);
}
@@ -2538,7 +2538,7 @@ emacs_full_write (int fildes, char const *buf, ptrdiff_t
nbyte,
{
if (errno == EINTR)
{
- /* I originally used `QUIT' but that might cause files to
+ /* I originally used maybe_quit but that might cause files to
be truncated if you hit C-g in the middle of it. --Stef */
if (process_signals && pending_signals)
process_pending_signals ();
diff --git a/src/textprop.c b/src/textprop.c
index 7cb3d3c..225ff28 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -211,7 +211,7 @@ validate_plist (Lisp_Object list)
if (! CONSP (tail))
error ("Odd length text property list");
tail = XCDR (tail);
- QUIT;
+ maybe_quit ();
}
while (CONSP (tail));
diff --git a/src/thread.c b/src/thread.c
index 5498fe5..9ea7e12 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -128,11 +128,11 @@ lisp_mutex_init (lisp_mutex_t *mutex)
sys_cond_init (&mutex->condition);
}
-/* Lock MUTEX setting its count to COUNT, if non-zero, or to 1
- otherwise.
+/* Lock MUTEX for thread LOCKER, setting its lock count to COUNT, if
+ non-zero, or to 1 otherwise.
- If MUTEX is locked by the current thread, COUNT must be zero, and
- the MUTEX's lock count will be incremented.
+ If MUTEX is locked by LOCKER, COUNT must be zero, and the MUTEX's
+ lock count will be incremented.
If MUTEX is locked by another thread, this function will release
the global lock, giving other threads a chance to run, and will
@@ -143,24 +143,25 @@ lisp_mutex_init (lisp_mutex_t *mutex)
unlocked (meaning other threads could have run during the wait),
zero otherwise. */
static int
-lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
+lisp_mutex_lock_for_thread (lisp_mutex_t *mutex, struct thread_state *locker,
+ int new_count)
{
struct thread_state *self;
if (mutex->owner == NULL)
{
- mutex->owner = current_thread;
+ mutex->owner = locker;
mutex->count = new_count == 0 ? 1 : new_count;
return 0;
}
- if (mutex->owner == current_thread)
+ if (mutex->owner == locker)
{
eassert (new_count == 0);
++mutex->count;
return 0;
}
- self = current_thread;
+ self = locker;
self->wait_condvar = &mutex->condition;
while (mutex->owner != NULL && (new_count != 0
|| NILP (self->error_symbol)))
@@ -176,6 +177,12 @@ lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
return 1;
}
+static int
+lisp_mutex_lock (lisp_mutex_t *mutex, int new_count)
+{
+ return lisp_mutex_lock_for_thread (mutex, current_thread, new_count);
+}
+
/* Decrement MUTEX's lock count. If the lock count becomes zero after
decrementing it, meaning the mutex is now unlocked, broadcast that
to all the threads that might be waiting to lock the mutex. This
@@ -398,16 +405,16 @@ condition_wait_callback (void *arg)
self->wait_condvar = NULL;
}
self->event_object = Qnil;
- /* Since sys_cond_wait could switch threads, we need to re-establish
- ourselves as the current thread, otherwise lisp_mutex_lock will
- record the wrong thread as the owner of the mutex lock. */
- post_acquire_global_lock (self);
- /* Calling lisp_mutex_lock might yield to other threads while this
- one waits for the mutex to become unlocked, so we need to
- announce us as the current thread by calling
+ /* Since sys_cond_wait could switch threads, we need to lock the
+ mutex for the thread which was the current when we were called,
+ otherwise lisp_mutex_lock will record the wrong thread as the
+ owner of the mutex lock. */
+ lisp_mutex_lock_for_thread (&mutex->mutex, self, saved_count);
+ /* Calling lisp_mutex_lock_for_thread might yield to other threads
+ while this one waits for the mutex to become unlocked, so we need
+ to announce us as the current thread by calling
post_acquire_global_lock. */
- if (lisp_mutex_lock (&mutex->mutex, saved_count))
- post_acquire_global_lock (self);
+ post_acquire_global_lock (self);
}
DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0,
@@ -663,10 +670,13 @@ invoke_thread_function (void)
return unbind_to (count, Qnil);
}
+static Lisp_Object last_thread_error;
+
static Lisp_Object
-do_nothing (Lisp_Object whatever)
+record_thread_error (Lisp_Object error_form)
{
- return whatever;
+ last_thread_error = error_form;
+ return error_form;
}
static void *
@@ -695,7 +705,7 @@ run_thread (void *state)
handlerlist_sentinel->next = NULL;
/* It might be nice to do something with errors here. */
- internal_condition_case (invoke_thread_function, Qt, do_nothing);
+ internal_condition_case (invoke_thread_function, Qt, record_thread_error);
update_processes_for_thread_death (Fcurrent_thread ());
@@ -944,6 +954,13 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
return result;
}
+DEFUN ("thread-last-error", Fthread_last_error, Sthread_last_error, 0, 0, 0,
+ doc: /* Return the last error form recorded by a dying thread. */)
+ (void)
+{
+ return last_thread_error;
+}
+
bool
@@ -1028,6 +1045,10 @@ syms_of_threads (void)
defsubr (&Scondition_notify);
defsubr (&Scondition_mutex);
defsubr (&Scondition_name);
+ defsubr (&Sthread_last_error);
+
+ staticpro (&last_thread_error);
+ last_thread_error = Qnil;
}
DEFSYM (Qthreadp, "threadp");
diff --git a/src/w32fns.c b/src/w32fns.c
index c24fce1..6a576fc 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -778,7 +778,7 @@ w32_color_map_lookup (const char *colorname)
break;
}
- QUIT;
+ maybe_quit ();
}
unblock_input ();
@@ -3166,7 +3166,7 @@ signal_user_input (void)
if (!NILP (Vthrow_on_input))
{
Vquit_flag = Vthrow_on_input;
- /* Doing a QUIT from this thread is a bad idea, since this
+ /* Calling maybe_quit from this thread is a bad idea, since this
unwinds the stack of the Lisp thread, and the Windows runtime
rightfully barfs. Disabled. */
#if 0
@@ -3174,8 +3174,8 @@ signal_user_input (void)
do it now. */
if (immediate_quit && NILP (Vinhibit_quit))
{
- immediate_quit = 0;
- QUIT;
+ immediate_quit = false;
+ maybe_quit ();
}
#endif
}
diff --git a/src/w32notify.c b/src/w32notify.c
index 1f4cbe2..2520581 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -664,7 +664,7 @@ w32_get_watch_object (void *desc)
Lisp_Object descriptor = make_pointer_integer (desc);
/* This is called from the input queue handling code, inside a
- critical section, so we cannot possibly QUIT if watch_list is not
+ critical section, so we cannot possibly quit if watch_list is not
in the right condition. */
return NILP (watch_list) ? Qnil : assoc_no_quit (descriptor, watch_list);
}
diff --git a/src/w32proc.c b/src/w32proc.c
index a7f2b4a..0aa248a 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -1449,7 +1449,7 @@ waitpid (pid_t pid, int *status, int options)
do
{
- QUIT;
+ maybe_quit ();
active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
} while (active == WAIT_TIMEOUT && !dont_wait);
diff --git a/src/window.c b/src/window.c
index 0a6b94d..71a82b5 100644
--- a/src/window.c
+++ b/src/window.c
@@ -521,9 +521,10 @@ select_window (Lisp_Object window, Lisp_Object norecord,
bset_last_selected_window (XBUFFER (w->contents), window);
record_and_return:
- /* record_buffer can run QUIT, so make sure it is run only after we have
- re-established the invariant between selected_window and selected_frame,
- otherwise the temporary broken invariant might "escape" (bug#14161). */
+ /* record_buffer can call maybe_quit, so make sure it is run only
+ after we have re-established the invariant between
+ selected_window and selected_frame, otherwise the temporary
+ broken invariant might "escape" (Bug#14161). */
if (NILP (norecord))
{
w->use_time = ++window_select_count;
diff --git a/src/xdisp.c b/src/xdisp.c
index 168922e..33661c8 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -22635,7 +22635,7 @@ move_elt_to_front (Lisp_Object elt, Lisp_Object list)
else
prev = tail;
tail = XCDR (tail);
- QUIT;
+ maybe_quit ();
}
/* Not found--return unchanged LIST. */
diff --git a/src/xselect.c b/src/xselect.c
index 47ccf68..2249828 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -329,7 +329,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object
selection_value,
Fcons (selection_data, dpyinfo->terminal->Vselection_alist));
/* If we already owned the selection, remove the old selection
- data. Don't use Fdelq as that may QUIT. */
+ data. Don't use Fdelq as that may quit. */
if (!NILP (prev_value))
{
/* We know it's not the CAR, so it's easy. */
@@ -929,7 +929,7 @@ x_handle_selection_clear (struct selection_input_event
*event)
&& local_selection_time > changed_owner_time)
return;
- /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
+ /* Otherwise, really clear. Don't use Fdelq as that may quit. */
Vselection_alist = dpyinfo->terminal->Vselection_alist;
if (EQ (local_selection_data, CAR (Vselection_alist)))
Vselection_alist = XCDR (Vselection_alist);
diff --git a/src/xterm.c b/src/xterm.c
index adc02e2..38229a5 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -635,7 +635,7 @@ x_cr_export_frames (Lisp_Object frames,
cairo_surface_type_t surface_type)
(*surface_set_size_func) (surface, width, height);
unblock_input ();
- QUIT;
+ maybe_quit ();
block_input ();
}
@@ -10993,19 +10993,12 @@ xembed_send_message (struct frame *f, Time t, enum
xembed_message msg,
/* Change of visibility. */
-/* This tries to wait until the frame is really visible.
- However, if the window manager asks the user where to position
- the frame, this will return before the user finishes doing that.
- The frame will not actually be visible at that time,
- but it will become visible later when the window manager
- finishes with it. */
+/* This function sends the request to make the frame visible, but may
+ return before it the frame's visibility is changed. */
void
x_make_frame_visible (struct frame *f)
{
- int original_top, original_left;
- int tries = 0;
-
block_input ();
x_set_bitmap_icon (f);
@@ -11052,16 +11045,13 @@ x_make_frame_visible (struct frame *f)
before we do anything else. We do this loop with input not blocked
so that incoming events are handled. */
{
- Lisp_Object frame;
/* This must be before UNBLOCK_INPUT
since events that arrive in response to the actions above
will set it when they are handled. */
bool previously_visible = f->output_data.x->has_been_visible;
- XSETFRAME (frame, f);
-
- original_left = f->left_pos;
- original_top = f->top_pos;
+ int original_left = f->left_pos;
+ int original_top = f->top_pos;
/* This must come after we set COUNT. */
unblock_input ();
@@ -11105,46 +11095,6 @@ x_make_frame_visible (struct frame *f)
unblock_input ();
}
-
- /* Process X events until a MapNotify event has been seen. */
- while (!FRAME_VISIBLE_P (f))
- {
- /* Force processing of queued events. */
- x_sync (f);
-
- /* If on another desktop, the deiconify/map may be ignored and the
- frame never becomes visible. XMonad does this.
- Prevent an endless loop. */
- if (FRAME_ICONIFIED_P (f) && ++tries > 100)
- break;
-
- /* This hack is still in use at least for Cygwin. See
- http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00351.html.
-
- Machines that do polling rather than SIGIO have been
- observed to go into a busy-wait here. So we'll fake an
- alarm signal to let the handler know that there's something
- to be read. We used to raise a real alarm, but it seems
- that the handler isn't always enabled here. This is
- probably a bug. */
- if (input_polling_used ())
- {
- /* It could be confusing if a real alarm arrives while
- processing the fake one. Turn it off and let the
- handler reset it. */
- int old_poll_suppress_count = poll_suppress_count;
- poll_suppress_count = 1;
- poll_for_input_1 ();
- poll_suppress_count = old_poll_suppress_count;
- }
-
- if (XPending (FRAME_X_DISPLAY (f)))
- {
- XEvent xev;
- XNextEvent (FRAME_X_DISPLAY (f), &xev);
- x_dispatch_event (&xev, FRAME_X_DISPLAY (f));
- }
- }
}
}
@@ -12927,7 +12877,7 @@ keysyms. The default is nil, which is the same as
`super'. */);
Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900),
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
- Qnil);
+ Qnil, Qnil);
DEFVAR_BOOL ("x-frame-normalize-before-maximize",
x_frame_normalize_before_maximize,
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index a454471..1ffcd6a 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -45,8 +45,7 @@
(should-not (abbrev-table-p []))
;; Missing :abbrev-table-modiff counter:
(should-not (abbrev-table-p (obarray-make)))
- (let* ((table (obarray-make)))
- (should (abbrev-table-empty-p (make-abbrev-table)))))
+ (should (abbrev-table-empty-p (make-abbrev-table))))
(ert-deftest abbrev-make-abbrev-table-test ()
;; Table without properties:
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el
b/test/lisp/emacs-lisp/cl-seq-tests.el
index 3740b5c..61e3d72 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -250,9 +250,9 @@ Body are forms defining the test."
(should (= 0 (cl-count -5 list)))
(should (= 0 (cl-count 2 list :start 2 :end 4)))
(should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x)
'foo)))))
- (should (= 4 (cl-count 'foo list :test (lambda (a b) (cl-evenp b)))))
- (should (equal (cl-count 'foo list :test (lambda (a b) (cl-oddp b)))
- (cl-count 'foo list :test-not (lambda (a b) (cl-evenp
b)))))))
+ (should (= 4 (cl-count 'foo list :test (lambda (_a b) (cl-evenp b)))))
+ (should (equal (cl-count 'foo list :test (lambda (_a b) (cl-oddp b)))
+ (cl-count 'foo list :test-not (lambda (_a b) (cl-evenp
b)))))))
;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2
:from-end
(ert-deftest cl-seq-mismatch-test ()
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el
b/test/lisp/emacs-lisp/let-alist-tests.el
index fbcde4e..d046457 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -31,7 +31,7 @@
(.test-two (cdr (assq 'test-two symbol))))
(list .test-one .test-two
.test-two .test-two)))
- (cl-letf (((symbol-function #'make-symbol) (lambda (x) 'symbol)))
+ (cl-letf (((symbol-function #'make-symbol) (lambda (_x) 'symbol)))
(macroexpand
'(let-alist data (list .test-one .test-two
.test-two .test-two))))))
@@ -51,8 +51,7 @@
(ert-deftest let-alist-cons ()
(should
(equal
- (let ((.external "ext")
- (.external.too "et"))
+ (let ((.external "ext"))
(let-alist '((test-two . 0)
(test-three . 1)
(sublist . ((foo . 2)
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index a30ba25..2b3456d 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -23,13 +23,18 @@
(require 'ert)
(require 'faces)
+(defgroup faces--test nil ""
+ :group 'faces--test)
+
(defface faces--test1
'((t :background "black" :foreground "black"))
- "")
+ ""
+ :group 'faces--test)
(defface faces--test2
'((t :box 1))
- "")
+ ""
+ :group 'faces--test)
(ert-deftest faces--test-color-at-point ()
(with-temp-buffer
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index a3fe350..827d751 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -44,7 +44,7 @@ index 3d7cebadcf..ad4b70d737 100644
str
(make-string ffap-max-region-length #xa)
(format "%s ENDS HERE" file)))
- (mark-whole-buffer)
+ (call-interactively 'mark-whole-buffer)
(should (equal "" (ffap-string-at-point)))
(should (equal '(1 1) ffap-string-at-point-region)))))
(and (file-exists-p file) (delete-file file)))))
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index d237d0c..db7f55e 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -850,6 +850,13 @@ delivered."
;; After deleting the parent directory, the descriptor must
;; not be valid anymore.
(should-not (file-notify-valid-p file-notify--test-desc))
+ ;; w32notify doesn't generate 'stopped' events when the parent
+ ;; directory is deleted, which doesn't provide a chance for
+ ;; filenotify.el to remove the descriptor from the internal
+ ;; hash table it maintains. So we must remove the descriptor
+ ;; manually.
+ (if (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
@@ -906,6 +913,8 @@ delivered."
(file-notify--test-timeout)
(not (file-notify-valid-p file-notify--test-desc)))
(should-not (file-notify-valid-p file-notify--test-desc))
+ (if (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
@@ -975,6 +984,8 @@ delivered."
(file-notify--test-read-event)
(delete-file file)))
(delete-directory file-notify--test-tmpfile)
+ (if (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
@@ -1184,6 +1195,9 @@ the file watch."
(delete-directory file-notify--test-tmpfile 'recursive))
(should-not (file-notify-valid-p file-notify--test-desc1))
(should-not (file-notify-valid-p file-notify--test-desc2))
+ (when (string-equal (file-notify--test-library) "w32notify")
+ (file-notify--rm-descriptor file-notify--test-desc1)
+ (file-notify--rm-descriptor file-notify--test-desc2))
;; The environment shall be cleaned up.
(file-notify--test-cleanup-p))
diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el
index 15eb7c1..4a1d566 100644
--- a/test/lisp/htmlfontify-tests.el
+++ b/test/lisp/htmlfontify-tests.el
@@ -30,5 +30,17 @@
(symbol-function
'htmlfontify-load-rgb-file))))
+(ert-deftest htmlfontify-bug25468 ()
+ "Tests that htmlfontify can be loaded even if no shell is
+available (Bug#25468)."
+ (should (equal (let ((process-environment
+ (cons "SHELL=/does/not/exist" process-environment)))
+ (call-process
+ (expand-file-name (invocation-name) (invocation-directory))
+ nil nil nil
+ "--quick" "--batch"
+ (concat "--load=" (locate-library "htmlfontify"))))
+ 0)))
+
(provide 'htmlfontify-tests)
;; htmlfontify-tests.el ends here
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index fb632e2..b9f7fe7 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -23,6 +23,15 @@
(eval-when-compile
(require 'ibuf-macs))
+(defvar ibuffer-filter-groups)
+(defvar ibuffer-filtering-alist)
+(defvar ibuffer-filtering-qualifiers)
+(defvar ibuffer-save-with-custom)
+(defvar ibuffer-saved-filter-groups)
+(defvar ibuffer-saved-filters)
+(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier))
+(declare-function ibuffer-unary-operand "ibuf-ext" (filter))
+
(ert-deftest ibuffer-autoload ()
"Tests to see whether ibuffer has been autoloaded"
(skip-unless (not (featurep 'ibuf-ext)))
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index efed8f8..7c5fcb4 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -28,7 +28,7 @@
(ert-deftest completion-test1 ()
(with-temp-buffer
- (cl-flet* ((test/completion-table (string pred action)
+ (cl-flet* ((test/completion-table (_string _pred action)
(if (eq action 'lambda)
nil
"test: "))
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 525709b..0a59e3b 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -22,7 +22,8 @@
(require 'ert)
(require 'dbus)
-(setq dbus-debug nil)
+(defvar dbus-debug nil)
+(declare-function dbus-get-unique-name "dbusbind.c" (bus))
(defvar dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 02e5d18..0c3068a 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1991,12 +1991,16 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(string-equal
(make-auto-save-file-name)
;; This is taken from original `make-auto-save-file-name'.
- (expand-file-name
- (format
- "#%s#"
- (subst-char-in-string
- ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
- temporary-file-directory)))))
+ ;; We call `convert-standard-filename', because on
+ ;; MS Windows the (local) colons must be replaced by
+ ;; exclamation marks.
+ (convert-standard-filename
+ (expand-file-name
+ (format
+ "#%s#"
+ (subst-char-in-string
+ ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+ temporary-file-directory))))))
;; No mapping.
(let (tramp-auto-save-directory auto-save-file-name-transforms)
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index 9bf7258..84749ef 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -59,6 +59,32 @@
* Load the inspector's shared head.js for use by tests that need to
* open the something or other"))))
+(ert-deftest js-mode-regexp-syntax ()
+ (with-temp-buffer
+ ;; Normally indentation tests are done in manual/indent, but in
+ ;; this case we are specifically testing a case where the bug
+ ;; caused the indenter not to do anything, and manual/indent can
+ ;; only be used for already-correct files.
+ (insert "function f(start, value) {
+if (start - 1 === 0 || /[ (:,='\"]/.test(value)) {
+--start;
+}
+if (start - 1 === 0 && /[ (:,='\"]/.test(value)) {
+--start;
+}
+if (!/[ (:,='\"]/.test(value)) {
+--start;
+}
+}
+")
+ (js-mode)
+ (indent-region (point-min) (point-max))
+ (goto-char (point-min))
+ (dolist (x '(0 4 8 4 4 8 4 4 8 4 0))
+ (back-to-indentation)
+ (should (= (current-column) x))
+ (forward-line))))
+
(provide 'js-tests)
;;; js-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 2df1bbf..1e6b867 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1156,6 +1156,27 @@ if do:
(python-tests-look-at "that)")
(should (= (current-indentation) 6))))
+(ert-deftest python-indent-electric-colon-4 ()
+ "Test indentation case where there is one more-indented previous open block."
+ (python-tests-with-temp-buffer
+ "
+def f():
+ if True:
+ a = 5
+
+ if True:
+ a = 10
+
+ b = 3
+
+else
+"
+ (python-tests-look-at "else")
+ (goto-char (line-end-position))
+ (python-tests-self-insert ":")
+ (python-tests-look-at "else" -1)
+ (should (= (current-indentation) 4))))
+
(ert-deftest python-indent-region-1 ()
"Test indentation case from Bug#18843."
(let ((contents "
@@ -2457,7 +2478,7 @@ if x:
(python-tests-with-temp-buffer
" \"\n"
(goto-char (point-min))
- (font-lock-fontify-buffer)))
+ (call-interactively 'font-lock-fontify-buffer)))
;;; Shell integration
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 6194cad..f4849c4 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -30,8 +30,9 @@
(insert "(a b")
(save-excursion (insert " c d)"))
,@body
- (cons (buffer-substring (point-min) (point))
- (buffer-substring (point) (point-max)))))
+ (with-no-warnings
+ (cons (buffer-substring (point-min) (point))
+ (buffer-substring (point) (point-max))))))
(defmacro simple-test--transpositions (&rest body)
@@ -266,7 +267,6 @@
(with-temp-buffer
(setq buffer-undo-list nil)
(insert "hello")
- (car buffer-undo-list)
(undo-auto--boundaries 'test))))
;;; Transposition with negative args (bug#20698, bug#21885)
diff --git a/test/lisp/textmodes/tildify-tests.el
b/test/lisp/textmodes/tildify-tests.el
index 0a82b25..f958fbc 100644
--- a/test/lisp/textmodes/tildify-tests.el
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -226,7 +226,7 @@ The function must terminate as soon as callback returns
nil."
(defun tildify-space-undo-test--test
- (modes nbsp env-open &optional set-space-string)
+ (modes nbsp _env-open &optional set-space-string)
(with-temp-buffer
(setq-local buffer-file-coding-system 'utf-8)
(dolist (mode modes)
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 0f2182a..d0da209 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -134,6 +134,21 @@ Parser is called with and without 'symbol-qnames
argument.")
(append xml-default-ns
'(("F" . "FOOBAR:"))))))))))
+;; Test bug #23440 (proper expansion of default namespace)
+; Test data for default namespace
+(defvar xml-parse-test--default-namespace-qnames
+ (cons "<something xmlns=\"myns:\"><whatever></whatever></something>"
+ '((myns:something
+ ((("http://www.w3.org/2000/xmlns/"; . "")
+ . "myns:"))
+ (myns:whatever nil)))))
+
+(ert-deftest xml-parse-test-default-namespace-qnames ()
+ (with-temp-buffer
+ (insert (car xml-parse-test--default-namespace-qnames))
+ (should (equal (cdr xml-parse-test--default-namespace-qnames)
+ (xml-parse-region nil nil nil nil 'symbol-qnames)))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index a1fe8cc..95655ea 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -47,4 +47,14 @@ Bug#24912 and Bug#24913."
(let ((byte-compile-debug t))
(should-error (eval `(byte-compile (lambda ,args)) t)))))
+
+(dolist (form '(let let*))
+ (dolist (arg '(1 "a" [a]))
+ (eval
+ `(ert-deftest ,(intern (format "eval-tests--%s--%s" form (type-of arg)))
()
+ ,(format "Check that the first argument of `%s' cannot be a %s"
+ form (type-of arg))
+ (should-error (,form ,arg) :type 'wrong-type-argument))
+ t)))
+
;;; eval-tests.el ends here
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
new file mode 100644
index 0000000..6edde0b
--- /dev/null
+++ b/test/src/syntax-tests.el
@@ -0,0 +1,85 @@
+;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 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/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest parse-partial-sexp-continue-over-comment-marker ()
+ "Continue a parse that stopped in the middle of a comment marker."
+ (with-temp-buffer
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?/ ". 124")
+ (modify-syntax-entry ?* ". 23b")
+ (set-syntax-table table))
+ (insert "/*C*/\nX")
+ (goto-char (point-min))
+ (let* ((pointC (progn (search-forward "C") (1- (point))))
+ (preC (1- pointC))
+ (pointX (progn (search-forward "X") (1- (point))))
+ (aftC (+ 2 pointC))
+ (ppsC (parse-partial-sexp (point-min) pointC))
+ (pps-preC (parse-partial-sexp (point-min) preC))
+ (pps-aftC (parse-partial-sexp (point-min) aftC))
+ (ppsX (parse-partial-sexp (point-min) pointX)))
+ ;; C should be inside comment.
+ (should (= (nth 0 ppsC) 0))
+ (should (eq (nth 4 ppsC) t))
+ (should (= (nth 8 ppsC) (- pointC 2)))
+ ;; X should not be in comment or list.
+ (should (= (nth 0 ppsX) 0))
+ (should-not (nth 4 ppsX))
+ ;; Try using OLDSTATE.
+ (should (equal (parse-partial-sexp preC pointC nil nil pps-preC)
+ ppsC))
+ (should (equal (parse-partial-sexp pointC aftC nil nil ppsC)
+ pps-aftC))
+ (should (equal (parse-partial-sexp preC aftC nil nil pps-preC)
+ pps-aftC))
+ (should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC)
+ ppsX)))))
+
+(ert-deftest parse-partial-sexp-paren-comments ()
+ "Test syntax parsing with paren comment markers.
+Specifically, where the first character of the comment marker is
+also has open paren syntax (see Bug#24870)."
+ (with-temp-buffer
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\{ "(}1nb" table)
+ (modify-syntax-entry ?\} "){4nb" table)
+ (modify-syntax-entry ?- ". 123" table)
+ (set-syntax-table table))
+ (insert "{-C-}\nX")
+ (goto-char (point-min))
+ (let* ((pointC (progn (search-forward "C") (1- (point))))
+ (pointX (progn (search-forward "X") (1- (point))))
+ (ppsC (parse-partial-sexp (point-min) pointC))
+ (ppsX (parse-partial-sexp (point-min) pointX)))
+ ;; C should be inside nestable comment, not list.
+ (should (= (nth 0 ppsC) 0))
+ (should (= (nth 4 ppsC) 1))
+ (should (= (nth 8 ppsC) (- pointC 2)))
+ ;; X should not be in comment or list.
+ (should (= (nth 0 ppsX) 0))
+ (should-not (nth 4 ppsX))
+ ;; Try using OLDSTATE.
+ (should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
+ ppsX)))))
+
+;;; syntax-tests.el ends here
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index df8222a..849b2e3 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -222,8 +222,15 @@
(ert-deftest thread-errors ()
"Test what happens when a thread signals an error."
- (should (threadp (make-thread #'call-error "call-error")))
- (should (threadp (make-thread #'thread-custom "thread-custom"))))
+ (let (th1 th2)
+ (setq th1 (make-thread #'call-error "call-error"))
+ (should (threadp th1))
+ (while (thread-alive-p th1)
+ (thread-yield))
+ (should (equal (thread-last-error)
+ '(error "Error is called")))
+ (setq th2 (make-thread #'thread-custom "thread-custom"))
+ (should (threadp th2))))
(ert-deftest thread-sticky-point ()
"Test bug #25165 with point movement in cloned buffer."
@@ -242,7 +249,8 @@
(while t (thread-yield))))))
(thread-signal thread 'error nil)
(sit-for 1)
- (should-not (thread-alive-p thread))))
+ (should-not (thread-alive-p thread))
+ (should (equal (thread-last-error) '(error)))))
(defvar threads-condvar nil)
@@ -287,6 +295,7 @@
(thread-signal new-thread 'error '("Die, die, die!"))
(sleep-for 0.1)
;; Make sure the thread died.
- (should (= (length (all-threads)) 1))))
+ (should (= (length (all-threads)) 1))
+ (should (equal (thread-last-error) '(error "Die, die, die!")))))
;;; threads.el ends here