aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNickolas Lloyd2017-02-01 22:31:55 -0500
committerNickolas Lloyd2017-02-01 22:31:55 -0500
commit9a15b5509abb49a11c97c1101ad216f4ef258368 (patch)
tree7311337d92833cb8f233eaa696a967a15a306a80
parent5d8f2548ceaa5a0b33c08a39f1d6c11071ec63aa (diff)
parent70d36dda26465b43c1a63e8e13153e070af86456 (diff)
downloademacs-9a15b5509abb49a11c97c1101ad216f4ef258368.tar.gz
emacs-9a15b5509abb49a11c97c1101ad216f4ef258368.zip
Merge branch 'master' into nick.lloyd-bytecode-jitnick.lloyd-bytecode-jit
-rw-r--r--admin/notes/multi-tty5
-rw-r--r--doc/misc/cc-mode.texi31
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/auth-source.el2
-rw-r--r--lisp/calendar/parse-time.el12
-rw-r--r--lisp/comint.el11
-rw-r--r--lisp/emacs-lisp/debug.el54
-rw-r--r--lisp/emacs-lisp/let-alist.el2
-rw-r--r--lisp/emacs-lisp/subr-x.el5
-rw-r--r--lisp/gnus/gnus-art.el7
-rw-r--r--lisp/image-dired.el8
-rw-r--r--lisp/net/tramp.el30
-rw-r--r--lisp/progmodes/cc-align.el12
-rw-r--r--lisp/progmodes/cc-engine.el101
-rw-r--r--lisp/progmodes/cc-styles.el1
-rw-r--r--lisp/progmodes/cc-vars.el2
-rw-r--r--lisp/shell.el2
-rw-r--r--lisp/vc/diff-mode.el26
-rw-r--r--src/alloc.c26
-rw-r--r--src/bytecode.c20
-rw-r--r--src/callproc.c18
-rw-r--r--src/data.c50
-rw-r--r--src/dired.c3
-rw-r--r--src/doc.c9
-rw-r--r--src/editfns.c10
-rw-r--r--src/eval.c15
-rw-r--r--src/fileio.c74
-rw-r--r--src/filelock.c7
-rw-r--r--src/fns.c99
-rw-r--r--src/indent.c13
-rw-r--r--src/keyboard.c93
-rw-r--r--src/lisp.h42
-rw-r--r--src/lread.c2
-rw-r--r--src/process.c10
-rw-r--r--src/regex.c10
-rw-r--r--src/search.c98
-rw-r--r--src/syntax.c140
-rw-r--r--src/sysdep.c129
-rw-r--r--src/w32fns.c11
-rw-r--r--src/window.c2
-rw-r--r--test/lisp/vc/diff-mode-tests.el203
41 files changed, 735 insertions, 662 deletions
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index b58180e6fab..d0096adc6d2 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1239,9 +1239,8 @@ DIARY OF CHANGES
1239 (Update: OK, it all seems so easy now (NOT). Input could be done 1239 (Update: OK, it all seems so easy now (NOT). Input could be done
1240 synchronously (with wait_reading_process_input), or asynchronously 1240 synchronously (with wait_reading_process_input), or asynchronously
1241 by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag, 1241 by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag,
1242 signals a 'quit condition (when immediate_quit), or throws to 1242 signals a 'quit condition, or throws to 'getcjmp' when Emacs was
1243 'getcjmp' when Emacs was waiting for input when the C-g event 1243 waiting for input when the C-g event arrived.)
1244 arrived.)
1245 1244
1246-- Replace wrong_kboard_jmpbuf with a special return value of 1245-- Replace wrong_kboard_jmpbuf with a special return value of
1247 read_char. It is absurd that we use setjmp/longjmp just to return 1246 read_char. It is absurd that we use setjmp/longjmp just to return
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 68a16c0ed74..14981c9c58b 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -4141,7 +4141,8 @@ Open brace of an enum or static array list. @ref{Brace List Symbols}.
4141@item brace-list-close 4141@item brace-list-close
4142Close brace of an enum or static array list. @ref{Brace List Symbols}. 4142Close brace of an enum or static array list. @ref{Brace List Symbols}.
4143@item brace-list-intro 4143@item brace-list-intro
4144First line in an enum or static array list. @ref{Brace List Symbols}. 4144First line after the opening @samp{@{} in an enum or static array
4145list. @ref{Brace List Symbols}.
4145@item brace-list-entry 4146@item brace-list-entry
4146Subsequent lines in an enum or static array list. @ref{Brace List 4147Subsequent lines in an enum or static array list. @ref{Brace List
4147Symbols}. 4148Symbols}.
@@ -4635,11 +4636,18 @@ example:
4635 4636
4636Here, you've already seen the analysis of lines 1, 2, 3, and 11. On 4637Here, you've already seen the analysis of lines 1, 2, 3, and 11. On
4637line 4, things get interesting; this line is assigned 4638line 4, things get interesting; this line is assigned
4638@code{brace-entry-open} syntactic symbol because it's a bracelist entry 4639@code{brace-entry-open} syntactic symbol because it's a bracelist
4639line that starts with an open brace. Lines 5 and 6 (and line 9) are 4640entry line that starts with an open brace. Lines 5 and 6 are pretty
4640pretty standard, and line 7 is a @code{brace-list-close} as you'd 4641standard, and line 7 is a @code{brace-list-close} as you'd expect.
4641expect. Once again, line 8 is assigned as @code{brace-entry-open} as is 4642Once again, line 8 is assigned as @code{brace-entry-open} as is line
4642line 10. 464310. Line 9 is assigned two syntactic elements, @code{brace-list-intro}
4644with anchor point at the @samp{@{} of line 8@footnote{This extra
4645syntactic element was introduced in @ccmode{} 5.33.1 to allow extra
4646flexibility in indenting the second line of such a construct. You can
4647preserve the behaviour resulting from the former syntactic analysis by
4648giving @code{brace-list-entry} an offset of
4649@code{c-lineup-under-anchor} (@pxref{Misc Line-Up}).}, and
4650@code{brace-list-entry} anchored on the @samp{1} of line 8.
4643 4651
4644@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 4652@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4645@node External Scope Symbols, Paren List Symbols, Brace List Symbols, Syntactic Symbols 4653@node External Scope Symbols, Paren List Symbols, Brace List Symbols, Syntactic Symbols
@@ -6288,6 +6296,17 @@ already has; think of it as an identity function for lineups.
6288 6296
6289@comment ------------------------------------------------------------ 6297@comment ------------------------------------------------------------
6290 6298
6299@defun c-lineup-under-anchor
6300
6301Line up a line directly underneath its anchor point. This is like
6302@samp{0}, except any previously calculated offset contributions are
6303disregarded.
6304
6305@workswith Any syntactic symbol which has an anchor point.
6306@end defun
6307
6308@comment ------------------------------------------------------------
6309
6291@defun c-lineup-cpp-define 6310@defun c-lineup-cpp-define
6292@findex lineup-cpp-define (c-) 6311@findex lineup-cpp-define (c-)
6293Line up macro continuation lines according to the indentation of the 6312Line up macro continuation lines according to the indentation of the
diff --git a/etc/NEWS b/etc/NEWS
index 18ab162bd23..86a8385ae76 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -614,7 +614,7 @@ Completion candidates for HTML classes and IDs are retrieved from open
614HTML mode buffers. 614HTML mode buffers.
615 615
616--- 616---
617*** CSS mode now binds 'C-h s' to a function that will show 617*** CSS mode now binds 'C-h S' to a function that will show
618information about a CSS construct (an at-rule, property, pseudo-class, 618information about a CSS construct (an at-rule, property, pseudo-class,
619pseudo-element, with the default being guessed from context). By 619pseudo-element, with the default being guessed from context). By
620default the information is looked up on the Mozilla Developer Network, 620default the information is looked up on the Mozilla Developer Network,
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index c26935fcc97..7402ab21d74 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -2129,7 +2129,7 @@ MODE can be \"login\" or \"password\"."
2129 (if user 2129 (if user
2130 (auth-source-search 2130 (auth-source-search
2131 :host host 2131 :host host
2132 :user "yourusername" 2132 :user user
2133 :max 1 2133 :max 1
2134 :require '(:user :secret) 2134 :require '(:user :secret)
2135 :create nil) 2135 :create nil)
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 7651c5da1f4..b781cb0eb48 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -1,4 +1,4 @@
1;;; parse-time.el --- parsing time strings 1;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc. 3;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc.
4 4
@@ -203,12 +203,9 @@ any values that are unknown are returned as nil."
203 (time-second 2digit) 203 (time-second 2digit)
204 (time-secfrac "\\(\\.[0-9]+\\)?") 204 (time-secfrac "\\(\\.[0-9]+\\)?")
205 (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?")) 205 (time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?"))
206 (time-offset (concat "Z" time-numoffset))
207 (partial-time (concat time-hour colon time-minute colon time-second 206 (partial-time (concat time-hour colon time-minute colon time-second
208 time-secfrac)) 207 time-secfrac))
209 (full-date (concat date-fullyear dash date-month dash date-mday)) 208 (full-date (concat date-fullyear dash date-month dash date-mday)))
210 (full-time (concat partial-time time-offset))
211 (date-time (concat full-date "T" full-time)))
212 (list (concat "^" full-date) 209 (list (concat "^" full-date)
213 (concat "T" partial-time) 210 (concat "T" partial-time)
214 (concat "\\(Z\\|" time-numoffset "\\)"))) 211 (concat "\\(Z\\|" time-numoffset "\\)")))
@@ -225,7 +222,7 @@ If DATE-STRING cannot be parsed, it falls back to
225 (time-re (nth 1 parse-time-iso8601-regexp)) 222 (time-re (nth 1 parse-time-iso8601-regexp))
226 (tz-re (nth 2 parse-time-iso8601-regexp)) 223 (tz-re (nth 2 parse-time-iso8601-regexp))
227 re-start 224 re-start
228 time seconds minute hour fractional-seconds 225 time seconds minute hour
229 day month year day-of-week dst tz) 226 day month year day-of-week dst tz)
230 ;; We need to populate 'time' with 227 ;; We need to populate 'time' with
231 ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) 228 ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
@@ -240,9 +237,6 @@ If DATE-STRING cannot be parsed, it falls back to
240 (setq hour (string-to-number (match-string 1 date-string)) 237 (setq hour (string-to-number (match-string 1 date-string))
241 minute (string-to-number (match-string 2 date-string)) 238 minute (string-to-number (match-string 2 date-string))
242 seconds (string-to-number (match-string 3 date-string)) 239 seconds (string-to-number (match-string 3 date-string))
243 fractional-seconds (string-to-number (or
244 (match-string 4 date-string)
245 "0"))
246 re-start (match-end 0)) 240 re-start (match-end 0))
247 (when (string-match tz-re date-string re-start) 241 (when (string-match tz-re date-string re-start)
248 (if (string= "Z" (match-string 1 date-string)) 242 (if (string= "Z" (match-string 1 date-string))
diff --git a/lisp/comint.el b/lisp/comint.el
index c82c3d09df3..830f4ca88f9 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1879,7 +1879,6 @@ Similarly for Soar, Scheme, etc."
1879 (let ((echo-len (- comint-last-input-end 1879 (let ((echo-len (- comint-last-input-end
1880 comint-last-input-start))) 1880 comint-last-input-start)))
1881 ;; Wait for all input to be echoed: 1881 ;; Wait for all input to be echoed:
1882
1883 (while (and (> (+ comint-last-input-end echo-len) 1882 (while (and (> (+ comint-last-input-end echo-len)
1884 (point-max)) 1883 (point-max))
1885 (accept-process-output proc) 1884 (accept-process-output proc)
@@ -1891,7 +1890,6 @@ Similarly for Soar, Scheme, etc."
1891 ;; (+ comint-last-input-start 1890 ;; (+ comint-last-input-start
1892 ;; (- (point-max) comint-last-input-end)) 1891 ;; (- (point-max) comint-last-input-end))
1893 nil comint-last-input-end (point-max))))) 1892 nil comint-last-input-end (point-max)))))
1894
1895 (if (and 1893 (if (and
1896 (<= (+ comint-last-input-end echo-len) 1894 (<= (+ comint-last-input-end echo-len)
1897 (point-max)) 1895 (point-max))
@@ -1903,7 +1901,6 @@ Similarly for Soar, Scheme, etc."
1903 ;; Certain parts of the text to be deleted may have 1901 ;; Certain parts of the text to be deleted may have
1904 ;; been mistaken for prompts. We have to prevent 1902 ;; been mistaken for prompts. We have to prevent
1905 ;; problems when `comint-prompt-read-only' is non-nil. 1903 ;; problems when `comint-prompt-read-only' is non-nil.
1906
1907 (let ((inhibit-read-only t)) 1904 (let ((inhibit-read-only t))
1908 (delete-region comint-last-input-end 1905 (delete-region comint-last-input-end
1909 (+ comint-last-input-end echo-len)) 1906 (+ comint-last-input-end echo-len))
@@ -1912,7 +1909,6 @@ Similarly for Soar, Scheme, etc."
1912 (goto-char comint-last-input-end) 1909 (goto-char comint-last-input-end)
1913 (comint-update-fence))))))) 1910 (comint-update-fence)))))))
1914 1911
1915
1916 ;; This used to call comint-output-filter-functions, 1912 ;; This used to call comint-output-filter-functions,
1917 ;; but that scrolled the buffer in undesirable ways. 1913 ;; but that scrolled the buffer in undesirable ways.
1918 (run-hook-with-args 'comint-output-filter-functions ""))))) 1914 (run-hook-with-args 'comint-output-filter-functions "")))))
@@ -2243,7 +2239,10 @@ the current line with any initial string matching the regexp
2243 (null (get-char-property (setq bof (field-beginning)) 'field))) 2239 (null (get-char-property (setq bof (field-beginning)) 'field)))
2244 (field-string-no-properties bof) 2240 (field-string-no-properties bof)
2245 (comint-bol) 2241 (comint-bol)
2246 (buffer-substring-no-properties (point) (line-end-position))))) 2242 (buffer-substring-no-properties (point)
2243 (if comint-use-prompt-regexp
2244 (line-end-position)
2245 (field-end))))))
2247 2246
2248(defun comint-copy-old-input () 2247(defun comint-copy-old-input ()
2249 "Insert after prompt old input at point as new input to be edited. 2248 "Insert after prompt old input at point as new input to be edited.
@@ -2670,7 +2669,7 @@ This command is like `M-.' in bash."
2670 (set-marker comint-insert-previous-argument-last-start-pos (point)) 2669 (set-marker comint-insert-previous-argument-last-start-pos (point))
2671 ;; Insert the argument. 2670 ;; Insert the argument.
2672 (let ((input-string (comint-previous-input-string 0))) 2671 (let ((input-string (comint-previous-input-string 0)))
2673 (when (string-match "[ \t\n]*&[ \t\n]*$" input-string) 2672 (when (string-match "[ \t\n]*&" input-string)
2674 ;; strip terminating '&' 2673 ;; strip terminating '&'
2675 (setq input-string (substring input-string 0 (match-beginning 0)))) 2674 (setq input-string (substring input-string 0 (match-beginning 0))))
2676 (insert (comint-arguments input-string index index))) 2675 (insert (comint-arguments input-string index index)))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index faa323f733a..cb77148c285 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -816,60 +816,6 @@ Redefining FUNCTION also cancels it."
816 '((depth . -100))) 816 '((depth . -100)))
817 function) 817 function)
818 818
819;;;###autoload
820;; (defun debug-on-set (symbol)
821;; "Request FUNCTION to invoke debugger each time it is called.
822
823;; When called interactively, prompt for FUNCTION in the minibuffer.
824
825;; This works by modifying the definition of FUNCTION. If you tell the
826;; debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a
827;; normal function or a macro written in Lisp, you can also step through
828;; its execution. FUNCTION can also be a primitive that is not a special
829;; form, in which case stepping is not possible. Break-on-entry for
830;; primitive functions only works when that function is called from Lisp.
831
832;; Use \\[cancel-debug-on-entry] to cancel the effect of this command.
833;; Redefining FUNCTION also cancels it."
834;; (interactive
835;; (let ((v (variable-at-point))
836;; (enable-recursive-minibuffers t)
837;; (orig-buffer (current-buffer))
838;; val)
839;; (setq val (completing-read
840;; (if (symbolp v)
841;; (format
842;; "Debug on set to symbol (default %s): " v)
843;; "Debug on set to symbol: ")
844;; #'help--symbol-completion-table
845;; (lambda (vv)
846;; ;; In case the variable only exists in the buffer
847;; ;; the command we switch back to that buffer before
848;; ;; we examine the variable.
849;; (with-current-buffer orig-buffer
850;; (or (get vv 'variable-documentation)
851;; (and (boundp vv) (not (keywordp vv))))))
852;; t nil nil
853;; (if (symbolp v) (symbol-name v))))
854;; (list (if (equal val "")
855;; v (intern val)))))
856
857
858
859;; (interactive
860;; (let* ((var-default (variable-at-point))
861;; (var (completing-read
862;; (if var-default
863;; (format "Debug on set to symbol (default %s): " var-default)
864;; "Debug on set to symbol: ")
865;; nil
866;; #'boundp
867;; t nil nil (symbol-name var-default))))
868;; (list (if (equal var "") var-default (intern var)))))
869;; (advice-add function :before #'debug--implement-debug-on-entry
870;; '((depth . -100)))
871;; function)
872
873(defun debug--function-list () 819(defun debug--function-list ()
874 "List of functions currently set for debug on entry." 820 "List of functions currently set for debug on entry."
875 (let ((funs '())) 821 (let ((funs '()))
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index a45fc0a05c3..cf82fe3ec63 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Artur Malabarba <emacs@endlessparentheses.com> 5;; Author: Artur Malabarba <emacs@endlessparentheses.com>
6;; Package-Requires: ((emacs "24.1")) 6;; Package-Requires: ((emacs "24.1"))
7;; Version: 1.0.4 7;; Version: 1.0.5
8;; Keywords: extensions lisp 8;; Keywords: extensions lisp
9;; Prefix: let-alist 9;; Prefix: let-alist
10;; Separator: - 10;; Separator: -
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 7736225b5fa..52331b9ad36 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -214,6 +214,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses,
214perform the requested window recentering or scrolling and ask 214perform the requested window recentering or scrolling and ask
215again. 215again.
216 216
217When `use-dialog-box' is t (the default), this function can pop
218up a dialog window to collect the user input. That functionality
219requires `display-popup-menus-p' to return t. Otherwise, a text
220dialog will be used.
221
217The return value is the matching entry from the CHOICES list. 222The return value is the matching entry from the CHOICES list.
218 223
219Usage example: 224Usage example:
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 43e1231914c..a4ff840f755 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1713,9 +1713,10 @@ regexp."
1713 ;; (modify-syntax-entry ?- "w" table) 1713 ;; (modify-syntax-entry ?- "w" table)
1714 (modify-syntax-entry ?> ")<" table) 1714 (modify-syntax-entry ?> ")<" table)
1715 (modify-syntax-entry ?< "(>" table) 1715 (modify-syntax-entry ?< "(>" table)
1716 ;; make M-. in article buffers work for `foo' strings 1716 ;; make M-. in article buffers work for `foo' strings,
1717 (modify-syntax-entry ?' " " table) 1717 ;; and still allow C-s C-w to yank ' to the search ring
1718 (modify-syntax-entry ?` " " table) 1718 (modify-syntax-entry ?' "'" table)
1719 (modify-syntax-entry ?` "'" table)
1719 table) 1720 table)
1720 "Syntax table used in article mode buffers. 1721 "Syntax table used in article mode buffers.
1721Initialized from `text-mode-syntax-table'.") 1722Initialized from `text-mode-syntax-table'.")
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 901225fa2e9..2a4064560a7 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -94,6 +94,7 @@
94;; * WARNING: The "database" format used might be changed so keep a 94;; * WARNING: The "database" format used might be changed so keep a
95;; backup of `image-dired-db-file' when testing new versions. 95;; backup of `image-dired-db-file' when testing new versions.
96;; 96;;
97;; * `image-dired-display-image-mode' does not support animation
97;; 98;;
98;; TODO 99;; TODO
99;; ==== 100;; ====
@@ -228,7 +229,7 @@ Used together with `image-dired-cmd-create-thumbnail-options'."
228 :group 'image-dired) 229 :group 'image-dired)
229 230
230(defcustom image-dired-cmd-create-thumbnail-options 231(defcustom image-dired-cmd-create-thumbnail-options
231 '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") 232 '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
232 "Options of command used to create thumbnail image. 233 "Options of command used to create thumbnail image.
233Used with `image-dired-cmd-create-thumbnail-program'. 234Used with `image-dired-cmd-create-thumbnail-program'.
234Available format specifiers are: %w which is replaced by 235Available format specifiers are: %w which is replaced by
@@ -246,7 +247,7 @@ Used together with `image-dired-cmd-create-temp-image-options'."
246 :group 'image-dired) 247 :group 'image-dired)
247 248
248(defcustom image-dired-cmd-create-temp-image-options 249(defcustom image-dired-cmd-create-temp-image-options
249 '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") 250 '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
250 "Options of command used to create temporary image for display window. 251 "Options of command used to create temporary image for display window.
251Used together with `image-dired-cmd-create-temp-image-program', 252Used together with `image-dired-cmd-create-temp-image-program',
252Available format specifiers are: %w and %h which are replaced by 253Available format specifiers are: %w and %h which are replaced by
@@ -316,7 +317,7 @@ Available format specifiers are described in
316 :group 'image-dired) 317 :group 'image-dired)
317 318
318(defcustom image-dired-cmd-create-standard-thumbnail-options 319(defcustom image-dired-cmd-create-standard-thumbnail-options
319 (append '("-size" "%wx%h" "%f") 320 (append '("-size" "%wx%h" "%f[0]")
320 (unless (or image-dired-cmd-pngcrush-program 321 (unless (or image-dired-cmd-pngcrush-program
321 image-dired-cmd-pngnq-program) 322 image-dired-cmd-pngnq-program)
322 (list 323 (list
@@ -1626,6 +1627,7 @@ Resized or in full-size."
1626 :group 'image-dired 1627 :group 'image-dired
1627 (buffer-disable-undo) 1628 (buffer-disable-undo)
1628 (image-mode-setup-winprops) 1629 (image-mode-setup-winprops)
1630 (setq cursor-type nil)
1629 (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) 1631 (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t))
1630 1632
1631(defvar image-dired-minor-mode-map 1633(defvar image-dired-minor-mode-map
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index fc7fdd30850..48dcd5edd11 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3614,18 +3614,36 @@ connection buffer."
3614 3614
3615;;; Utility functions: 3615;;; Utility functions:
3616 3616
3617(defun tramp-accept-process-output (&optional proc timeout timeout-msecs) 3617(defun tramp-accept-process-output (proc timeout)
3618 "Like `accept-process-output' for Tramp processes. 3618 "Like `accept-process-output' for Tramp processes.
3619This is needed in order to hide `last-coding-system-used', which is set 3619This is needed in order to hide `last-coding-system-used', which is set
3620for process communication also." 3620for process communication also."
3621 ;; FIXME: There are problems, when an asynchronous process runs in
3622 ;; parallel, and also timers are active. See
3623 ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>.
3624 (when (and timer-event-last
3625 (string-prefix-p "*tramp/" (process-name proc))
3626 (let (result)
3627 (maphash
3628 (lambda (key _value)
3629 (and (processp key)
3630 (not (string-prefix-p "*tramp/" (process-name key)))
3631 (tramp-compat-process-live-p key)
3632 (setq result t)))
3633 tramp-cache-data)
3634 result))
3635 (sit-for 0.01 'nodisp))
3621 (with-current-buffer (process-buffer proc) 3636 (with-current-buffer (process-buffer proc)
3622 (let (buffer-read-only last-coding-system-used) 3637 (let (buffer-read-only last-coding-system-used)
3623 ;; Under Windows XP, accept-process-output doesn't return 3638 ;; Under Windows XP, accept-process-output doesn't return
3624 ;; sometimes. So we add an additional timeout. 3639 ;; sometimes. So we add an additional timeout. JUST-THIS-ONE
3625 (with-timeout ((or timeout 1)) 3640 ;; is set due to Bug#12145.
3626 (accept-process-output proc timeout timeout-msecs (and proc t))) 3641 (tramp-message
3627 (tramp-message proc 10 "%s %s\n%s" 3642 proc 10 "%s %s %s\n%s"
3628 proc (process-status proc) (buffer-string))))) 3643 proc (process-status proc)
3644 (with-timeout (timeout)
3645 (accept-process-output proc timeout nil t))
3646 (buffer-string)))))
3629 3647
3630(defun tramp-check-for-regexp (proc regexp) 3648(defun tramp-check-for-regexp (proc regexp)
3631 "Check, whether REGEXP is contained in process buffer of PROC. 3649 "Check, whether REGEXP is contained in process buffer of PROC.
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 7cb36c4396b..0f7e4b598dc 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1221,6 +1221,18 @@ Works with: arglist-cont, arglist-cont-nonempty."
1221 1221
1222 (vector (progn (goto-char alignto) (current-column))))))) 1222 (vector (progn (goto-char alignto) (current-column)))))))
1223 1223
1224(defun c-lineup-under-anchor (langelem)
1225 "Line up the current line directly under the anchor position in LANGELEM.
1226
1227This is like 0, except it supersedes any indentation already calculated for
1228previous syntactic elements in the syntactic context.
1229
1230Works with: Any syntactic symbol which has an anchor position."
1231 (save-excursion
1232 (goto-char (c-langelem-pos langelem))
1233 (vector (current-column))))
1234
1235
1224(defun c-lineup-dont-change (langelem) 1236(defun c-lineup-dont-change (langelem)
1225 "Do not change the indentation of the current line. 1237 "Do not change the indentation of the current line.
1226 1238
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index fd7aa50840f..dfd7aebd569 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -10260,13 +10260,22 @@ comment at the start of cc-engine.el for more info."
10260 (t nil))))) 10260 (t nil)))))
10261 10261
10262 (setq pos (point)) 10262 (setq pos (point))
10263 (if (and after-type-id-pos 10263 (cond
10264 (goto-char after-type-id-pos) 10264 ((and after-type-id-pos
10265 (setq res (c-back-over-member-initializers)) 10265 (goto-char after-type-id-pos)
10266 (goto-char res) 10266 (setq res (c-back-over-member-initializers))
10267 (eq (car (c-beginning-of-decl-1 lim)) 'same)) 10267 (goto-char res)
10268 (cons (point) nil) ; Return value. 10268 (eq (car (c-beginning-of-decl-1 lim)) 'same))
10269 10269 (cons (point) nil)) ; Return value.
10270
10271 ((and after-type-id-pos
10272 (progn
10273 (c-backward-syntactic-ws)
10274 (eq (char-before) ?\()))
10275 ;; Single identifier between '(' and '{'. We have a bracelist.
10276 (cons after-type-id-pos nil))
10277
10278 (t
10270 (goto-char pos) 10279 (goto-char pos)
10271 ;; Checks to do on all sexps before the brace, up to the 10280 ;; Checks to do on all sexps before the brace, up to the
10272 ;; beginning of the statement. 10281 ;; beginning of the statement.
@@ -10368,7 +10377,7 @@ comment at the start of cc-engine.el for more info."
10368 ; languages where 10377 ; languages where
10369 ; `c-opt-inexpr-brace-list-key' is 10378 ; `c-opt-inexpr-brace-list-key' is
10370 ; non-nil and we have macros. 10379 ; non-nil and we have macros.
10371 (t t))) ;; The caller can go up one level. 10380 (t t)))) ;; The caller can go up one level.
10372 ))) 10381 )))
10373 10382
10374(defun c-inside-bracelist-p (containing-sexp paren-state) 10383(defun c-inside-bracelist-p (containing-sexp paren-state)
@@ -10493,6 +10502,30 @@ comment at the start of cc-engine.el for more info."
10493 (c-at-statement-start-p)) 10502 (c-at-statement-start-p))
10494(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1") 10503(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1")
10495 10504
10505(defun c-looking-at-statement-block ()
10506 ;; Point is at an opening brace. If this is a statement block (i.e. the
10507 ;; elements in it are terminated by semicolons) return t. Otherwise, return
10508 ;; nil.
10509 (let ((here (point)))
10510 (prog1
10511 (if (c-go-list-forward)
10512 (let ((there (point)))
10513 (backward-char)
10514 (c-syntactic-skip-backward
10515 "^;," here t)
10516 (cond
10517 ((eq (char-before) ?\;) t)
10518 ((eq (char-before) ?,) nil)
10519 (t (goto-char here)
10520 (forward-char)
10521 (and (c-syntactic-re-search-forward "{" there t t)
10522 (progn (backward-char)
10523 (c-looking-at-statement-block))))))
10524 (forward-char)
10525 (and (c-syntactic-re-search-forward "[;,]" nil t t)
10526 (eq (char-before) ?\;)))
10527 (goto-char here))))
10528
10496(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) 10529(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end)
10497 ;; Return non-nil if we're looking at the beginning of a block 10530 ;; Return non-nil if we're looking at the beginning of a block
10498 ;; inside an expression. The value returned is actually a cons of 10531 ;; inside an expression. The value returned is actually a cons of
@@ -10648,15 +10681,7 @@ comment at the start of cc-engine.el for more info."
10648 (and (c-major-mode-is 'c++-mode) 10681 (and (c-major-mode-is 'c++-mode)
10649 (save-excursion 10682 (save-excursion
10650 (goto-char block-follows) 10683 (goto-char block-follows)
10651 (if (c-go-list-forward) 10684 (not (c-looking-at-statement-block)))))
10652 (progn
10653 (backward-char)
10654 (c-syntactic-skip-backward
10655 "^;," block-follows t)
10656 (not (eq (char-before) ?\;)))
10657 (or (not (c-syntactic-re-search-forward
10658 "[;,]" nil t t))
10659 (not (eq (char-before) ?\;)))))))
10660 nil 10685 nil
10661 (cons 'inexpr-statement (point))))) 10686 (cons 'inexpr-statement (point)))))
10662 10687
@@ -10792,17 +10817,20 @@ comment at the start of cc-engine.el for more info."
10792 syntax-extra-args 10817 syntax-extra-args
10793 stop-at-boi-only 10818 stop-at-boi-only
10794 containing-sexp 10819 containing-sexp
10795 paren-state) 10820 paren-state
10821 &optional fixed-anchor)
10796 ;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as 10822 ;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as
10797 ;; needed with further syntax elements of the types `substatement', 10823 ;; needed with further syntax elements of the types `substatement',
10798 ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', and 10824 ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro',
10799 ;; `defun-block-intro'. 10825 ;; `defun-block-intro', and `brace-list-intro'.
10800 ;; 10826 ;;
10801 ;; Do the generic processing to anchor the given syntax symbol on 10827 ;; Do the generic processing to anchor the given syntax symbol on the
10802 ;; the preceding statement: Skip over any labels and containing 10828 ;; preceding statement: First skip over any labels and containing statements
10803 ;; statements on the same line, and then search backward until we 10829 ;; on the same line. If FIXED-ANCHOR is non-nil, use this as the
10804 ;; find a statement or block start that begins at boi without a 10830 ;; anchor-point for the given syntactic symbol, and don't make syntactic
10805 ;; label or comment. 10831 ;; entries for constructs beginning on lines before that containing
10832 ;; ANCHOR-POINT. Otherwise search backward until we find a statement or
10833 ;; block start that begins at boi without a label or comment.
10806 ;; 10834 ;;
10807 ;; Point is assumed to be at the prospective anchor point for the 10835 ;; Point is assumed to be at the prospective anchor point for the
10808 ;; given SYNTAX-SYMBOL. More syntax entries are added if we need to 10836 ;; given SYNTAX-SYMBOL. More syntax entries are added if we need to
@@ -10831,6 +10859,7 @@ comment at the start of cc-engine.el for more info."
10831 10859
10832 (let ((syntax-last c-syntactic-context) 10860 (let ((syntax-last c-syntactic-context)
10833 (boi (c-point 'boi)) 10861 (boi (c-point 'boi))
10862 (anchor-boi (c-point 'boi))
10834 ;; Set when we're on a label, so that we don't stop there. 10863 ;; Set when we're on a label, so that we don't stop there.
10835 ;; FIXME: To be complete we should check if we're on a label 10864 ;; FIXME: To be complete we should check if we're on a label
10836 ;; now at the start. 10865 ;; now at the start.
@@ -10908,7 +10937,9 @@ comment at the start of cc-engine.el for more info."
10908 (c-add-syntax 'substatement nil)))) 10937 (c-add-syntax 'substatement nil))))
10909 ))) 10938 )))
10910 10939
10911 containing-sexp) 10940 containing-sexp
10941 (or (null fixed-anchor)
10942 (> containing-sexp anchor-boi)))
10912 10943
10913 ;; Now we have to go out of this block. 10944 ;; Now we have to go out of this block.
10914 (goto-char containing-sexp) 10945 (goto-char containing-sexp)
@@ -10982,6 +11013,14 @@ comment at the start of cc-engine.el for more info."
10982 (cdr (assoc (match-string 1) 11013 (cdr (assoc (match-string 1)
10983 c-other-decl-block-key-in-symbols-alist)) 11014 c-other-decl-block-key-in-symbols-alist))
10984 (max (c-point 'boi paren-pos) (point)))) 11015 (max (c-point 'boi paren-pos) (point))))
11016 ((save-excursion
11017 (goto-char paren-pos)
11018 (c-looking-at-or-maybe-in-bracelist containing-sexp))
11019 (if (save-excursion
11020 (goto-char paren-pos)
11021 (c-looking-at-statement-block))
11022 (c-add-syntax 'defun-block-intro nil)
11023 (c-add-syntax 'brace-list-intro nil)))
10985 (t (c-add-syntax 'defun-block-intro nil)))) 11024 (t (c-add-syntax 'defun-block-intro nil))))
10986 11025
10987 (c-add-syntax 'statement-block-intro nil))) 11026 (c-add-syntax 'statement-block-intro nil)))
@@ -11001,7 +11040,10 @@ comment at the start of cc-engine.el for more info."
11001 (setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty nil 28)] 11040 (setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty nil 28)]
11002 (while q 11041 (while q
11003 (unless (car q) 11042 (unless (car q)
11004 (setcar q (point))) 11043 (setcar q (if (or (cdr p)
11044 (null fixed-anchor))
11045 (point)
11046 fixed-anchor)))
11005 (setq q (cdr q))) 11047 (setq q (cdr q)))
11006 (setq p (cdr p)))) 11048 (setq p (cdr p))))
11007 ))) 11049 )))
@@ -12354,7 +12396,8 @@ comment at the start of cc-engine.el for more info."
12354 (c-forward-syntactic-ws (c-point 'eol)) 12396 (c-forward-syntactic-ws (c-point 'eol))
12355 (c-looking-at-special-brace-list (point))))) 12397 (c-looking-at-special-brace-list (point)))))
12356 (c-add-syntax 'brace-entry-open (point)) 12398 (c-add-syntax 'brace-entry-open (point))
12357 (c-add-syntax 'brace-list-entry (point)) 12399 (c-add-stmt-syntax 'brace-list-entry nil t containing-sexp
12400 paren-state (point))
12358 )) 12401 ))
12359 )))) 12402 ))))
12360 12403
@@ -12848,7 +12891,7 @@ Cannot combine absolute offsets %S and %S in `add' method"
12848 ;; 12891 ;;
12849 ;; Note that topmost-intro always has an anchor position at bol, for 12892 ;; Note that topmost-intro always has an anchor position at bol, for
12850 ;; historical reasons. It's often used together with other symbols 12893 ;; historical reasons. It's often used together with other symbols
12851 ;; that has more sane positions. Since we always use the first 12894 ;; that have more sane positions. Since we always use the first
12852 ;; found anchor position, we rely on that these other symbols always 12895 ;; found anchor position, we rely on that these other symbols always
12853 ;; precede topmost-intro in the LANGELEMS list. 12896 ;; precede topmost-intro in the LANGELEMS list.
12854 ;; 12897 ;;
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index d3505490505..b3848a74f97 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -67,6 +67,7 @@
67 (arglist-close . c-lineup-arglist) 67 (arglist-close . c-lineup-arglist)
68 (inline-open . 0) 68 (inline-open . 0)
69 (brace-list-open . +) 69 (brace-list-open . +)
70 (brace-list-intro . c-lineup-arglist-intro-after-paren)
70 (topmost-intro-cont 71 (topmost-intro-cont
71 . (first c-lineup-topmost-intro-cont 72 . (first c-lineup-topmost-intro-cont
72 c-lineup-gnu-DEFUN-intro-cont)))) 73 c-lineup-gnu-DEFUN-intro-cont))))
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index a6a96d15188..1114b21381d 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1115,7 +1115,7 @@ can always override the use of `c-default-style' by making calls to
1115 ;; Anchor pos: At the brace list decl start(*). 1115 ;; Anchor pos: At the brace list decl start(*).
1116 (brace-list-intro . +) 1116 (brace-list-intro . +)
1117 ;; Anchor pos: At the brace list decl start(*). 1117 ;; Anchor pos: At the brace list decl start(*).
1118 (brace-list-entry . 0) 1118 (brace-list-entry . c-lineup-under-anchor)
1119 ;; Anchor pos: At the first non-ws char after the open paren if 1119 ;; Anchor pos: At the first non-ws char after the open paren if
1120 ;; the first token is on the same line, otherwise boi at that 1120 ;; the first token is on the same line, otherwise boi at that
1121 ;; token. 1121 ;; token.
diff --git a/lisp/shell.el b/lisp/shell.el
index c7ba64ecf4e..c8a8555d632 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1000,8 +1000,6 @@ command again."
1000 (let ((pt (point)) 1000 (let ((pt (point))
1001 (regexp 1001 (regexp
1002 (concat 1002 (concat
1003 ;; comint-process-echoes is the thing that breaks the
1004 ;; throbber
1005 (if comint-process-echoes 1003 (if comint-process-echoes
1006 ;; Skip command echo if the process echoes 1004 ;; Skip command echo if the process echoes
1007 (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)") 1005 (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)")
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index e609ca9f943..7ffa115bde4 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -437,6 +437,9 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
437(defconst diff-hunk-header-re 437(defconst diff-hunk-header-re
438 (concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")) 438 (concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$"))
439(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* \n]\\).+\n" (substring diff-hunk-header-re 1))) 439(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* \n]\\).+\n" (substring diff-hunk-header-re 1)))
440
441(defconst diff-separator-re "^--+ ?$")
442
440(defvar diff-narrowed-to nil) 443(defvar diff-narrowed-to nil)
441 444
442(defun diff-hunk-style (&optional style) 445(defun diff-hunk-style (&optional style)
@@ -1537,15 +1540,20 @@ Only works for unified diffs."
1537 (pcase (char-after) 1540 (pcase (char-after)
1538 (?\s (cl-decf before) (cl-decf after) t) 1541 (?\s (cl-decf before) (cl-decf after) t)
1539 (?- 1542 (?-
1540 (if (and (looking-at diff-file-header-re) 1543 (cond
1541 (zerop before) (zerop after)) 1544 ((and (looking-at diff-separator-re)
1542 ;; No need to query: this is a case where two patches 1545 (zerop before) (zerop after))
1543 ;; are concatenated and only counting the lines will 1546 nil)
1544 ;; give the right result. Let's just add an empty 1547 ((and (looking-at diff-file-header-re)
1545 ;; line so that our code which doesn't count lines 1548 (zerop before) (zerop after))
1546 ;; will not get confused. 1549 ;; No need to query: this is a case where two patches
1547 (progn (save-excursion (insert "\n")) nil) 1550 ;; are concatenated and only counting the lines will
1548 (cl-decf before) t)) 1551 ;; give the right result. Let's just add an empty
1552 ;; line so that our code which doesn't count lines
1553 ;; will not get confused.
1554 (save-excursion (insert "\n")) nil)
1555 (t
1556 (cl-decf before) t)))
1549 (?+ (cl-decf after) t) 1557 (?+ (cl-decf after) t)
1550 (_ 1558 (_
1551 (cond 1559 (cond
diff --git a/src/alloc.c b/src/alloc.c
index 8c9b1167fb0..a2302a6f462 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2884,7 +2884,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2884 for (EMACS_INT size = XFASTINT (length); 0 < size; size--) 2884 for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
2885 { 2885 {
2886 val = Fcons (init, val); 2886 val = Fcons (init, val);
2887 maybe_quit (); 2887 rarely_quit (size);
2888 } 2888 }
2889 2889
2890 return val; 2890 return val;
@@ -5452,7 +5452,8 @@ make_pure_vector (ptrdiff_t len)
5452/* Copy all contents and parameters of TABLE to a new table allocated 5452/* Copy all contents and parameters of TABLE to a new table allocated
5453 from pure space, return the purified table. */ 5453 from pure space, return the purified table. */
5454static struct Lisp_Hash_Table * 5454static struct Lisp_Hash_Table *
5455purecopy_hash_table (struct Lisp_Hash_Table *table) { 5455purecopy_hash_table (struct Lisp_Hash_Table *table)
5456{
5456 eassert (NILP (table->weak)); 5457 eassert (NILP (table->weak));
5457 eassert (!NILP (table->pure)); 5458 eassert (!NILP (table->pure));
5458 5459
@@ -5495,14 +5496,12 @@ Does not copy symbols. Copies strings without text properties. */)
5495 return purecopy (obj); 5496 return purecopy (obj);
5496} 5497}
5497 5498
5498struct pinned_object 5499/* Pinned objects are marked before every GC cycle. */
5500static struct pinned_object
5499{ 5501{
5500 Lisp_Object object; 5502 Lisp_Object object;
5501 struct pinned_object *next; 5503 struct pinned_object *next;
5502}; 5504} *pinned_objects;
5503
5504/* Pinned objects are marked before every GC cycle. */
5505static struct pinned_object *pinned_objects;
5506 5505
5507static Lisp_Object 5506static Lisp_Object
5508purecopy (Lisp_Object obj) 5507purecopy (Lisp_Object obj)
@@ -5534,13 +5533,13 @@ purecopy (Lisp_Object obj)
5534 else if (HASH_TABLE_P (obj)) 5533 else if (HASH_TABLE_P (obj))
5535 { 5534 {
5536 struct Lisp_Hash_Table *table = XHASH_TABLE (obj); 5535 struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
5537 /* We cannot purify hash tables which haven't been defined with 5536 /* Do not purify hash tables which haven't been defined with
5538 :purecopy as non-nil or are weak - they aren't guaranteed to 5537 :purecopy as non-nil or are weak - they aren't guaranteed to
5539 not change. */ 5538 not change. */
5540 if (!NILP (table->weak) || NILP (table->pure)) 5539 if (!NILP (table->weak) || NILP (table->pure))
5541 { 5540 {
5542 /* Instead, the hash table is added to the list of pinned objects, 5541 /* Instead, add the hash table to the list of pinned objects,
5543 and is marked before GC. */ 5542 so that it will be marked during GC. */
5544 struct pinned_object *o = xmalloc (sizeof *o); 5543 struct pinned_object *o = xmalloc (sizeof *o);
5545 o->object = obj; 5544 o->object = obj;
5546 o->next = pinned_objects; 5545 o->next = pinned_objects;
@@ -5770,11 +5769,8 @@ compact_undo_list (Lisp_Object list)
5770static void 5769static void
5771mark_pinned_objects (void) 5770mark_pinned_objects (void)
5772{ 5771{
5773 struct pinned_object *pobj; 5772 for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next)
5774 for (pobj = pinned_objects; pobj; pobj = pobj->next) 5773 mark_object (pobj->object);
5775 {
5776 mark_object (pobj->object);
5777 }
5778} 5774}
5779 5775
5780static void 5776static void
diff --git a/src/bytecode.c b/src/bytecode.c
index 88df30c9721..a6019f7c1a5 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -617,11 +617,11 @@ exec_byte_code__ (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
617 { 617 {
618 Lisp_Object v2 = POP, v1 = TOP; 618 Lisp_Object v2 = POP, v1 = TOP;
619 CHECK_NUMBER (v1); 619 CHECK_NUMBER (v1);
620 EMACS_INT n = XINT (v1); 620 for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
621 immediate_quit = true; 621 {
622 while (--n >= 0 && CONSP (v2)) 622 v2 = XCDR (v2);
623 v2 = XCDR (v2); 623 rarely_quit (n);
624 immediate_quit = false; 624 }
625 TOP = CAR (v2); 625 TOP = CAR (v2);
626 NEXT; 626 NEXT;
627 } 627 }
@@ -1051,11 +1051,11 @@ exec_byte_code__ (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1051 /* Exchange args and then do nth. */ 1051 /* Exchange args and then do nth. */
1052 Lisp_Object v2 = POP, v1 = TOP; 1052 Lisp_Object v2 = POP, v1 = TOP;
1053 CHECK_NUMBER (v2); 1053 CHECK_NUMBER (v2);
1054 EMACS_INT n = XINT (v2); 1054 for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
1055 immediate_quit = true; 1055 {
1056 while (--n >= 0 && CONSP (v1)) 1056 v1 = XCDR (v1);
1057 v1 = XCDR (v1); 1057 rarely_quit (n);
1058 immediate_quit = false; 1058 }
1059 TOP = CAR (v1); 1059 TOP = CAR (v1);
1060 } 1060 }
1061 else 1061 else
diff --git a/src/callproc.c b/src/callproc.c
index 301ccf383b5..84324c48dcf 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,11 @@ call_process_cleanup (Lisp_Object buffer)
198 { 198 {
199 kill (-synch_process_pid, SIGINT); 199 kill (-synch_process_pid, SIGINT);
200 message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); 200 message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
201 immediate_quit = true; 201
202 maybe_quit (); 202 /* This will quit on C-g. */
203 wait_for_termination (synch_process_pid, 0, 1); 203 wait_for_termination (synch_process_pid, 0, 1);
204
204 synch_process_pid = 0; 205 synch_process_pid = 0;
205 immediate_quit = false;
206 message1 ("Waiting for process to die...done"); 206 message1 ("Waiting for process to die...done");
207 } 207 }
208#endif /* !MSDOS */ 208#endif /* !MSDOS */
@@ -726,9 +726,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
726 process_coding.src_multibyte = 0; 726 process_coding.src_multibyte = 0;
727 } 727 }
728 728
729 immediate_quit = true;
730 maybe_quit ();
731
732 if (0 <= fd0) 729 if (0 <= fd0)
733 { 730 {
734 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 }; 731 enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
@@ -749,8 +746,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
749 nread = carryover; 746 nread = carryover;
750 while (nread < bufsize - 1024) 747 while (nread < bufsize - 1024)
751 { 748 {
752 int this_read = emacs_read (fd0, buf + nread, 749 int this_read = emacs_read_quit (fd0, buf + nread,
753 bufsize - nread); 750 bufsize - nread);
754 751
755 if (this_read < 0) 752 if (this_read < 0)
756 goto give_up; 753 goto give_up;
@@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
769 } 766 }
770 767
771 /* Now NREAD is the total amount of data in the buffer. */ 768 /* Now NREAD is the total amount of data in the buffer. */
772 immediate_quit = false;
773 769
774 if (!nread) 770 if (!nread)
775 ; 771 ;
@@ -842,8 +838,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
842 we should have already detected a coding system. */ 838 we should have already detected a coding system. */
843 display_on_the_fly = true; 839 display_on_the_fly = true;
844 } 840 }
845 immediate_quit = true;
846 maybe_quit ();
847 } 841 }
848 give_up: ; 842 give_up: ;
849 843
@@ -860,8 +854,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
860 wait_for_termination (pid, &status, fd0 < 0); 854 wait_for_termination (pid, &status, fd0 < 0);
861#endif 855#endif
862 856
863 immediate_quit = false;
864
865 /* Don't kill any children that the subprocess may have left behind 857 /* Don't kill any children that the subprocess may have left behind
866 when exiting. */ 858 when exiting. */
867 synch_process_pid = 0; 859 synch_process_pid = 0;
diff --git a/src/data.c b/src/data.c
index 098407200d5..c73f04cf638 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1304,56 +1304,6 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
1304 default: emacs_abort (); 1304 default: emacs_abort ();
1305 } 1305 }
1306 1306
1307
1308 const char* symname = SDATA(sym->name);
1309
1310 if( EQ(Vwatch_object, symbol) )
1311 {
1312 static int nest_level = 0;
1313 if(nest_level++ == 0)
1314 {
1315 switch(sym->redirect)
1316 {
1317 case SYMBOL_PLAINVAL:
1318 {
1319 AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_PLAINVAL");
1320 CALLN (Fmessage, format, SYMBOL_NAME (symbol));
1321 break;
1322 }
1323 case SYMBOL_VARALIAS:
1324 {
1325 AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_VARALIAS");
1326 CALLN (Fmessage, format, SYMBOL_NAME (symbol));
1327 break;
1328 }
1329 case SYMBOL_LOCALIZED:
1330 {
1331 AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_LOCALIZED");
1332 CALLN (Fmessage, format, SYMBOL_NAME (symbol));
1333 break;
1334 }
1335 case SYMBOL_FORWARDED:
1336 {
1337 AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_FORWARDED");
1338 CALLN (Fmessage, format, SYMBOL_NAME (symbol));
1339 break;
1340 }
1341
1342 default:
1343 {
1344 AUTO_STRING (format, "Setting symbol '%s'; redirect: UNKNOWN");
1345 CALLN (Fmessage, format, SYMBOL_NAME (symbol));
1346 break;
1347 }
1348 }
1349 }
1350 nest_level--;
1351 }
1352
1353
1354
1355
1356
1357 start: 1307 start:
1358 switch (sym->redirect) 1308 switch (sym->redirect)
1359 { 1309 {
diff --git a/src/dired.c b/src/dired.c
index 52e81fb380b..5ea00fb8db4 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -248,14 +248,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
248 248
249 /* Now that we have unwind_protect in place, we might as well 249 /* Now that we have unwind_protect in place, we might as well
250 allow matching to be interrupted. */ 250 allow matching to be interrupted. */
251 immediate_quit = true;
252 maybe_quit (); 251 maybe_quit ();
253 252
254 bool wanted = (NILP (match) 253 bool wanted = (NILP (match)
255 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0); 254 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
256 255
257 immediate_quit = false;
258
259 if (wanted) 256 if (wanted)
260 { 257 {
261 if (!NILP (full)) 258 if (!NILP (full))
diff --git a/src/doc.c b/src/doc.c
index 361d09a0878..1e7e3fcf6a6 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -186,7 +186,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
186 If we read the same block last time, maybe skip this? */ 186 If we read the same block last time, maybe skip this? */
187 if (space_left > 1024 * 8) 187 if (space_left > 1024 * 8)
188 space_left = 1024 * 8; 188 space_left = 1024 * 8;
189 nread = emacs_read (fd, p, space_left); 189 nread = emacs_read_quit (fd, p, space_left);
190 if (nread < 0) 190 if (nread < 0)
191 report_file_error ("Read error on documentation file", file); 191 report_file_error ("Read error on documentation file", file);
192 p[nread] = 0; 192 p[nread] = 0;
@@ -590,16 +590,15 @@ the same file name is found in the `doc-directory'. */)
590 Vdoc_file_name = filename; 590 Vdoc_file_name = filename;
591 filled = 0; 591 filled = 0;
592 pos = 0; 592 pos = 0;
593 while (1) 593 while (true)
594 { 594 {
595 register char *end;
596 if (filled < 512) 595 if (filled < 512)
597 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled); 596 filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled);
598 if (!filled) 597 if (!filled)
599 break; 598 break;
600 599
601 buf[filled] = 0; 600 buf[filled] = 0;
602 end = buf + (filled < 512 ? filled : filled - 128); 601 char *end = buf + (filled < 512 ? filled : filled - 128);
603 p = memchr (buf, '\037', end - buf); 602 p = memchr (buf, '\037', end - buf);
604 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */ 603 /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
605 if (p) 604 if (p)
diff --git a/src/editfns.c b/src/editfns.c
index 82c6abb9987..4618164d008 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3053,7 +3053,6 @@ determines whether case is significant or ignored. */)
3053 i2 = begp2; 3053 i2 = begp2;
3054 i1_byte = buf_charpos_to_bytepos (bp1, i1); 3054 i1_byte = buf_charpos_to_bytepos (bp1, i1);
3055 i2_byte = buf_charpos_to_bytepos (bp2, i2); 3055 i2_byte = buf_charpos_to_bytepos (bp2, i2);
3056 immediate_quit = true;
3057 3056
3058 while (i1 < endp1 && i2 < endp2) 3057 while (i1 < endp1 && i2 < endp2)
3059 { 3058 {
@@ -3092,17 +3091,14 @@ determines whether case is significant or ignored. */)
3092 c1 = char_table_translate (trt, c1); 3091 c1 = char_table_translate (trt, c1);
3093 c2 = char_table_translate (trt, c2); 3092 c2 = char_table_translate (trt, c2);
3094 } 3093 }
3094
3095 if (c1 != c2) 3095 if (c1 != c2)
3096 { 3096 return make_number (c1 < c2 ? -1 - chars : chars + 1);
3097 immediate_quit = false;
3098 return make_number (c1 < c2 ? -1 - chars : chars + 1);
3099 }
3100 3097
3101 chars++; 3098 chars++;
3099 rarely_quit (chars);
3102 } 3100 }
3103 3101
3104 immediate_quit = false;
3105
3106 /* The strings match as far as they go. 3102 /* The strings match as far as they go.
3107 If one is shorter, that one is less. */ 3103 If one is shorter, that one is less. */
3108 if (chars < endp1 - begp1) 3104 if (chars < endp1 - begp1)
diff --git a/src/eval.c b/src/eval.c
index 68b48f95a44..54a646b69e9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1131,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
1131 /* Restore certain special C variables. */ 1131 /* Restore certain special C variables. */
1132 set_poll_suppress_count (catch->poll_suppress_count); 1132 set_poll_suppress_count (catch->poll_suppress_count);
1133 unblock_input_to (catch->interrupt_input_blocked); 1133 unblock_input_to (catch->interrupt_input_blocked);
1134 immediate_quit = false;
1135 1134
1136 do 1135 do
1137 { 1136 {
@@ -1462,6 +1461,19 @@ process_quit_flag (void)
1462 quit (); 1461 quit ();
1463} 1462}
1464 1463
1464/* Check quit-flag and quit if it is non-nil. Typing C-g does not
1465 directly cause a quit; it only sets Vquit_flag. So the program
1466 needs to call maybe_quit at times when it is safe to quit. Every
1467 loop that might run for a long time or might not exit ought to call
1468 maybe_quit at least once, at a safe place. Unless that is
1469 impossible, of course. But it is very desirable to avoid creating
1470 loops where maybe_quit is impossible.
1471
1472 If quit-flag is set to `kill-emacs' the SIGINT handler has received
1473 a request to exit Emacs when it is safe to do.
1474
1475 When not quitting, process any pending signals. */
1476
1465void 1477void
1466maybe_quit (void) 1478maybe_quit (void)
1467{ 1479{
@@ -1517,7 +1529,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
1517 Lisp_Object clause = Qnil; 1529 Lisp_Object clause = Qnil;
1518 struct handler *h; 1530 struct handler *h;
1519 1531
1520 immediate_quit = false;
1521 if (gc_in_progress || waiting_for_input) 1532 if (gc_in_progress || waiting_for_input)
1522 emacs_abort (); 1533 emacs_abort ();
1523 1534
diff --git a/src/fileio.c b/src/fileio.c
index a46cfc7ac69..38400623793 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1960,9 +1960,7 @@ permissions. */)
1960 report_file_error ("Copying permissions to", newname); 1960 report_file_error ("Copying permissions to", newname);
1961 } 1961 }
1962#else /* not WINDOWSNT */ 1962#else /* not WINDOWSNT */
1963 immediate_quit = true;
1964 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0); 1963 ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
1965 immediate_quit = false;
1966 1964
1967 if (ifd < 0) 1965 if (ifd < 0)
1968 report_file_error ("Opening input file", file); 1966 report_file_error ("Opening input file", file);
@@ -2024,7 +2022,6 @@ permissions. */)
2024 oldsize = out_st.st_size; 2022 oldsize = out_st.st_size;
2025 } 2023 }
2026 2024
2027 immediate_quit = true;
2028 maybe_quit (); 2025 maybe_quit ();
2029 2026
2030 if (clone_file (ofd, ifd)) 2027 if (clone_file (ofd, ifd))
@@ -2033,9 +2030,9 @@ permissions. */)
2033 { 2030 {
2034 char buf[MAX_ALLOCA]; 2031 char buf[MAX_ALLOCA];
2035 ptrdiff_t n; 2032 ptrdiff_t n;
2036 for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf)); 2033 for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
2037 newsize += n) 2034 newsize += n)
2038 if (emacs_write_sig (ofd, buf, n) != n) 2035 if (emacs_write_quit (ofd, buf, n) != n)
2039 report_file_error ("Write error", newname); 2036 report_file_error ("Write error", newname);
2040 if (n < 0) 2037 if (n < 0)
2041 report_file_error ("Read error", file); 2038 report_file_error ("Read error", file);
@@ -2047,8 +2044,6 @@ permissions. */)
2047 if (newsize < oldsize && ftruncate (ofd, newsize) != 0) 2044 if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
2048 report_file_error ("Truncating output file", newname); 2045 report_file_error ("Truncating output file", newname);
2049 2046
2050 immediate_quit = false;
2051
2052#ifndef MSDOS 2047#ifndef MSDOS
2053 /* Preserve the original file permissions, and if requested, also its 2048 /* Preserve the original file permissions, and if requested, also its
2054 owner and group. */ 2049 owner and group. */
@@ -3401,15 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data)
3401static Lisp_Object 3396static Lisp_Object
3402read_non_regular (Lisp_Object state) 3397read_non_regular (Lisp_Object state)
3403{ 3398{
3404 int nbytes; 3399 int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
3405 3400 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3406 immediate_quit = true; 3401 + XSAVE_INTEGER (state, 1)),
3407 maybe_quit (); 3402 XSAVE_INTEGER (state, 2));
3408 nbytes = emacs_read (XSAVE_INTEGER (state, 0),
3409 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
3410 + XSAVE_INTEGER (state, 1)),
3411 XSAVE_INTEGER (state, 2));
3412 immediate_quit = false;
3413 /* Fast recycle this object for the likely next call. */ 3403 /* Fast recycle this object for the likely next call. */
3414 free_misc (state); 3404 free_misc (state);
3415 return make_number (nbytes); 3405 return make_number (nbytes);
@@ -3753,17 +3743,17 @@ by calling `format-decode', which see. */)
3753 int nread; 3743 int nread;
3754 3744
3755 if (st.st_size <= (1024 * 4)) 3745 if (st.st_size <= (1024 * 4))
3756 nread = emacs_read (fd, read_buf, 1024 * 4); 3746 nread = emacs_read_quit (fd, read_buf, 1024 * 4);
3757 else 3747 else
3758 { 3748 {
3759 nread = emacs_read (fd, read_buf, 1024); 3749 nread = emacs_read_quit (fd, read_buf, 1024);
3760 if (nread == 1024) 3750 if (nread == 1024)
3761 { 3751 {
3762 int ntail; 3752 int ntail;
3763 if (lseek (fd, - (1024 * 3), SEEK_END) < 0) 3753 if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
3764 report_file_error ("Setting file position", 3754 report_file_error ("Setting file position",
3765 orig_filename); 3755 orig_filename);
3766 ntail = emacs_read (fd, read_buf + nread, 1024 * 3); 3756 ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
3767 nread = ntail < 0 ? ntail : nread + ntail; 3757 nread = ntail < 0 ? ntail : nread + ntail;
3768 } 3758 }
3769 } 3759 }
@@ -3868,15 +3858,11 @@ by calling `format-decode', which see. */)
3868 report_file_error ("Setting file position", orig_filename); 3858 report_file_error ("Setting file position", orig_filename);
3869 } 3859 }
3870 3860
3871 immediate_quit = true;
3872 maybe_quit ();
3873 /* Count how many chars at the start of the file 3861 /* Count how many chars at the start of the file
3874 match the text at the beginning of the buffer. */ 3862 match the text at the beginning of the buffer. */
3875 while (1) 3863 while (true)
3876 { 3864 {
3877 int nread, bufpos; 3865 int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
3878
3879 nread = emacs_read (fd, read_buf, sizeof read_buf);
3880 if (nread < 0) 3866 if (nread < 0)
3881 report_file_error ("Read error", orig_filename); 3867 report_file_error ("Read error", orig_filename);
3882 else if (nread == 0) 3868 else if (nread == 0)
@@ -3898,7 +3884,7 @@ by calling `format-decode', which see. */)
3898 break; 3884 break;
3899 } 3885 }
3900 3886
3901 bufpos = 0; 3887 int bufpos = 0;
3902 while (bufpos < nread && same_at_start < ZV_BYTE 3888 while (bufpos < nread && same_at_start < ZV_BYTE
3903 && FETCH_BYTE (same_at_start) == read_buf[bufpos]) 3889 && FETCH_BYTE (same_at_start) == read_buf[bufpos])
3904 same_at_start++, bufpos++; 3890 same_at_start++, bufpos++;
@@ -3907,7 +3893,6 @@ by calling `format-decode', which see. */)
3907 if (bufpos != nread) 3893 if (bufpos != nread)
3908 break; 3894 break;
3909 } 3895 }
3910 immediate_quit = false;
3911 /* If the file matches the buffer completely, 3896 /* If the file matches the buffer completely,
3912 there's no need to replace anything. */ 3897 there's no need to replace anything. */
3913 if (same_at_start - BEGV_BYTE == end_offset - beg_offset) 3898 if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
@@ -3919,8 +3904,7 @@ by calling `format-decode', which see. */)
3919 del_range_1 (same_at_start, same_at_end, 0, 0); 3904 del_range_1 (same_at_start, same_at_end, 0, 0);
3920 goto handled; 3905 goto handled;
3921 } 3906 }
3922 immediate_quit = true; 3907
3923 maybe_quit ();
3924 /* Count how many chars at the end of the file 3908 /* Count how many chars at the end of the file
3925 match the text at the end of the buffer. But, if we have 3909 match the text at the end of the buffer. But, if we have
3926 already found that decoding is necessary, don't waste time. */ 3910 already found that decoding is necessary, don't waste time. */
@@ -3942,7 +3926,8 @@ by calling `format-decode', which see. */)
3942 total_read = nread = 0; 3926 total_read = nread = 0;
3943 while (total_read < trial) 3927 while (total_read < trial)
3944 { 3928 {
3945 nread = emacs_read (fd, read_buf + total_read, trial - total_read); 3929 nread = emacs_read_quit (fd, read_buf + total_read,
3930 trial - total_read);
3946 if (nread < 0) 3931 if (nread < 0)
3947 report_file_error ("Read error", orig_filename); 3932 report_file_error ("Read error", orig_filename);
3948 else if (nread == 0) 3933 else if (nread == 0)
@@ -3977,7 +3962,6 @@ by calling `format-decode', which see. */)
3977 if (nread == 0) 3962 if (nread == 0)
3978 break; 3963 break;
3979 } 3964 }
3980 immediate_quit = false;
3981 3965
3982 if (! giveup_match_end) 3966 if (! giveup_match_end)
3983 { 3967 {
@@ -4069,18 +4053,13 @@ by calling `format-decode', which see. */)
4069 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ 4053 inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
4070 unprocessed = 0; /* Bytes not processed in previous loop. */ 4054 unprocessed = 0; /* Bytes not processed in previous loop. */
4071 4055
4072 while (1) 4056 while (true)
4073 { 4057 {
4074 /* Read at most READ_BUF_SIZE bytes at a time, to allow 4058 /* Read at most READ_BUF_SIZE bytes at a time, to allow
4075 quitting while reading a huge file. */ 4059 quitting while reading a huge file. */
4076 4060
4077 /* Allow quitting out of the actual I/O. */ 4061 this = emacs_read_quit (fd, read_buf + unprocessed,
4078 immediate_quit = true; 4062 READ_BUF_SIZE - unprocessed);
4079 maybe_quit ();
4080 this = emacs_read (fd, read_buf + unprocessed,
4081 READ_BUF_SIZE - unprocessed);
4082 immediate_quit = false;
4083
4084 if (this <= 0) 4063 if (this <= 0)
4085 break; 4064 break;
4086 4065
@@ -4294,13 +4273,10 @@ by calling `format-decode', which see. */)
4294 /* Allow quitting out of the actual I/O. We don't make text 4273 /* Allow quitting out of the actual I/O. We don't make text
4295 part of the buffer until all the reading is done, so a C-g 4274 part of the buffer until all the reading is done, so a C-g
4296 here doesn't do any harm. */ 4275 here doesn't do any harm. */
4297 immediate_quit = true; 4276 this = emacs_read_quit (fd,
4298 maybe_quit (); 4277 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
4299 this = emacs_read (fd, 4278 + inserted),
4300 ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE 4279 trytry);
4301 + inserted),
4302 trytry);
4303 immediate_quit = false;
4304 } 4280 }
4305 4281
4306 if (this <= 0) 4282 if (this <= 0)
@@ -5002,8 +4978,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5002 } 4978 }
5003 } 4979 }
5004 4980
5005 immediate_quit = true;
5006
5007 if (STRINGP (start)) 4981 if (STRINGP (start))
5008 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding); 4982 ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
5009 else if (XINT (start) != XINT (end)) 4983 else if (XINT (start) != XINT (end))
@@ -5026,8 +5000,6 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
5026 save_errno = errno; 5000 save_errno = errno;
5027 } 5001 }
5028 5002
5029 immediate_quit = false;
5030
5031 /* fsync is not crucial for temporary files. Nor for auto-save 5003 /* fsync is not crucial for temporary files. Nor for auto-save
5032 files, since they might lose some work anyway. */ 5004 files, since they might lose some work anyway. */
5033 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) 5005 if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync)
@@ -5417,7 +5389,7 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
5417 : (STRINGP (coding->dst_object) 5389 : (STRINGP (coding->dst_object)
5418 ? SSDATA (coding->dst_object) 5390 ? SSDATA (coding->dst_object)
5419 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte))); 5391 : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
5420 coding->produced -= emacs_write_sig (desc, buf, coding->produced); 5392 coding->produced -= emacs_write_quit (desc, buf, coding->produced);
5421 5393
5422 if (coding->raw_destination) 5394 if (coding->raw_destination)
5423 { 5395 {
diff --git a/src/filelock.c b/src/filelock.c
index de65c52efa1..67e8dbd34ed 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -407,9 +407,7 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
407 fcntl (fd, F_SETFD, FD_CLOEXEC); 407 fcntl (fd, F_SETFD, FD_CLOEXEC);
408 lock_info_len = strlen (lock_info_str); 408 lock_info_len = strlen (lock_info_str);
409 err = 0; 409 err = 0;
410 /* Use 'write', not 'emacs_write', as garbage collection 410 if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
411 might signal an error, which would leak FD. */
412 if (write (fd, lock_info_str, lock_info_len) != lock_info_len
413 || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0) 411 || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
414 err = errno; 412 err = errno;
415 /* There is no need to call fsync here, as the contents of 413 /* There is no need to call fsync here, as the contents of
@@ -490,8 +488,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1])
490 int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0); 488 int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
491 if (0 <= fd) 489 if (0 <= fd)
492 { 490 {
493 /* Use read, not emacs_read, since FD isn't unwind-protected. */ 491 ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
494 ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
495 int read_errno = errno; 492 int read_errno = errno;
496 if (emacs_close (fd) != 0) 493 if (emacs_close (fd) != 0)
497 return -1; 494 return -1;
diff --git a/src/fns.c b/src/fns.c
index 9eabc1414f4..ac7c1f265a4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */)
84 return make_number (val); 84 return make_number (val);
85} 85}
86 86
87/* Heuristic on how many iterations of a tight loop can be safely done
88 before it's time to do a quit. This must be a power of 2. It
89 is nice but not necessary for it to equal USHRT_MAX + 1. */
90enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
91
92/* Process a quit, but do it only rarely, for efficiency. "Rarely"
93 means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
94 whichever is smaller. Use *QUIT_COUNT to count this. */
95
96static void
97rarely_quit (unsigned short int *quit_count)
98{
99 if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
100 maybe_quit ();
101}
102
103/* Random data-structure functions. */ 87/* Random data-structure functions. */
104 88
105DEFUN ("length", Flength, Slength, 1, 1, 0, 89DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -1359,20 +1343,17 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
1359 (Lisp_Object n, Lisp_Object list) 1343 (Lisp_Object n, Lisp_Object list)
1360{ 1344{
1361 CHECK_NUMBER (n); 1345 CHECK_NUMBER (n);
1362 EMACS_INT num = XINT (n);
1363 Lisp_Object tail = list; 1346 Lisp_Object tail = list;
1364 immediate_quit = true; 1347 for (EMACS_INT num = XINT (n); 0 < num; num--)
1365 for (EMACS_INT i = 0; i < num; i++)
1366 { 1348 {
1367 if (! CONSP (tail)) 1349 if (! CONSP (tail))
1368 { 1350 {
1369 immediate_quit = false;
1370 CHECK_LIST_END (tail, list); 1351 CHECK_LIST_END (tail, list);
1371 return Qnil; 1352 return Qnil;
1372 } 1353 }
1373 tail = XCDR (tail); 1354 tail = XCDR (tail);
1355 rarely_quit (num);
1374 } 1356 }
1375 immediate_quit = false;
1376 return tail; 1357 return tail;
1377} 1358}
1378 1359
@@ -1408,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT. */)
1408 { 1389 {
1409 if (! NILP (Fequal (elt, XCAR (tail)))) 1390 if (! NILP (Fequal (elt, XCAR (tail))))
1410 return tail; 1391 return tail;
1411 rarely_quit (&quit_count); 1392 rarely_quit (++quit_count);
1412 } 1393 }
1413 CHECK_LIST_END (tail, list); 1394 CHECK_LIST_END (tail, list);
1414 return Qnil; 1395 return Qnil;
@@ -1419,17 +1400,14 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
1419The value is actually the tail of LIST whose car is ELT. */) 1400The value is actually the tail of LIST whose car is ELT. */)
1420 (Lisp_Object elt, Lisp_Object list) 1401 (Lisp_Object elt, Lisp_Object list)
1421{ 1402{
1422 immediate_quit = true; 1403 unsigned short int quit_count = 0;
1423 Lisp_Object tail; 1404 Lisp_Object tail;
1424 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1405 for (tail = list; CONSP (tail); tail = XCDR (tail))
1425 { 1406 {
1426 if (EQ (XCAR (tail), elt)) 1407 if (EQ (XCAR (tail), elt))
1427 { 1408 return tail;
1428 immediate_quit = false; 1409 rarely_quit (++quit_count);
1429 return tail;
1430 }
1431 } 1410 }
1432 immediate_quit = false;
1433 CHECK_LIST_END (tail, list); 1411 CHECK_LIST_END (tail, list);
1434 return Qnil; 1412 return Qnil;
1435} 1413}
@@ -1442,18 +1420,15 @@ The value is actually the tail of LIST whose car is ELT. */)
1442 if (!FLOATP (elt)) 1420 if (!FLOATP (elt))
1443 return Fmemq (elt, list); 1421 return Fmemq (elt, list);
1444 1422
1445 immediate_quit = true; 1423 unsigned short int quit_count = 0;
1446 Lisp_Object tail; 1424 Lisp_Object tail;
1447 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1425 for (tail = list; CONSP (tail); tail = XCDR (tail))
1448 { 1426 {
1449 Lisp_Object tem = XCAR (tail); 1427 Lisp_Object tem = XCAR (tail);
1450 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) 1428 if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
1451 { 1429 return tail;
1452 immediate_quit = false; 1430 rarely_quit (++quit_count);
1453 return tail;
1454 }
1455 } 1431 }
1456 immediate_quit = false;
1457 CHECK_LIST_END (tail, list); 1432 CHECK_LIST_END (tail, list);
1458 return Qnil; 1433 return Qnil;
1459} 1434}
@@ -1464,15 +1439,14 @@ The value is actually the first element of LIST whose car is KEY.
1464Elements of LIST that are not conses are ignored. */) 1439Elements of LIST that are not conses are ignored. */)
1465 (Lisp_Object key, Lisp_Object list) 1440 (Lisp_Object key, Lisp_Object list)
1466{ 1441{
1467 immediate_quit = true; 1442 unsigned short int quit_count = 0;
1468 Lisp_Object tail; 1443 Lisp_Object tail;
1469 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1444 for (tail = list; CONSP (tail); tail = XCDR (tail))
1470 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) 1445 {
1471 { 1446 if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
1472 immediate_quit = false;
1473 return XCAR (tail); 1447 return XCAR (tail);
1474 } 1448 rarely_quit (++quit_count);
1475 immediate_quit = false; 1449 }
1476 CHECK_LIST_END (tail, list); 1450 CHECK_LIST_END (tail, list);
1477 return Qnil; 1451 return Qnil;
1478} 1452}
@@ -1502,7 +1476,7 @@ The value is actually the first element of LIST whose car equals KEY. */)
1502 if (CONSP (car) 1476 if (CONSP (car)
1503 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) 1477 && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
1504 return car; 1478 return car;
1505 rarely_quit (&quit_count); 1479 rarely_quit (++quit_count);
1506 } 1480 }
1507 CHECK_LIST_END (tail, list); 1481 CHECK_LIST_END (tail, list);
1508 return Qnil; 1482 return Qnil;
@@ -1529,15 +1503,14 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
1529The value is actually the first element of LIST whose cdr is KEY. */) 1503The value is actually the first element of LIST whose cdr is KEY. */)
1530 (Lisp_Object key, Lisp_Object list) 1504 (Lisp_Object key, Lisp_Object list)
1531{ 1505{
1532 immediate_quit = true; 1506 unsigned short int quit_count = 0;
1533 Lisp_Object tail; 1507 Lisp_Object tail;
1534 for (tail = list; CONSP (tail); tail = XCDR (tail)) 1508 for (tail = list; CONSP (tail); tail = XCDR (tail))
1535 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) 1509 {
1536 { 1510 if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
1537 immediate_quit = false;
1538 return XCAR (tail); 1511 return XCAR (tail);
1539 } 1512 rarely_quit (++quit_count);
1540 immediate_quit = false; 1513 }
1541 CHECK_LIST_END (tail, list); 1514 CHECK_LIST_END (tail, list);
1542 return Qnil; 1515 return Qnil;
1543} 1516}
@@ -1555,7 +1528,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */)
1555 if (CONSP (car) 1528 if (CONSP (car)
1556 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) 1529 && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
1557 return car; 1530 return car;
1558 rarely_quit (&quit_count); 1531 rarely_quit (++quit_count);
1559 } 1532 }
1560 CHECK_LIST_END (tail, list); 1533 CHECK_LIST_END (tail, list);
1561 return Qnil; 1534 return Qnil;
@@ -1711,7 +1684,7 @@ changing the value of a sequence `foo'. */)
1711 } 1684 }
1712 else 1685 else
1713 prev = tail; 1686 prev = tail;
1714 rarely_quit (&quit_count); 1687 rarely_quit (++quit_count);
1715 } 1688 }
1716 CHECK_LIST_END (tail, seq); 1689 CHECK_LIST_END (tail, seq);
1717 } 1690 }
@@ -1736,10 +1709,10 @@ This function may destructively modify SEQ to produce the value. */)
1736 1709
1737 for (prev = Qnil, tail = seq; CONSP (tail); tail = next) 1710 for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
1738 { 1711 {
1739 rarely_quit (&quit_count);
1740 next = XCDR (tail); 1712 next = XCDR (tail);
1741 Fsetcdr (tail, prev); 1713 Fsetcdr (tail, prev);
1742 prev = tail; 1714 prev = tail;
1715 rarely_quit (++quit_count);
1743 } 1716 }
1744 CHECK_LIST_END (tail, seq); 1717 CHECK_LIST_END (tail, seq);
1745 seq = prev; 1718 seq = prev;
@@ -1785,8 +1758,8 @@ See also the function `nreverse', which is used more often. */)
1785 unsigned short int quit_count = 0; 1758 unsigned short int quit_count = 0;
1786 for (new = Qnil; CONSP (seq); seq = XCDR (seq)) 1759 for (new = Qnil; CONSP (seq); seq = XCDR (seq))
1787 { 1760 {
1788 rarely_quit (&quit_count);
1789 new = Fcons (XCAR (seq), new); 1761 new = Fcons (XCAR (seq), new);
1762 rarely_quit (++quit_count);
1790 } 1763 }
1791 CHECK_LIST_END (seq, seq); 1764 CHECK_LIST_END (seq, seq);
1792 } 1765 }
@@ -2077,21 +2050,20 @@ use `(setq x (plist-put x prop val))' to be sure to use the new value.
2077The PLIST is modified by side effects. */) 2050The PLIST is modified by side effects. */)
2078 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val) 2051 (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
2079{ 2052{
2080 immediate_quit = true; 2053 unsigned short int quit_count = 0;
2081 Lisp_Object prev = Qnil; 2054 Lisp_Object prev = Qnil;
2082 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail)); 2055 for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
2083 tail = XCDR (XCDR (tail))) 2056 tail = XCDR (XCDR (tail)))
2084 { 2057 {
2085 if (EQ (prop, XCAR (tail))) 2058 if (EQ (prop, XCAR (tail)))
2086 { 2059 {
2087 immediate_quit = false;
2088 Fsetcar (XCDR (tail), val); 2060 Fsetcar (XCDR (tail), val);
2089 return plist; 2061 return plist;
2090 } 2062 }
2091 2063
2092 prev = tail; 2064 prev = tail;
2065 rarely_quit (++quit_count);
2093 } 2066 }
2094 immediate_quit = false;
2095 Lisp_Object newcell 2067 Lisp_Object newcell
2096 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); 2068 = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
2097 if (NILP (prev)) 2069 if (NILP (prev))
@@ -2128,7 +2100,7 @@ one of the properties on the list. */)
2128 { 2100 {
2129 if (! NILP (Fequal (prop, XCAR (tail)))) 2101 if (! NILP (Fequal (prop, XCAR (tail))))
2130 return XCAR (XCDR (tail)); 2102 return XCAR (XCDR (tail));
2131 rarely_quit (&quit_count); 2103 rarely_quit (++quit_count);
2132 } 2104 }
2133 2105
2134 CHECK_LIST_END (tail, prop); 2106 CHECK_LIST_END (tail, prop);
@@ -2158,7 +2130,7 @@ The PLIST is modified by side effects. */)
2158 } 2130 }
2159 2131
2160 prev = tail; 2132 prev = tail;
2161 rarely_quit (&quit_count); 2133 rarely_quit (++quit_count);
2162 } 2134 }
2163 Lisp_Object newcell = list2 (prop, val); 2135 Lisp_Object newcell = list2 (prop, val);
2164 if (NILP (prev)) 2136 if (NILP (prev))
@@ -2238,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props,
2238 2210
2239 unsigned short int quit_count = 0; 2211 unsigned short int quit_count = 0;
2240 tail_recurse: 2212 tail_recurse:
2241 rarely_quit (&quit_count); 2213 rarely_quit (++quit_count);
2242 if (EQ (o1, o2)) 2214 if (EQ (o1, o2))
2243 return 1; 2215 return 1;
2244 if (XTYPE (o1) != XTYPE (o2)) 2216 if (XTYPE (o1) != XTYPE (o2))
@@ -2442,18 +2414,15 @@ usage: (nconc &rest LISTS) */)
2442 2414
2443 CHECK_CONS (tem); 2415 CHECK_CONS (tem);
2444 2416
2445 immediate_quit = true;
2446 Lisp_Object tail; 2417 Lisp_Object tail;
2447 do 2418 do
2448 { 2419 {
2449 tail = tem; 2420 tail = tem;
2450 tem = XCDR (tail); 2421 tem = XCDR (tail);
2422 rarely_quit (++quit_count);
2451 } 2423 }
2452 while (CONSP (tem)); 2424 while (CONSP (tem));
2453 2425
2454 immediate_quit = false;
2455 rarely_quit (&quit_count);
2456
2457 tem = args[argnum + 1]; 2426 tem = args[argnum + 1];
2458 Fsetcdr (tail, tem); 2427 Fsetcdr (tail, tem);
2459 if (NILP (tem)) 2428 if (NILP (tem))
@@ -2874,13 +2843,13 @@ property and a property with the value nil.
2874The value is actually the tail of PLIST whose car is PROP. */) 2843The value is actually the tail of PLIST whose car is PROP. */)
2875 (Lisp_Object plist, Lisp_Object prop) 2844 (Lisp_Object plist, Lisp_Object prop)
2876{ 2845{
2877 immediate_quit = true; 2846 unsigned short int quit_count = 0;
2878 while (CONSP (plist) && !EQ (XCAR (plist), prop)) 2847 while (CONSP (plist) && !EQ (XCAR (plist), prop))
2879 { 2848 {
2880 plist = XCDR (plist); 2849 plist = XCDR (plist);
2881 plist = CDR (plist); 2850 plist = CDR (plist);
2851 rarely_quit (++quit_count);
2882 } 2852 }
2883 immediate_quit = false;
2884 return plist; 2853 return plist;
2885} 2854}
2886 2855
@@ -5120,10 +5089,6 @@ On some platforms, file selection dialogs are also enabled if this is
5120non-nil. */); 5089non-nil. */);
5121 use_dialog_box = 1; 5090 use_dialog_box = 1;
5122 5091
5123 DEFVAR_LISP("watch-object", Vwatch_object,
5124 doc: /* Symbol to watch. */);
5125 Vwatch_object = Qnil;
5126
5127 DEFVAR_BOOL ("use-file-dialog", use_file_dialog, 5092 DEFVAR_BOOL ("use-file-dialog", use_file_dialog,
5128 doc: /* Non-nil means mouse commands use a file dialog to ask for files. 5093 doc: /* Non-nil means mouse commands use a file dialog to ask for files.
5129This applies to commands from menus and tool bar buttons even when 5094This applies to commands from menus and tool bar buttons even when
diff --git a/src/indent.c b/src/indent.c
index 23951a16eb6..f630ebb847c 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,9 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1200 continuation_glyph_width = 0; /* In the fringe. */ 1200 continuation_glyph_width = 0; /* In the fringe. */
1201#endif 1201#endif
1202 1202
1203 immediate_quit = true;
1204 maybe_quit ();
1205
1206 /* It's just impossible to be too paranoid here. */ 1203 /* It's just impossible to be too paranoid here. */
1207 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from)); 1204 eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
1208 1205
@@ -1214,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1214 cmp_it.id = -1; 1211 cmp_it.id = -1;
1215 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil); 1212 composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil);
1216 1213
1217 while (1) 1214 unsigned short int quit_count = 0;
1215
1216 while (true)
1218 { 1217 {
1218 rarely_quit (++quit_count);
1219
1219 while (pos == next_boundary) 1220 while (pos == next_boundary)
1220 { 1221 {
1221 ptrdiff_t pos_here = pos; 1222 ptrdiff_t pos_here = pos;
@@ -1280,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1280 pos = newpos; 1281 pos = newpos;
1281 pos_byte = CHAR_TO_BYTE (pos); 1282 pos_byte = CHAR_TO_BYTE (pos);
1282 } 1283 }
1284
1285 rarely_quit (++quit_count);
1283 } 1286 }
1284 1287
1285 /* Handle right margin. */ 1288 /* Handle right margin. */
@@ -1602,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1602 pos = find_before_next_newline (pos, to, 1, &pos_byte); 1605 pos = find_before_next_newline (pos, to, 1, &pos_byte);
1603 if (pos < to) 1606 if (pos < to)
1604 INC_BOTH (pos, pos_byte); 1607 INC_BOTH (pos, pos_byte);
1608 rarely_quit (++quit_count);
1605 } 1609 }
1606 while (pos < to 1610 while (pos < to
1607 && indented_beyond_p (pos, pos_byte, 1611 && indented_beyond_p (pos, pos_byte,
@@ -1694,7 +1698,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
1694 /* Nonzero if have just continued a line */ 1698 /* Nonzero if have just continued a line */
1695 val_compute_motion.contin = (contin_hpos && prev_hpos == 0); 1699 val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
1696 1700
1697 immediate_quit = false;
1698 return &val_compute_motion; 1701 return &val_compute_motion;
1699} 1702}
1700 1703
diff --git a/src/keyboard.c b/src/keyboard.c
index 0c04d95304c..a86e7c5f8e4 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -169,9 +169,6 @@ struct kboard *echo_kboard;
169 169
170Lisp_Object echo_message_buffer; 170Lisp_Object echo_message_buffer;
171 171
172/* True means C-g should cause immediate error-signal. */
173bool immediate_quit;
174
175/* Character that causes a quit. Normally C-g. 172/* Character that causes a quit. Normally C-g.
176 173
177 If we are running on an ordinary terminal, this must be an ordinary 174 If we are running on an ordinary terminal, this must be an ordinary
@@ -3584,16 +3581,7 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
3584 as input, set quit-flag to cause an interrupt. */ 3581 as input, set quit-flag to cause an interrupt. */
3585 if (!NILP (Vthrow_on_input) 3582 if (!NILP (Vthrow_on_input)
3586 && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) 3583 && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)))
3587 { 3584 Vquit_flag = Vthrow_on_input;
3588 Vquit_flag = Vthrow_on_input;
3589 /* If we're inside a function that wants immediate quits,
3590 do it now. */
3591 if (immediate_quit && NILP (Vinhibit_quit))
3592 {
3593 immediate_quit = false;
3594 maybe_quit ();
3595 }
3596 }
3597} 3585}
3598 3586
3599 3587
@@ -7053,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal,
7053 7041
7054 /* Now read; for one reason or another, this will not block. 7042 /* Now read; for one reason or another, this will not block.
7055 NREAD is set to the number of chars read. */ 7043 NREAD is set to the number of chars read. */
7056 do 7044 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7057 { 7045 /* POSIX infers that processes which are not in the session leader's
7058 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read); 7046 process group won't get SIGHUPs at logout time. BSDI adheres to
7059 /* POSIX infers that processes which are not in the session leader's 7047 this part standard and returns -1 from read (0) with errno==EIO
7060 process group won't get SIGHUPs at logout time. BSDI adheres to 7048 when the control tty is taken away.
7061 this part standard and returns -1 from read (0) with errno==EIO 7049 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7062 when the control tty is taken away. 7050 if (nread == -1 && errno == EIO)
7063 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */ 7051 return -2; /* Close this terminal. */
7064 if (nread == -1 && errno == EIO) 7052#if defined AIX && defined _BSD
7065 return -2; /* Close this terminal. */ 7053 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7066#if defined (AIX) && defined (_BSD) 7054 This looks incorrect, but it isn't, because _BSD causes
7067 /* The kernel sometimes fails to deliver SIGHUP for ptys. 7055 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7068 This looks incorrect, but it isn't, because _BSD causes 7056 and that causes a value other than 0 when there is no input. */
7069 O_NDELAY to be defined in fcntl.h as O_NONBLOCK, 7057 if (nread == 0)
7070 and that causes a value other than 0 when there is no input. */ 7058 return -2; /* Close this terminal. */
7071 if (nread == 0)
7072 return -2; /* Close this terminal. */
7073#endif
7074 }
7075 while (
7076 /* We used to retry the read if it was interrupted.
7077 But this does the wrong thing when O_NONBLOCK causes
7078 an EAGAIN error. Does anybody know of a situation
7079 where a retry is actually needed? */
7080#if 0
7081 nread < 0 && (errno == EAGAIN || errno == EFAULT
7082#ifdef EBADSLT
7083 || errno == EBADSLT
7084#endif
7085 )
7086#else
7087 0
7088#endif 7059#endif
7089 );
7090 7060
7091#ifndef USABLE_FIONREAD 7061#ifndef USABLE_FIONREAD
7092#if defined (USG) || defined (CYGWIN) 7062#if defined (USG) || defined (CYGWIN)
@@ -10445,30 +10415,12 @@ handle_interrupt (bool in_signal_handler)
10445 } 10415 }
10446 else 10416 else
10447 { 10417 {
10448 /* If executing a function that wants to be interrupted out of 10418 /* Request quit when it's safe. */
10449 and the user has not deferred quitting by binding `inhibit-quit' 10419 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10450 then quit right away. */ 10420 force_quit_count = count;
10451 if (immediate_quit && NILP (Vinhibit_quit) && !waiting_for_input) 10421 if (count == 3)
10452 { 10422 Vinhibit_quit = Qnil;
10453 struct gl_state_s saved; 10423 Vquit_flag = Qt;
10454
10455 immediate_quit = false;
10456 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10457 saved = gl_state;
10458 quit ();
10459 gl_state = saved;
10460 }
10461 else
10462 { /* Else request quit when it's safe. */
10463 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10464 force_quit_count = count;
10465 if (count == 3)
10466 {
10467 immediate_quit = true;
10468 Vinhibit_quit = Qnil;
10469 }
10470 Vquit_flag = Qt;
10471 }
10472 } 10424 }
10473 10425
10474 pthread_sigmask (SIG_SETMASK, &empty_mask, 0); 10426 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
@@ -10907,7 +10859,6 @@ init_keyboard (void)
10907{ 10859{
10908 /* This is correct before outermost invocation of the editor loop. */ 10860 /* This is correct before outermost invocation of the editor loop. */
10909 command_loop_level = -1; 10861 command_loop_level = -1;
10910 immediate_quit = false;
10911 quit_char = Ctl ('g'); 10862 quit_char = Ctl ('g');
10912 Vunread_command_events = Qnil; 10863 Vunread_command_events = Qnil;
10913 timer_idleness_start_time = invalid_timespec (); 10864 timer_idleness_start_time = invalid_timespec ();
diff --git a/src/lisp.h b/src/lisp.h
index a29335904fd..44b59f6bac5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1995,8 +1995,8 @@ struct Lisp_Hash_Table
1995 hash table size to reduce collisions. */ 1995 hash table size to reduce collisions. */
1996 Lisp_Object index; 1996 Lisp_Object index;
1997 1997
1998 /* Non-nil if the table can be purecopied. Any changes the table after 1998 /* Non-nil if the table can be purecopied. The table cannot be
1999 purecopy will result in an error. */ 1999 changed afterwards. */
2000 Lisp_Object pure; 2000 Lisp_Object pure;
2001 2001
2002 /* Only the fields above are traced normally by the GC. The ones below 2002 /* Only the fields above are traced normally by the GC. The ones below
@@ -3132,29 +3132,28 @@ struct handler
3132 3132
3133extern Lisp_Object memory_signal_data; 3133extern Lisp_Object memory_signal_data;
3134 3134
3135/* Check quit-flag and quit if it is non-nil. Typing C-g does not 3135extern void maybe_quit (void);
3136 directly cause a quit; it only sets Vquit_flag. So the program
3137 needs to call maybe_quit at times when it is safe to quit. Every
3138 loop that might run for a long time or might not exit ought to call
3139 maybe_quit at least once, at a safe place. Unless that is
3140 impossible, of course. But it is very desirable to avoid creating
3141 loops where maybe_quit is impossible.
3142 3136
3143 Exception: if you set immediate_quit, the handler that responds to 3137/* True if ought to quit now. */
3144 the C-g does the quit itself. This is a good thing to do around a
3145 loop that has no side effects and (in particular) cannot call
3146 arbitrary Lisp code.
3147 3138
3148 If quit-flag is set to `kill-emacs' the SIGINT handler has received 3139#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
3149 a request to exit Emacs when it is safe to do.
3150 3140
3151 When not quitting, process any pending signals. */ 3141/* Heuristic on how many iterations of a tight loop can be safely done
3142 before it's time to do a quit. This must be a power of 2. It
3143 is nice but not necessary for it to equal USHRT_MAX + 1. */
3152 3144
3153extern void maybe_quit (void); 3145enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
3154 3146
3155/* True if ought to quit now. */ 3147/* Process a quit rarely, based on a counter COUNT, for efficiency.
3148 "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
3149 times, whichever is smaller (somewhat arbitrary, but often faster). */
3156 3150
3157#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) 3151INLINE void
3152rarely_quit (unsigned short int count)
3153{
3154 if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
3155 maybe_quit ();
3156}
3158 3157
3159extern Lisp_Object Vascii_downcase_table; 3158extern Lisp_Object Vascii_downcase_table;
3160extern Lisp_Object Vascii_canon_table; 3159extern Lisp_Object Vascii_canon_table;
@@ -4233,8 +4232,10 @@ extern int emacs_open (const char *, int, int);
4233extern int emacs_pipe (int[2]); 4232extern int emacs_pipe (int[2]);
4234extern int emacs_close (int); 4233extern int emacs_close (int);
4235extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); 4234extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
4235extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t);
4236extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); 4236extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
4237extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); 4237extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
4238extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
4238extern void emacs_perror (char const *); 4239extern void emacs_perror (char const *);
4239 4240
4240extern void unlock_all_files (void); 4241extern void unlock_all_files (void);
@@ -4360,9 +4361,6 @@ extern char my_edata[];
4360extern char my_endbss[]; 4361extern char my_endbss[];
4361extern char *my_endbss_static; 4362extern char *my_endbss_static;
4362 4363
4363/* True means ^G can quit instantly. */
4364extern bool immediate_quit;
4365
4366extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); 4364extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
4367extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); 4365extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
4368extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2)); 4366extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
diff --git a/src/lread.c b/src/lread.c
index 0a818c3695b..f0a764f2dea 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -910,7 +910,7 @@ safe_to_load_version (int fd)
910 910
911 /* Read the first few bytes from the file, and look for a line 911 /* Read the first few bytes from the file, and look for a line
912 specifying the byte compiler version used. */ 912 specifying the byte compiler version used. */
913 nbytes = emacs_read (fd, buf, sizeof buf); 913 nbytes = emacs_read_quit (fd, buf, sizeof buf);
914 if (nbytes > 0) 914 if (nbytes > 0)
915 { 915 {
916 /* Skip to the next newline, skipping over the initial `ELC' 916 /* Skip to the next newline, skipping over the initial `ELC'
diff --git a/src/process.c b/src/process.c
index dbd4358dd1a..434a3955b2c 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,7 +3431,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3431 break; 3431 break;
3432 } 3432 }
3433 3433
3434 immediate_quit = true;
3435 maybe_quit (); 3434 maybe_quit ();
3436 3435
3437 ret = connect (s, sa, addrlen); 3436 ret = connect (s, sa, addrlen);
@@ -3439,8 +3438,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3439 3438
3440 if (ret == 0 || xerrno == EISCONN) 3439 if (ret == 0 || xerrno == EISCONN)
3441 { 3440 {
3442 /* The unwind-protect will be discarded afterwards. 3441 /* The unwind-protect will be discarded afterwards. */
3443 Likewise for immediate_quit. */
3444 break; 3442 break;
3445 } 3443 }
3446 3444
@@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3481 } 3479 }
3482#endif /* !WINDOWSNT */ 3480#endif /* !WINDOWSNT */
3483 3481
3484 immediate_quit = false;
3485
3486 /* Discard the unwind protect closing S. */ 3482 /* Discard the unwind protect closing S. */
3487 specpdl_ptr = specpdl + count; 3483 specpdl_ptr = specpdl + count;
3488 emacs_close (s); 3484 emacs_close (s);
@@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3539#endif 3535#endif
3540 } 3536 }
3541 3537
3542 immediate_quit = false;
3543
3544 if (s < 0) 3538 if (s < 0)
3545 { 3539 {
3546 /* If non-blocking got this far - and failed - assume non-blocking is 3540 /* If non-blocking got this far - and failed - assume non-blocking is
@@ -4012,7 +4006,6 @@ usage: (make-network-process &rest ARGS) */)
4012 struct addrinfo *res, *lres; 4006 struct addrinfo *res, *lres;
4013 int ret; 4007 int ret;
4014 4008
4015 immediate_quit = true;
4016 maybe_quit (); 4009 maybe_quit ();
4017 4010
4018 struct addrinfo hints; 4011 struct addrinfo hints;
@@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */)
4034#else 4027#else
4035 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret); 4028 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4036#endif 4029#endif
4037 immediate_quit = false;
4038 4030
4039 for (lres = res; lres; lres = lres->ai_next) 4031 for (lres = res; lres; lres = lres->ai_next)
4040 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos); 4032 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
diff --git a/src/regex.c b/src/regex.c
index f6e67afef4c..796f868d1c2 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1728,10 +1728,8 @@ typedef struct
1728 1728
1729/* Explicit quit checking is needed for Emacs, which uses polling to 1729/* Explicit quit checking is needed for Emacs, which uses polling to
1730 process input events. */ 1730 process input events. */
1731#ifdef emacs 1731#ifndef emacs
1732# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0) 1732static void maybe_quit (void) {}
1733#else
1734# define IMMEDIATE_QUIT_CHECK ((void) 0)
1735#endif 1733#endif
1736 1734
1737/* Structure to manage work area for range table. */ 1735/* Structure to manage work area for range table. */
@@ -5820,7 +5818,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
5820 /* Unconditionally jump (without popping any failure points). */ 5818 /* Unconditionally jump (without popping any failure points). */
5821 case jump: 5819 case jump:
5822 unconditional_jump: 5820 unconditional_jump:
5823 IMMEDIATE_QUIT_CHECK; 5821 maybe_quit ();
5824 EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */ 5822 EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */
5825 DEBUG_PRINT ("EXECUTING jump %d ", mcnt); 5823 DEBUG_PRINT ("EXECUTING jump %d ", mcnt);
5826 p += mcnt; /* Do the jump. */ 5824 p += mcnt; /* Do the jump. */
@@ -6168,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6168 6166
6169 /* We goto here if a matching operation fails. */ 6167 /* We goto here if a matching operation fails. */
6170 fail: 6168 fail:
6171 IMMEDIATE_QUIT_CHECK; 6169 maybe_quit ();
6172 if (!FAIL_STACK_EMPTY ()) 6170 if (!FAIL_STACK_EMPTY ())
6173 { 6171 {
6174 re_char *str, *pat; 6172 re_char *str, *pat;
diff --git a/src/search.c b/src/search.c
index f54f44c8818..33cb02aa7af 100644
--- a/src/search.c
+++ b/src/search.c
@@ -99,6 +99,25 @@ matcher_overflow (void)
99 error ("Stack overflow in regexp matcher"); 99 error ("Stack overflow in regexp matcher");
100} 100}
101 101
102static void
103freeze_buffer_relocation (void)
104{
105#ifdef REL_ALLOC
106 /* Prevent ralloc.c from relocating the current buffer while
107 searching it. */
108 r_alloc_inhibit_buffer_relocation (1);
109 record_unwind_protect_int (r_alloc_inhibit_buffer_relocation, 0);
110#endif
111}
112
113static void
114thaw_buffer_relocation (void)
115{
116#ifdef REL_ALLOC
117 unbind_to (SPECPDL_INDEX () - 1, Qnil);
118#endif
119}
120
102/* Compile a regexp and signal a Lisp error if anything goes wrong. 121/* Compile a regexp and signal a Lisp error if anything goes wrong.
103 PATTERN is the pattern to compile. 122 PATTERN is the pattern to compile.
104 CP is the place to put the result. 123 CP is the place to put the result.
@@ -277,7 +296,6 @@ looking_at_1 (Lisp_Object string, bool posix)
277 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 296 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
278 297
279 /* Do a pending quit right away, to avoid paradoxical behavior */ 298 /* Do a pending quit right away, to avoid paradoxical behavior */
280 immediate_quit = true;
281 maybe_quit (); 299 maybe_quit ();
282 300
283 /* Get pointers and sizes of the two strings 301 /* Get pointers and sizes of the two strings
@@ -301,20 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix)
301 319
302 re_match_object = Qnil; 320 re_match_object = Qnil;
303 321
304#ifdef REL_ALLOC 322 freeze_buffer_relocation ();
305 /* Prevent ralloc.c from relocating the current buffer while
306 searching it. */
307 r_alloc_inhibit_buffer_relocation (1);
308#endif
309 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, 323 i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
310 PT_BYTE - BEGV_BYTE, 324 PT_BYTE - BEGV_BYTE,
311 (NILP (Vinhibit_changing_match_data) 325 (NILP (Vinhibit_changing_match_data)
312 ? &search_regs : NULL), 326 ? &search_regs : NULL),
313 ZV_BYTE - BEGV_BYTE); 327 ZV_BYTE - BEGV_BYTE);
314 immediate_quit = false; 328 thaw_buffer_relocation ();
315#ifdef REL_ALLOC
316 r_alloc_inhibit_buffer_relocation (0);
317#endif
318 329
319 if (i == -2) 330 if (i == -2)
320 matcher_overflow (); 331 matcher_overflow ();
@@ -399,7 +410,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
399 ? BVAR (current_buffer, case_canon_table) : Qnil), 410 ? BVAR (current_buffer, case_canon_table) : Qnil),
400 posix, 411 posix,
401 STRING_MULTIBYTE (string)); 412 STRING_MULTIBYTE (string));
402 immediate_quit = true;
403 re_match_object = string; 413 re_match_object = string;
404 414
405 val = re_search (bufp, SSDATA (string), 415 val = re_search (bufp, SSDATA (string),
@@ -407,7 +417,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
407 SBYTES (string) - pos_byte, 417 SBYTES (string) - pos_byte,
408 (NILP (Vinhibit_changing_match_data) 418 (NILP (Vinhibit_changing_match_data)
409 ? &search_regs : NULL)); 419 ? &search_regs : NULL));
410 immediate_quit = false;
411 420
412 /* Set last_thing_searched only when match data is changed. */ 421 /* Set last_thing_searched only when match data is changed. */
413 if (NILP (Vinhibit_changing_match_data)) 422 if (NILP (Vinhibit_changing_match_data))
@@ -471,13 +480,11 @@ fast_string_match_internal (Lisp_Object regexp, Lisp_Object string,
471 480
472 bufp = compile_pattern (regexp, 0, table, 481 bufp = compile_pattern (regexp, 0, table,
473 0, STRING_MULTIBYTE (string)); 482 0, STRING_MULTIBYTE (string));
474 immediate_quit = true;
475 re_match_object = string; 483 re_match_object = string;
476 484
477 val = re_search (bufp, SSDATA (string), 485 val = re_search (bufp, SSDATA (string),
478 SBYTES (string), 0, 486 SBYTES (string), 0,
479 SBYTES (string), 0); 487 SBYTES (string), 0);
480 immediate_quit = false;
481 return val; 488 return val;
482} 489}
483 490
@@ -498,9 +505,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
498 bufp = compile_pattern (regexp, 0, 505 bufp = compile_pattern (regexp, 0,
499 Vascii_canon_table, 0, 506 Vascii_canon_table, 0,
500 0); 507 0);
501 immediate_quit = true;
502 val = re_search (bufp, string, len, 0, len, 0); 508 val = re_search (bufp, string, len, 0, len, 0);
503 immediate_quit = false;
504 return val; 509 return val;
505} 510}
506 511
@@ -561,18 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte,
561 } 566 }
562 567
563 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); 568 buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
564 immediate_quit = true; 569 freeze_buffer_relocation ();
565#ifdef REL_ALLOC
566 /* Prevent ralloc.c from relocating the current buffer while
567 searching it. */
568 r_alloc_inhibit_buffer_relocation (1);
569#endif
570 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2, 570 len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
571 pos_byte, NULL, limit_byte); 571 pos_byte, NULL, limit_byte);
572#ifdef REL_ALLOC 572 thaw_buffer_relocation ();
573 r_alloc_inhibit_buffer_relocation (0);
574#endif
575 immediate_quit = false;
576 573
577 return len; 574 return len;
578} 575}
@@ -649,7 +646,7 @@ newline_cache_on_off (struct buffer *buf)
649 If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding 646 If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding
650 to the returned character position. 647 to the returned character position.
651 648
652 If ALLOW_QUIT, set immediate_quit. That's good to do 649 If ALLOW_QUIT, check for quitting. That's good to do
653 except when inside redisplay. */ 650 except when inside redisplay. */
654 651
655ptrdiff_t 652ptrdiff_t
@@ -685,8 +682,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
685 if (shortage != 0) 682 if (shortage != 0)
686 *shortage = 0; 683 *shortage = 0;
687 684
688 immediate_quit = allow_quit;
689
690 if (count > 0) 685 if (count > 0)
691 while (start != end) 686 while (start != end)
692 { 687 {
@@ -704,7 +699,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
704 ptrdiff_t next_change; 699 ptrdiff_t next_change;
705 int result = 1; 700 int result = 1;
706 701
707 immediate_quit = false;
708 while (start < end && result) 702 while (start < end && result)
709 { 703 {
710 ptrdiff_t lim1; 704 ptrdiff_t lim1;
@@ -757,7 +751,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
757 start_byte = end_byte; 751 start_byte = end_byte;
758 break; 752 break;
759 } 753 }
760 immediate_quit = allow_quit;
761 754
762 /* START should never be after END. */ 755 /* START should never be after END. */
763 if (start_byte > ceiling_byte) 756 if (start_byte > ceiling_byte)
@@ -810,11 +803,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
810 803
811 if (--count == 0) 804 if (--count == 0)
812 { 805 {
813 immediate_quit = false;
814 if (bytepos) 806 if (bytepos)
815 *bytepos = lim_byte + next; 807 *bytepos = lim_byte + next;
816 return BYTE_TO_CHAR (lim_byte + next); 808 return BYTE_TO_CHAR (lim_byte + next);
817 } 809 }
810 if (allow_quit)
811 maybe_quit ();
818 } 812 }
819 813
820 start_byte = lim_byte; 814 start_byte = lim_byte;
@@ -833,7 +827,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
833 ptrdiff_t next_change; 827 ptrdiff_t next_change;
834 int result = 1; 828 int result = 1;
835 829
836 immediate_quit = false;
837 while (start > end && result) 830 while (start > end && result)
838 { 831 {
839 ptrdiff_t lim1; 832 ptrdiff_t lim1;
@@ -870,7 +863,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
870 start_byte = end_byte; 863 start_byte = end_byte;
871 break; 864 break;
872 } 865 }
873 immediate_quit = allow_quit;
874 866
875 /* Start should never be at or before end. */ 867 /* Start should never be at or before end. */
876 if (start_byte <= ceiling_byte) 868 if (start_byte <= ceiling_byte)
@@ -918,11 +910,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
918 910
919 if (++count >= 0) 911 if (++count >= 0)
920 { 912 {
921 immediate_quit = false;
922 if (bytepos) 913 if (bytepos)
923 *bytepos = ceiling_byte + prev + 1; 914 *bytepos = ceiling_byte + prev + 1;
924 return BYTE_TO_CHAR (ceiling_byte + prev + 1); 915 return BYTE_TO_CHAR (ceiling_byte + prev + 1);
925 } 916 }
917 if (allow_quit)
918 maybe_quit ();
926 } 919 }
927 920
928 start_byte = ceiling_byte; 921 start_byte = ceiling_byte;
@@ -930,7 +923,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
930 } 923 }
931 } 924 }
932 925
933 immediate_quit = false;
934 if (shortage) 926 if (shortage)
935 *shortage = count * direction; 927 *shortage = count * direction;
936 if (bytepos) 928 if (bytepos)
@@ -954,7 +946,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
954 the number of line boundaries left unfound, and position at 946 the number of line boundaries left unfound, and position at
955 the limit we bumped up against. 947 the limit we bumped up against.
956 948
957 If ALLOW_QUIT, set immediate_quit. That's good to do 949 If ALLOW_QUIT, check for quitting. That's good to do
958 except in special cases. */ 950 except in special cases. */
959 951
960ptrdiff_t 952ptrdiff_t
@@ -1197,9 +1189,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1197 trt, posix, 1189 trt, posix,
1198 !NILP (BVAR (current_buffer, enable_multibyte_characters))); 1190 !NILP (BVAR (current_buffer, enable_multibyte_characters)));
1199 1191
1200 immediate_quit = true; /* Quit immediately if user types ^G,
1201 because letting this function finish
1202 can take too long. */
1203 maybe_quit (); /* Do a pending quit right away, 1192 maybe_quit (); /* Do a pending quit right away,
1204 to avoid paradoxical behavior */ 1193 to avoid paradoxical behavior */
1205 /* Get pointers and sizes of the two strings 1194 /* Get pointers and sizes of the two strings
@@ -1222,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1222 } 1211 }
1223 re_match_object = Qnil; 1212 re_match_object = Qnil;
1224 1213
1225#ifdef REL_ALLOC 1214 freeze_buffer_relocation ();
1226 /* Prevent ralloc.c from relocating the current buffer while
1227 searching it. */
1228 r_alloc_inhibit_buffer_relocation (1);
1229#endif
1230 1215
1231 while (n < 0) 1216 while (n < 0)
1232 { 1217 {
@@ -1268,13 +1253,11 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1268 } 1253 }
1269 else 1254 else
1270 { 1255 {
1271 immediate_quit = false; 1256 thaw_buffer_relocation ();
1272#ifdef REL_ALLOC
1273 r_alloc_inhibit_buffer_relocation (0);
1274#endif
1275 return (n); 1257 return (n);
1276 } 1258 }
1277 n++; 1259 n++;
1260 maybe_quit ();
1278 } 1261 }
1279 while (n > 0) 1262 while (n > 0)
1280 { 1263 {
@@ -1313,18 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte,
1313 } 1296 }
1314 else 1297 else
1315 { 1298 {
1316 immediate_quit = false; 1299 thaw_buffer_relocation ();
1317#ifdef REL_ALLOC
1318 r_alloc_inhibit_buffer_relocation (0);
1319#endif
1320 return (0 - n); 1300 return (0 - n);
1321 } 1301 }
1322 n--; 1302 n--;
1303 maybe_quit ();
1323 } 1304 }
1324 immediate_quit = false; 1305 thaw_buffer_relocation ();
1325#ifdef REL_ALLOC
1326 r_alloc_inhibit_buffer_relocation (0);
1327#endif
1328 return (pos); 1306 return (pos);
1329 } 1307 }
1330 else /* non-RE case */ 1308 else /* non-RE case */
@@ -3231,8 +3209,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3231 if (shortage != 0) 3209 if (shortage != 0)
3232 *shortage = 0; 3210 *shortage = 0;
3233 3211
3234 immediate_quit = allow_quit;
3235
3236 if (count > 0) 3212 if (count > 0)
3237 while (start != end) 3213 while (start != end)
3238 { 3214 {
@@ -3275,11 +3251,12 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3275 3251
3276 if (--count == 0) 3252 if (--count == 0)
3277 { 3253 {
3278 immediate_quit = false;
3279 if (bytepos) 3254 if (bytepos)
3280 *bytepos = lim_byte + next; 3255 *bytepos = lim_byte + next;
3281 return BYTE_TO_CHAR (lim_byte + next); 3256 return BYTE_TO_CHAR (lim_byte + next);
3282 } 3257 }
3258 if (allow_quit)
3259 maybe_quit ();
3283 } 3260 }
3284 3261
3285 start_byte = lim_byte; 3262 start_byte = lim_byte;
@@ -3287,7 +3264,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte, ptrdiff_t end,
3287 } 3264 }
3288 } 3265 }
3289 3266
3290 immediate_quit = false;
3291 if (shortage) 3267 if (shortage)
3292 *shortage = count; 3268 *shortage = count;
3293 if (bytepos) 3269 if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index f9e4093765c..7aa43e6e5c7 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -621,11 +621,9 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
621 SETUP_BUFFER_SYNTAX_TABLE (); 621 SETUP_BUFFER_SYNTAX_TABLE ();
622 while (PT > BEGV) 622 while (PT > BEGV)
623 { 623 {
624 int c;
625
626 /* Open-paren at start of line means we may have found our 624 /* Open-paren at start of line means we may have found our
627 defun-start. */ 625 defun-start. */
628 c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); 626 int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
629 if (SYNTAX (c) == Sopen) 627 if (SYNTAX (c) == Sopen)
630 { 628 {
631 SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ 629 SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
@@ -715,6 +713,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
715 ptrdiff_t nesting = 1; /* Current comment nesting. */ 713 ptrdiff_t nesting = 1; /* Current comment nesting. */
716 int c; 714 int c;
717 int syntax = 0; 715 int syntax = 0;
716 unsigned short int quit_count = 0;
718 717
719 /* FIXME: A }} comment-ender style leads to incorrect behavior 718 /* FIXME: A }} comment-ender style leads to incorrect behavior
720 in the case of {{ c }}} because we ignore the last two chars which are 719 in the case of {{ c }}} because we ignore the last two chars which are
@@ -724,6 +723,8 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
724 that determines quote parity to the comment-end. */ 723 that determines quote parity to the comment-end. */
725 while (from != stop) 724 while (from != stop)
726 { 725 {
726 rarely_quit (++quit_count);
727
727 ptrdiff_t temp_byte; 728 ptrdiff_t temp_byte;
728 int prev_syntax; 729 int prev_syntax;
729 bool com2start, com2end, comstart; 730 bool com2start, com2end, comstart;
@@ -951,7 +952,9 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
951 defun_start_byte = CHAR_TO_BYTE (defun_start); 952 defun_start_byte = CHAR_TO_BYTE (defun_start);
952 } 953 }
953 } 954 }
954 } while (defun_start < comment_end); 955 rarely_quit (++quit_count);
956 }
957 while (defun_start < comment_end);
955 958
956 from_byte = CHAR_TO_BYTE (from); 959 from_byte = CHAR_TO_BYTE (from);
957 UPDATE_SYNTAX_TABLE_FORWARD (from - 1); 960 UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
@@ -1417,29 +1420,23 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
1417 COUNT negative means scan backward and stop at word beginning. */ 1420 COUNT negative means scan backward and stop at word beginning. */
1418 1421
1419ptrdiff_t 1422ptrdiff_t
1420scan_words (register ptrdiff_t from, register EMACS_INT count) 1423scan_words (ptrdiff_t from, EMACS_INT count)
1421{ 1424{
1422 register ptrdiff_t beg = BEGV; 1425 ptrdiff_t beg = BEGV;
1423 register ptrdiff_t end = ZV; 1426 ptrdiff_t end = ZV;
1424 register ptrdiff_t from_byte = CHAR_TO_BYTE (from); 1427 ptrdiff_t from_byte = CHAR_TO_BYTE (from);
1425 register enum syntaxcode code; 1428 enum syntaxcode code;
1426 int ch0, ch1; 1429 int ch0, ch1;
1427 Lisp_Object func, pos; 1430 Lisp_Object func, pos;
1428 1431
1429 immediate_quit = true;
1430 maybe_quit ();
1431
1432 SETUP_SYNTAX_TABLE (from, count); 1432 SETUP_SYNTAX_TABLE (from, count);
1433 1433
1434 while (count > 0) 1434 while (count > 0)
1435 { 1435 {
1436 while (1) 1436 while (true)
1437 { 1437 {
1438 if (from == end) 1438 if (from == end)
1439 { 1439 return 0;
1440 immediate_quit = false;
1441 return 0;
1442 }
1443 UPDATE_SYNTAX_TABLE_FORWARD (from); 1440 UPDATE_SYNTAX_TABLE_FORWARD (from);
1444 ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); 1441 ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
1445 code = SYNTAX (ch0); 1442 code = SYNTAX (ch0);
@@ -1449,6 +1446,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1449 break; 1446 break;
1450 if (code == Sword) 1447 if (code == Sword)
1451 break; 1448 break;
1449 rarely_quit (from);
1452 } 1450 }
1453 /* Now CH0 is a character which begins a word and FROM is the 1451 /* Now CH0 is a character which begins a word and FROM is the
1454 position of the next character. */ 1452 position of the next character. */
@@ -1477,19 +1475,17 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1477 break; 1475 break;
1478 INC_BOTH (from, from_byte); 1476 INC_BOTH (from, from_byte);
1479 ch0 = ch1; 1477 ch0 = ch1;
1478 rarely_quit (from);
1480 } 1479 }
1481 } 1480 }
1482 count--; 1481 count--;
1483 } 1482 }
1484 while (count < 0) 1483 while (count < 0)
1485 { 1484 {
1486 while (1) 1485 while (true)
1487 { 1486 {
1488 if (from == beg) 1487 if (from == beg)
1489 { 1488 return 0;
1490 immediate_quit = false;
1491 return 0;
1492 }
1493 DEC_BOTH (from, from_byte); 1489 DEC_BOTH (from, from_byte);
1494 UPDATE_SYNTAX_TABLE_BACKWARD (from); 1490 UPDATE_SYNTAX_TABLE_BACKWARD (from);
1495 ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); 1491 ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -1499,6 +1495,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1499 break; 1495 break;
1500 if (code == Sword) 1496 if (code == Sword)
1501 break; 1497 break;
1498 rarely_quit (from);
1502 } 1499 }
1503 /* Now CH1 is a character which ends a word and FROM is the 1500 /* Now CH1 is a character which ends a word and FROM is the
1504 position of it. */ 1501 position of it. */
@@ -1531,13 +1528,12 @@ scan_words (register ptrdiff_t from, register EMACS_INT count)
1531 break; 1528 break;
1532 } 1529 }
1533 ch1 = ch0; 1530 ch1 = ch0;
1531 rarely_quit (from);
1534 } 1532 }
1535 } 1533 }
1536 count++; 1534 count++;
1537 } 1535 }
1538 1536
1539 immediate_quit = false;
1540
1541 return from; 1537 return from;
1542} 1538}
1543 1539
@@ -1921,7 +1917,6 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1921 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; 1917 stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
1922 } 1918 }
1923 1919
1924 immediate_quit = true;
1925 /* This code may look up syntax tables using functions that rely on the 1920 /* This code may look up syntax tables using functions that rely on the
1926 gl_state object. To make sure this object is not out of date, 1921 gl_state object. To make sure this object is not out of date,
1927 let's initialize it manually. 1922 let's initialize it manually.
@@ -1971,9 +1966,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1971 } 1966 }
1972 fwd_ok: 1967 fwd_ok:
1973 p += nbytes, pos++, pos_byte += nbytes; 1968 p += nbytes, pos++, pos_byte += nbytes;
1969 rarely_quit (pos);
1974 } 1970 }
1975 else 1971 else
1976 while (1) 1972 while (true)
1977 { 1973 {
1978 if (p >= stop) 1974 if (p >= stop)
1979 { 1975 {
@@ -1995,15 +1991,14 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
1995 break; 1991 break;
1996 fwd_unibyte_ok: 1992 fwd_unibyte_ok:
1997 p++, pos++, pos_byte++; 1993 p++, pos++, pos_byte++;
1994 rarely_quit (pos);
1998 } 1995 }
1999 } 1996 }
2000 else 1997 else
2001 { 1998 {
2002 if (multibyte) 1999 if (multibyte)
2003 while (1) 2000 while (true)
2004 { 2001 {
2005 unsigned char *prev_p;
2006
2007 if (p <= stop) 2002 if (p <= stop)
2008 { 2003 {
2009 if (p <= endp) 2004 if (p <= endp)
@@ -2011,8 +2006,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2011 p = GPT_ADDR; 2006 p = GPT_ADDR;
2012 stop = endp; 2007 stop = endp;
2013 } 2008 }
2014 prev_p = p; 2009 unsigned char *prev_p = p;
2015 while (--p >= stop && ! CHAR_HEAD_P (*p)); 2010 do
2011 p--;
2012 while (stop <= p && ! CHAR_HEAD_P (*p));
2013
2016 c = STRING_CHAR (p); 2014 c = STRING_CHAR (p);
2017 2015
2018 if (! NILP (iso_classes) && in_classes (c, iso_classes)) 2016 if (! NILP (iso_classes) && in_classes (c, iso_classes))
@@ -2036,9 +2034,10 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2036 } 2034 }
2037 back_ok: 2035 back_ok:
2038 pos--, pos_byte -= prev_p - p; 2036 pos--, pos_byte -= prev_p - p;
2037 rarely_quit (pos);
2039 } 2038 }
2040 else 2039 else
2041 while (1) 2040 while (true)
2042 { 2041 {
2043 if (p <= stop) 2042 if (p <= stop)
2044 { 2043 {
@@ -2060,11 +2059,11 @@ skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim,
2060 break; 2059 break;
2061 back_unibyte_ok: 2060 back_unibyte_ok:
2062 p--, pos--, pos_byte--; 2061 p--, pos--, pos_byte--;
2062 rarely_quit (pos);
2063 } 2063 }
2064 } 2064 }
2065 2065
2066 SET_PT_BOTH (pos, pos_byte); 2066 SET_PT_BOTH (pos, pos_byte);
2067 immediate_quit = false;
2068 2067
2069 SAFE_FREE (); 2068 SAFE_FREE ();
2070 return make_number (PT - start_point); 2069 return make_number (PT - start_point);
@@ -2138,7 +2137,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2138 ptrdiff_t pos_byte = PT_BYTE; 2137 ptrdiff_t pos_byte = PT_BYTE;
2139 unsigned char *p, *endp, *stop; 2138 unsigned char *p, *endp, *stop;
2140 2139
2141 immediate_quit = true;
2142 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); 2140 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
2143 2141
2144 if (forwardp) 2142 if (forwardp)
@@ -2167,6 +2165,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2167 if (! fastmap[SYNTAX (c)]) 2165 if (! fastmap[SYNTAX (c)])
2168 goto done; 2166 goto done;
2169 p += nbytes, pos++, pos_byte += nbytes; 2167 p += nbytes, pos++, pos_byte += nbytes;
2168 rarely_quit (pos);
2170 } 2169 }
2171 while (!parse_sexp_lookup_properties 2170 while (!parse_sexp_lookup_properties
2172 || pos < gl_state.e_property); 2171 || pos < gl_state.e_property);
@@ -2183,10 +2182,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2183 2182
2184 if (multibyte) 2183 if (multibyte)
2185 { 2184 {
2186 while (1) 2185 while (true)
2187 { 2186 {
2188 unsigned char *prev_p;
2189
2190 if (p <= stop) 2187 if (p <= stop)
2191 { 2188 {
2192 if (p <= endp) 2189 if (p <= endp)
@@ -2195,17 +2192,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2195 stop = endp; 2192 stop = endp;
2196 } 2193 }
2197 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); 2194 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
2198 prev_p = p; 2195
2199 while (--p >= stop && ! CHAR_HEAD_P (*p)); 2196 unsigned char *prev_p = p;
2197 do
2198 p--;
2199 while (stop <= p && ! CHAR_HEAD_P (*p));
2200
2200 c = STRING_CHAR (p); 2201 c = STRING_CHAR (p);
2201 if (! fastmap[SYNTAX (c)]) 2202 if (! fastmap[SYNTAX (c)])
2202 break; 2203 break;
2203 pos--, pos_byte -= prev_p - p; 2204 pos--, pos_byte -= prev_p - p;
2205 rarely_quit (pos);
2204 } 2206 }
2205 } 2207 }
2206 else 2208 else
2207 { 2209 {
2208 while (1) 2210 while (true)
2209 { 2211 {
2210 if (p <= stop) 2212 if (p <= stop)
2211 { 2213 {
@@ -2218,13 +2220,13 @@ skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2218 if (! fastmap[SYNTAX (p[-1])]) 2220 if (! fastmap[SYNTAX (p[-1])])
2219 break; 2221 break;
2220 p--, pos--, pos_byte--; 2222 p--, pos--, pos_byte--;
2223 rarely_quit (pos);
2221 } 2224 }
2222 } 2225 }
2223 } 2226 }
2224 2227
2225 done: 2228 done:
2226 SET_PT_BOTH (pos, pos_byte); 2229 SET_PT_BOTH (pos, pos_byte);
2227 immediate_quit = false;
2228 2230
2229 return make_number (PT - start_point); 2231 return make_number (PT - start_point);
2230 } 2232 }
@@ -2286,9 +2288,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2286 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr, 2288 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
2287 EMACS_INT *incomment_ptr, int *last_syntax_ptr) 2289 EMACS_INT *incomment_ptr, int *last_syntax_ptr)
2288{ 2290{
2289 register int c, c1; 2291 unsigned short int quit_count = 0;
2290 register enum syntaxcode code; 2292 int c, c1;
2291 register int syntax, other_syntax; 2293 enum syntaxcode code;
2294 int syntax, other_syntax;
2292 2295
2293 if (nesting <= 0) nesting = -1; 2296 if (nesting <= 0) nesting = -1;
2294 2297
@@ -2380,6 +2383,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2380 UPDATE_SYNTAX_TABLE_FORWARD (from); 2383 UPDATE_SYNTAX_TABLE_FORWARD (from);
2381 nesting++; 2384 nesting++;
2382 } 2385 }
2386
2387 rarely_quit (++quit_count);
2383 } 2388 }
2384 *charpos_ptr = from; 2389 *charpos_ptr = from;
2385 *bytepos_ptr = from_byte; 2390 *bytepos_ptr = from_byte;
@@ -2407,14 +2412,12 @@ between them, return t; otherwise return nil. */)
2407 ptrdiff_t out_charpos, out_bytepos; 2412 ptrdiff_t out_charpos, out_bytepos;
2408 EMACS_INT dummy; 2413 EMACS_INT dummy;
2409 int dummy2; 2414 int dummy2;
2415 unsigned short int quit_count = 0;
2410 2416
2411 CHECK_NUMBER (count); 2417 CHECK_NUMBER (count);
2412 count1 = XINT (count); 2418 count1 = XINT (count);
2413 stop = count1 > 0 ? ZV : BEGV; 2419 stop = count1 > 0 ? ZV : BEGV;
2414 2420
2415 immediate_quit = true;
2416 maybe_quit ();
2417
2418 from = PT; 2421 from = PT;
2419 from_byte = PT_BYTE; 2422 from_byte = PT_BYTE;
2420 2423
@@ -2429,7 +2432,6 @@ between them, return t; otherwise return nil. */)
2429 if (from == stop) 2432 if (from == stop)
2430 { 2433 {
2431 SET_PT_BOTH (from, from_byte); 2434 SET_PT_BOTH (from, from_byte);
2432 immediate_quit = false;
2433 return Qnil; 2435 return Qnil;
2434 } 2436 }
2435 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2437 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2456,6 +2458,7 @@ between them, return t; otherwise return nil. */)
2456 INC_BOTH (from, from_byte); 2458 INC_BOTH (from, from_byte);
2457 UPDATE_SYNTAX_TABLE_FORWARD (from); 2459 UPDATE_SYNTAX_TABLE_FORWARD (from);
2458 } 2460 }
2461 rarely_quit (++quit_count);
2459 } 2462 }
2460 while (code == Swhitespace || (code == Sendcomment && c == '\n')); 2463 while (code == Swhitespace || (code == Sendcomment && c == '\n'));
2461 2464
@@ -2463,7 +2466,6 @@ between them, return t; otherwise return nil. */)
2463 comstyle = ST_COMMENT_STYLE; 2466 comstyle = ST_COMMENT_STYLE;
2464 else if (code != Scomment) 2467 else if (code != Scomment)
2465 { 2468 {
2466 immediate_quit = false;
2467 DEC_BOTH (from, from_byte); 2469 DEC_BOTH (from, from_byte);
2468 SET_PT_BOTH (from, from_byte); 2470 SET_PT_BOTH (from, from_byte);
2469 return Qnil; 2471 return Qnil;
@@ -2474,7 +2476,6 @@ between them, return t; otherwise return nil. */)
2474 from = out_charpos; from_byte = out_bytepos; 2476 from = out_charpos; from_byte = out_bytepos;
2475 if (!found) 2477 if (!found)
2476 { 2478 {
2477 immediate_quit = false;
2478 SET_PT_BOTH (from, from_byte); 2479 SET_PT_BOTH (from, from_byte);
2479 return Qnil; 2480 return Qnil;
2480 } 2481 }
@@ -2486,23 +2487,19 @@ between them, return t; otherwise return nil. */)
2486 2487
2487 while (count1 < 0) 2488 while (count1 < 0)
2488 { 2489 {
2489 while (1) 2490 while (true)
2490 { 2491 {
2491 bool quoted;
2492 int syntax;
2493
2494 if (from <= stop) 2492 if (from <= stop)
2495 { 2493 {
2496 SET_PT_BOTH (BEGV, BEGV_BYTE); 2494 SET_PT_BOTH (BEGV, BEGV_BYTE);
2497 immediate_quit = false;
2498 return Qnil; 2495 return Qnil;
2499 } 2496 }
2500 2497
2501 DEC_BOTH (from, from_byte); 2498 DEC_BOTH (from, from_byte);
2502 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ 2499 /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
2503 quoted = char_quoted (from, from_byte); 2500 bool quoted = char_quoted (from, from_byte);
2504 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2501 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2505 syntax = SYNTAX_WITH_FLAGS (c); 2502 int syntax = SYNTAX_WITH_FLAGS (c);
2506 code = SYNTAX (c); 2503 code = SYNTAX (c);
2507 comstyle = 0; 2504 comstyle = 0;
2508 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); 2505 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
@@ -2545,6 +2542,7 @@ between them, return t; otherwise return nil. */)
2545 } 2542 }
2546 else if (from == stop) 2543 else if (from == stop)
2547 break; 2544 break;
2545 rarely_quit (++quit_count);
2548 } 2546 }
2549 if (fence_found == 0) 2547 if (fence_found == 0)
2550 { 2548 {
@@ -2587,18 +2585,18 @@ between them, return t; otherwise return nil. */)
2587 else if (code != Swhitespace || quoted) 2585 else if (code != Swhitespace || quoted)
2588 { 2586 {
2589 leave: 2587 leave:
2590 immediate_quit = false;
2591 INC_BOTH (from, from_byte); 2588 INC_BOTH (from, from_byte);
2592 SET_PT_BOTH (from, from_byte); 2589 SET_PT_BOTH (from, from_byte);
2593 return Qnil; 2590 return Qnil;
2594 } 2591 }
2592
2593 rarely_quit (++quit_count);
2595 } 2594 }
2596 2595
2597 count1++; 2596 count1++;
2598 } 2597 }
2599 2598
2600 SET_PT_BOTH (from, from_byte); 2599 SET_PT_BOTH (from, from_byte);
2601 immediate_quit = false;
2602 return Qt; 2600 return Qt;
2603} 2601}
2604 2602
@@ -2632,6 +2630,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2632 EMACS_INT dummy; 2630 EMACS_INT dummy;
2633 int dummy2; 2631 int dummy2;
2634 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; 2632 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
2633 unsigned short int quit_count = 0;
2635 2634
2636 if (depth > 0) min_depth = 0; 2635 if (depth > 0) min_depth = 0;
2637 2636
@@ -2640,7 +2639,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2640 2639
2641 from_byte = CHAR_TO_BYTE (from); 2640 from_byte = CHAR_TO_BYTE (from);
2642 2641
2643 immediate_quit = true;
2644 maybe_quit (); 2642 maybe_quit ();
2645 2643
2646 SETUP_SYNTAX_TABLE (from, count); 2644 SETUP_SYNTAX_TABLE (from, count);
@@ -2648,6 +2646,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2648 { 2646 {
2649 while (from < stop) 2647 while (from < stop)
2650 { 2648 {
2649 rarely_quit (++quit_count);
2651 bool comstart_first, prefix; 2650 bool comstart_first, prefix;
2652 int syntax, other_syntax; 2651 int syntax, other_syntax;
2653 UPDATE_SYNTAX_TABLE_FORWARD (from); 2652 UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -2716,6 +2715,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2716 goto done; 2715 goto done;
2717 } 2716 }
2718 INC_BOTH (from, from_byte); 2717 INC_BOTH (from, from_byte);
2718 rarely_quit (++quit_count);
2719 } 2719 }
2720 goto done; 2720 goto done;
2721 2721
@@ -2787,6 +2787,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2787 if (c_code == Scharquote || c_code == Sescape) 2787 if (c_code == Scharquote || c_code == Sescape)
2788 INC_BOTH (from, from_byte); 2788 INC_BOTH (from, from_byte);
2789 INC_BOTH (from, from_byte); 2789 INC_BOTH (from, from_byte);
2790 rarely_quit (++quit_count);
2790 } 2791 }
2791 INC_BOTH (from, from_byte); 2792 INC_BOTH (from, from_byte);
2792 if (!depth && sexpflag) goto done; 2793 if (!depth && sexpflag) goto done;
@@ -2801,7 +2802,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2801 if (depth) 2802 if (depth)
2802 goto lose; 2803 goto lose;
2803 2804
2804 immediate_quit = false;
2805 return Qnil; 2805 return Qnil;
2806 2806
2807 /* End of object reached */ 2807 /* End of object reached */
@@ -2813,11 +2813,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2813 { 2813 {
2814 while (from > stop) 2814 while (from > stop)
2815 { 2815 {
2816 int syntax; 2816 rarely_quit (++quit_count);
2817 DEC_BOTH (from, from_byte); 2817 DEC_BOTH (from, from_byte);
2818 UPDATE_SYNTAX_TABLE_BACKWARD (from); 2818 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2819 c = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2819 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2820 syntax= SYNTAX_WITH_FLAGS (c); 2820 int syntax = SYNTAX_WITH_FLAGS (c);
2821 code = syntax_multibyte (c, multibyte_symbol_p); 2821 code = syntax_multibyte (c, multibyte_symbol_p);
2822 if (depth == min_depth) 2822 if (depth == min_depth)
2823 last_good = from; 2823 last_good = from;
@@ -2889,6 +2889,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2889 default: goto done2; 2889 default: goto done2;
2890 } 2890 }
2891 DEC_BOTH (from, from_byte); 2891 DEC_BOTH (from, from_byte);
2892 rarely_quit (++quit_count);
2892 } 2893 }
2893 goto done2; 2894 goto done2;
2894 2895
@@ -2951,13 +2952,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2951 if (syntax_multibyte (c, multibyte_symbol_p) == code) 2952 if (syntax_multibyte (c, multibyte_symbol_p) == code)
2952 break; 2953 break;
2953 } 2954 }
2955 rarely_quit (++quit_count);
2954 } 2956 }
2955 if (code == Sstring_fence && !depth && sexpflag) goto done2; 2957 if (code == Sstring_fence && !depth && sexpflag) goto done2;
2956 break; 2958 break;
2957 2959
2958 case Sstring: 2960 case Sstring:
2959 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); 2961 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2960 while (1) 2962 while (true)
2961 { 2963 {
2962 if (from == stop) 2964 if (from == stop)
2963 goto lose; 2965 goto lose;
@@ -2971,6 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2971 == Sstring)) 2973 == Sstring))
2972 break; 2974 break;
2973 } 2975 }
2976 rarely_quit (++quit_count);
2974 } 2977 }
2975 if (!depth && sexpflag) goto done2; 2978 if (!depth && sexpflag) goto done2;
2976 break; 2979 break;
@@ -2984,7 +2987,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2984 if (depth) 2987 if (depth)
2985 goto lose; 2988 goto lose;
2986 2989
2987 immediate_quit = false;
2988 return Qnil; 2990 return Qnil;
2989 2991
2990 done2: 2992 done2:
@@ -2992,7 +2994,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2992 } 2994 }
2993 2995
2994 2996
2995 immediate_quit = false;
2996 XSETFASTINT (val, from); 2997 XSETFASTINT (val, from);
2997 return val; 2998 return val;
2998 2999
@@ -3085,6 +3086,7 @@ the prefix syntax flag (p). */)
3085 if (pos <= beg) 3086 if (pos <= beg)
3086 break; 3087 break;
3087 DEC_BOTH (pos, pos_byte); 3088 DEC_BOTH (pos, pos_byte);
3089 rarely_quit (pos);
3088 } 3090 }
3089 3091
3090 SET_PT_BOTH (opoint, opoint_byte); 3092 SET_PT_BOTH (opoint, opoint_byte);
@@ -3155,6 +3157,7 @@ scan_sexps_forward (struct lisp_parse_state *state,
3155 bool found; 3157 bool found;
3156 ptrdiff_t out_bytepos, out_charpos; 3158 ptrdiff_t out_bytepos, out_charpos;
3157 int temp; 3159 int temp;
3160 unsigned short int quit_count = 0;
3158 3161
3159 prev_from = from; 3162 prev_from = from;
3160 prev_from_byte = from_byte; 3163 prev_from_byte = from_byte;
@@ -3173,7 +3176,6 @@ do { prev_from = from; \
3173 UPDATE_SYNTAX_TABLE_FORWARD (from); \ 3176 UPDATE_SYNTAX_TABLE_FORWARD (from); \
3174 } while (0) 3177 } while (0)
3175 3178
3176 immediate_quit = true;
3177 maybe_quit (); 3179 maybe_quit ();
3178 3180
3179 depth = state->depth; 3181 depth = state->depth;
@@ -3225,6 +3227,7 @@ do { prev_from = from; \
3225 3227
3226 while (from < end) 3228 while (from < end)
3227 { 3229 {
3230 rarely_quit (++quit_count);
3228 INC_FROM; 3231 INC_FROM;
3229 3232
3230 if ((from < end) 3233 if ((from < end)
@@ -3281,6 +3284,7 @@ do { prev_from = from; \
3281 goto symdone; 3284 goto symdone;
3282 } 3285 }
3283 INC_FROM; 3286 INC_FROM;
3287 rarely_quit (++quit_count);
3284 } 3288 }
3285 symdone: 3289 symdone:
3286 curlevel->prev = curlevel->last; 3290 curlevel->prev = curlevel->last;
@@ -3391,6 +3395,7 @@ do { prev_from = from; \
3391 break; 3395 break;
3392 } 3396 }
3393 INC_FROM; 3397 INC_FROM;
3398 rarely_quit (++quit_count);
3394 } 3399 }
3395 } 3400 }
3396 string_end: 3401 string_end:
@@ -3432,7 +3437,6 @@ do { prev_from = from; \
3432 state->levelstarts); 3437 state->levelstarts);
3433 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax) 3438 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
3434 || state->quoted) ? prev_from_syntax : Smax; 3439 || state->quoted) ? prev_from_syntax : Smax;
3435 immediate_quit = false;
3436} 3440}
3437 3441
3438/* Convert a (lisp) parse state to the internal form used in 3442/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index e172dc0aed4..91b2a5cb943 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -382,19 +382,23 @@ get_child_status (pid_t child, int *status, int options, bool interruptible)
382 so that another thread running glib won't find them. */ 382 so that another thread running glib won't find them. */
383 eassert (child > 0); 383 eassert (child > 0);
384 384
385 while ((pid = waitpid (child, status, options)) < 0) 385 while (true)
386 { 386 {
387 /* Note: the MS-Windows emulation of waitpid calls maybe_quit
388 internally. */
389 if (interruptible)
390 maybe_quit ();
391
392 pid = waitpid (child, status, options);
393 if (0 <= pid)
394 break;
395
387 /* Check that CHILD is a child process that has not been reaped, 396 /* Check that CHILD is a child process that has not been reaped,
388 and that STATUS and OPTIONS are valid. Otherwise abort, 397 and that STATUS and OPTIONS are valid. Otherwise abort,
389 as continuing after this internal error could cause Emacs to 398 as continuing after this internal error could cause Emacs to
390 become confused and kill innocent-victim processes. */ 399 become confused and kill innocent-victim processes. */
391 if (errno != EINTR) 400 if (errno != EINTR)
392 emacs_abort (); 401 emacs_abort ();
393
394 /* Note: the MS-Windows emulation of waitpid calls maybe_quit
395 internally. */
396 if (interruptible)
397 maybe_quit ();
398 } 402 }
399 403
400 /* If successful and status is requested, tell wait_reading_process_output 404 /* If successful and status is requested, tell wait_reading_process_output
@@ -2503,78 +2507,113 @@ emacs_close (int fd)
2503#define MAX_RW_COUNT (INT_MAX >> 18 << 18) 2507#define MAX_RW_COUNT (INT_MAX >> 18 << 18)
2504#endif 2508#endif
2505 2509
2506/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted. 2510/* Read from FD to a buffer BUF with size NBYTE.
2511 If interrupted, process any quits and pending signals immediately
2512 if INTERRUPTIBLE, and then retry the read unless quitting.
2507 Return the number of bytes read, which might be less than NBYTE. 2513 Return the number of bytes read, which might be less than NBYTE.
2508 On error, set errno and return -1. */ 2514 On error, set errno to a value other than EINTR, and return -1. */
2509ptrdiff_t 2515static ptrdiff_t
2510emacs_read (int fildes, void *buf, ptrdiff_t nbyte) 2516emacs_intr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible)
2511{ 2517{
2512 ssize_t rtnval; 2518 ssize_t result;
2513 2519
2514 /* There is no need to check against MAX_RW_COUNT, since no caller ever 2520 /* There is no need to check against MAX_RW_COUNT, since no caller ever
2515 passes a size that large to emacs_read. */ 2521 passes a size that large to emacs_read. */
2522 do
2523 {
2524 if (interruptible)
2525 maybe_quit ();
2526 result = read (fd, buf, nbyte);
2527 }
2528 while (result < 0 && errno == EINTR);
2516 2529
2517 while ((rtnval = read (fildes, buf, nbyte)) == -1 2530 return result;
2518 && (errno == EINTR))
2519 maybe_quit ();
2520 return (rtnval);
2521} 2531}
2522 2532
2523/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted 2533/* Read from FD to a buffer BUF with size NBYTE.
2524 or if a partial write occurs. If interrupted, process pending 2534 If interrupted, retry the read. Return the number of bytes read,
2525 signals if PROCESS SIGNALS. Return the number of bytes written, setting 2535 which might be less than NBYTE. On error, set errno to a value
2526 errno if this is less than NBYTE. */ 2536 other than EINTR, and return -1. */
2537ptrdiff_t
2538emacs_read (int fd, void *buf, ptrdiff_t nbyte)
2539{
2540 return emacs_intr_read (fd, buf, nbyte, false);
2541}
2542
2543/* Like emacs_read, but also process quits and pending signals. */
2544ptrdiff_t
2545emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte)
2546{
2547 return emacs_intr_read (fd, buf, nbyte, true);
2548}
2549
2550/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
2551 interrupted or if a partial write occurs. Process any quits
2552 immediately if INTERRUPTIBLE is positive, and process any pending
2553 signals immediately if INTERRUPTIBLE is nonzero. Return the number
2554 of bytes written; if this is less than NBYTE, set errno to a value
2555 other than EINTR. */
2527static ptrdiff_t 2556static ptrdiff_t
2528emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte, 2557emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte,
2529 bool process_signals) 2558 int interruptible)
2530{ 2559{
2531 ptrdiff_t bytes_written = 0; 2560 ptrdiff_t bytes_written = 0;
2532 2561
2533 while (nbyte > 0) 2562 while (nbyte > 0)
2534 { 2563 {
2535 ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT)); 2564 ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT));
2536 2565
2537 if (n < 0) 2566 if (n < 0)
2538 { 2567 {
2539 if (errno == EINTR) 2568 if (errno != EINTR)
2569 break;
2570
2571 if (interruptible)
2540 { 2572 {
2541 /* I originally used maybe_quit but that might cause files to 2573 if (0 < interruptible)
2542 be truncated if you hit C-g in the middle of it. --Stef */ 2574 maybe_quit ();
2543 if (process_signals && pending_signals) 2575 if (pending_signals)
2544 process_pending_signals (); 2576 process_pending_signals ();
2545 continue;
2546 } 2577 }
2547 else
2548 break;
2549 } 2578 }
2550 2579 else
2551 buf += n; 2580 {
2552 nbyte -= n; 2581 buf += n;
2553 bytes_written += n; 2582 nbyte -= n;
2583 bytes_written += n;
2584 }
2554 } 2585 }
2555 2586
2556 return bytes_written; 2587 return bytes_written;
2557} 2588}
2558 2589
2559/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if 2590/* Write to FD from a buffer BUF with size NBYTE, retrying if
2560 interrupted or if a partial write occurs. Return the number of 2591 interrupted or if a partial write occurs. Do not process quits or
2561 bytes written, setting errno if this is less than NBYTE. */ 2592 pending signals. Return the number of bytes written, setting errno
2593 if this is less than NBYTE. */
2594ptrdiff_t
2595emacs_write (int fd, void const *buf, ptrdiff_t nbyte)
2596{
2597 return emacs_full_write (fd, buf, nbyte, 0);
2598}
2599
2600/* Like emacs_write, but also process pending signals. */
2562ptrdiff_t 2601ptrdiff_t
2563emacs_write (int fildes, void const *buf, ptrdiff_t nbyte) 2602emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte)
2564{ 2603{
2565 return emacs_full_write (fildes, buf, nbyte, 0); 2604 return emacs_full_write (fd, buf, nbyte, -1);
2566} 2605}
2567 2606
2568/* Like emacs_write, but also process pending signals if interrupted. */ 2607/* Like emacs_write, but also process quits and pending signals. */
2569ptrdiff_t 2608ptrdiff_t
2570emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte) 2609emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
2571{ 2610{
2572 return emacs_full_write (fildes, buf, nbyte, 1); 2611 return emacs_full_write (fd, buf, nbyte, 1);
2573} 2612}
2574 2613
2575/* Write a diagnostic to standard error that contains MESSAGE and a 2614/* Write a diagnostic to standard error that contains MESSAGE and a
2576 string derived from errno. Preserve errno. Do not buffer stderr. 2615 string derived from errno. Preserve errno. Do not buffer stderr.
2577 Do not process pending signals if interrupted. */ 2616 Do not process quits or pending signals if interrupted. */
2578void 2617void
2579emacs_perror (char const *message) 2618emacs_perror (char const *message)
2580{ 2619{
@@ -3168,7 +3207,7 @@ system_process_attributes (Lisp_Object pid)
3168 else 3207 else
3169 { 3208 {
3170 record_unwind_protect_int (close_file_unwind, fd); 3209 record_unwind_protect_int (close_file_unwind, fd);
3171 nread = emacs_read (fd, procbuf, sizeof procbuf - 1); 3210 nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1);
3172 } 3211 }
3173 if (0 < nread) 3212 if (0 < nread)
3174 { 3213 {
@@ -3289,7 +3328,7 @@ system_process_attributes (Lisp_Object pid)
3289 /* Leave room even if every byte needs escaping below. */ 3328 /* Leave room even if every byte needs escaping below. */
3290 readsize = (cmdline_size >> 1) - nread; 3329 readsize = (cmdline_size >> 1) - nread;
3291 3330
3292 nread_incr = emacs_read (fd, cmdline + nread, readsize); 3331 nread_incr = emacs_read_quit (fd, cmdline + nread, readsize);
3293 nread += max (0, nread_incr); 3332 nread += max (0, nread_incr);
3294 } 3333 }
3295 while (nread_incr == readsize); 3334 while (nread_incr == readsize);
@@ -3402,7 +3441,7 @@ system_process_attributes (Lisp_Object pid)
3402 else 3441 else
3403 { 3442 {
3404 record_unwind_protect_int (close_file_unwind, fd); 3443 record_unwind_protect_int (close_file_unwind, fd);
3405 nread = emacs_read (fd, &pinfo, sizeof pinfo); 3444 nread = emacs_read_quit (fd, &pinfo, sizeof pinfo);
3406 } 3445 }
3407 3446
3408 if (nread == sizeof pinfo) 3447 if (nread == sizeof pinfo)
diff --git a/src/w32fns.c b/src/w32fns.c
index 6a576fcec27..1b628b0b42e 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -3168,16 +3168,7 @@ signal_user_input (void)
3168 Vquit_flag = Vthrow_on_input; 3168 Vquit_flag = Vthrow_on_input;
3169 /* Calling maybe_quit from this thread is a bad idea, since this 3169 /* Calling maybe_quit from this thread is a bad idea, since this
3170 unwinds the stack of the Lisp thread, and the Windows runtime 3170 unwinds the stack of the Lisp thread, and the Windows runtime
3171 rightfully barfs. Disabled. */ 3171 rightfully barfs. */
3172#if 0
3173 /* If we're inside a function that wants immediate quits,
3174 do it now. */
3175 if (immediate_quit && NILP (Vinhibit_quit))
3176 {
3177 immediate_quit = false;
3178 maybe_quit ();
3179 }
3180#endif
3181 } 3172 }
3182} 3173}
3183 3174
diff --git a/src/window.c b/src/window.c
index 71a82b522c4..bc3f488f37f 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4770,7 +4770,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
4770{ 4770{
4771 ptrdiff_t count = SPECPDL_INDEX (); 4771 ptrdiff_t count = SPECPDL_INDEX ();
4772 4772
4773 immediate_quit = true;
4774 n = clip_to_bounds (INT_MIN, n, INT_MAX); 4773 n = clip_to_bounds (INT_MIN, n, INT_MAX);
4775 4774
4776 wset_redisplay (XWINDOW (window)); 4775 wset_redisplay (XWINDOW (window));
@@ -4789,7 +4788,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
4789 4788
4790 /* Bug#15957. */ 4789 /* Bug#15957. */
4791 XWINDOW (window)->window_end_valid = false; 4790 XWINDOW (window)->window_end_valid = false;
4792 immediate_quit = false;
4793} 4791}
4794 4792
4795 4793
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
new file mode 100644
index 00000000000..807a411fa5d
--- /dev/null
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -0,0 +1,203 @@
1;; Copyright (C) 2017 Free Software Foundation, Inc
2
3;; Author: Dima Kogan <dima@secretsauce.net>
4;; Maintainer: emacs-devel@gnu.org
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20
21;;; Code:
22
23(require 'diff-mode)
24
25
26(ert-deftest diff-mode-test-ignore-trailing-dashes ()
27 "Check to make sure we successfully ignore trailing -- made by
28'git format-patch'. This is bug #9597"
29
30 ;; I made a test repo, put some files in it, made arbitrary changes
31 ;; and invoked 'git format-patch' to get a patch out of it. The
32 ;; patch and the before and after versions of the files appear here.
33 ;; The test simply tries to apply the patch. The patch contains
34 ;; trailing --, which confused diff-mode previously
35 (let ((patch "From 18ed35640be496647e0a02fc155b4ee4a0490eca Mon Sep 17 00:00:00 2001
36From: Dima Kogan <dima@secretsauce.net>
37Date: Mon, 30 Jan 2017 22:24:13 -0800
38Subject: [PATCH] test commit
39
40---
41 fil | 3 ---
42 fil2 | 4 ----
43 2 files changed, 7 deletions(-)
44
45diff --git a/fil b/fil
46index 10344f1..2a56245 100644
47--- a/fil
48+++ b/fil
49@@ -2,10 +2,8 @@ Afrocentrism
50 Americanisms
51 Americanization
52 Americanizations
53-Americanized
54 Americanizes
55 Americanizing
56-Andrianampoinimerina
57 Anglicanisms
58 Antananarivo
59 Apalachicola
60@@ -15,6 +13,5 @@ Aristophanes
61 Aristotelian
62 Ashurbanipal
63 Australopithecus
64-Austronesian
65 Bangladeshis
66 Barquisimeto
67diff --git a/fil2 b/fil2
68index 8858f0d..86e8ea5 100644
69--- a/fil2
70+++ b/fil2
71@@ -1,20 +1,16 @@
72 whippoorwills
73 whitewashing
74 wholehearted
75-wholeheartedly
76 wholesomeness
77 wildernesses
78 windbreakers
79 wisecracking
80 withstanding
81-woodcarvings
82 woolgathering
83 workstations
84 worthlessness
85 wretchedness
86 wristwatches
87-wrongfulness
88 wrongheadedly
89 wrongheadedness
90-xylophonists
91 youthfulness
92--
932.11.0
94
95")
96 (fil_before "Afrocentrism
97Americanisms
98Americanization
99Americanizations
100Americanized
101Americanizes
102Americanizing
103Andrianampoinimerina
104Anglicanisms
105Antananarivo
106Apalachicola
107Appalachians
108Argentinians
109Aristophanes
110Aristotelian
111Ashurbanipal
112Australopithecus
113Austronesian
114Bangladeshis
115Barquisimeto
116")
117 (fil_after "Afrocentrism
118Americanisms
119Americanization
120Americanizations
121Americanizes
122Americanizing
123Anglicanisms
124Antananarivo
125Apalachicola
126Appalachians
127Argentinians
128Aristophanes
129Aristotelian
130Ashurbanipal
131Australopithecus
132Bangladeshis
133Barquisimeto
134")
135 (fil2_before "whippoorwills
136whitewashing
137wholehearted
138wholeheartedly
139wholesomeness
140wildernesses
141windbreakers
142wisecracking
143withstanding
144woodcarvings
145woolgathering
146workstations
147worthlessness
148wretchedness
149wristwatches
150wrongfulness
151wrongheadedly
152wrongheadedness
153xylophonists
154youthfulness
155")
156 (fil2_after "whippoorwills
157whitewashing
158wholehearted
159wholesomeness
160wildernesses
161windbreakers
162wisecracking
163withstanding
164woolgathering
165workstations
166worthlessness
167wretchedness
168wristwatches
169wrongheadedly
170wrongheadedness
171youthfulness
172")
173 (temp-dir (make-temp-file "diff-mode-test" 'dir)))
174
175 (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
176 (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
177 (unwind-protect
178 (progn
179 (with-current-buffer buf (insert fil_before) (save-buffer))
180 (with-current-buffer buf2 (insert fil2_before) (save-buffer))
181
182 (with-temp-buffer
183 (cd temp-dir)
184 (insert patch)
185 (beginning-of-buffer)
186 (diff-apply-hunk)
187 (diff-apply-hunk)
188 (diff-apply-hunk))
189
190 (should (equal (with-current-buffer buf (buffer-string))
191 fil_after))
192 (should (equal (with-current-buffer buf2 (buffer-string))
193 fil2_after)))
194
195 (ignore-errors
196 (with-current-buffer buf (set-buffer-modified-p nil))
197 (kill-buffer buf)
198 (with-current-buffer buf2 (set-buffer-modified-p nil))
199 (kill-buffer buf2)
200 (delete-directory temp-dir 'recursive))))))
201
202
203(provide 'diff-mode-tests)