[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] nick.lloyd-bytecode-jit 9a15b55 3/3: Merge branch 'master'
|
From: |
Nickolas Lloyd |
|
Subject: |
[Emacs-diffs] nick.lloyd-bytecode-jit 9a15b55 3/3: Merge branch 'master' into nick.lloyd-bytecode-jit |
|
Date: |
Thu, 2 Feb 2017 03:33:00 +0000 (UTC) |
branch: nick.lloyd-bytecode-jit
commit 9a15b5509abb49a11c97c1101ad216f4ef258368
Merge: 5d8f254 70d36dd
Author: Nickolas Lloyd <address@hidden>
Commit: Nickolas Lloyd <address@hidden>
Merge branch 'master' into nick.lloyd-bytecode-jit
---
admin/notes/multi-tty | 5 +-
doc/misc/cc-mode.texi | 31 ++++--
etc/NEWS | 2 +-
lisp/auth-source.el | 2 +-
lisp/calendar/parse-time.el | 12 +--
lisp/comint.el | 11 +--
lisp/emacs-lisp/debug.el | 54 -----------
lisp/emacs-lisp/let-alist.el | 2 +-
lisp/emacs-lisp/subr-x.el | 5 +
lisp/gnus/gnus-art.el | 7 +-
lisp/image-dired.el | 8 +-
lisp/net/tramp.el | 30 ++++--
lisp/progmodes/cc-align.el | 12 +++
lisp/progmodes/cc-engine.el | 101 +++++++++++++------
lisp/progmodes/cc-styles.el | 1 +
lisp/progmodes/cc-vars.el | 2 +-
lisp/shell.el | 2 -
lisp/vc/diff-mode.el | 26 +++--
src/alloc.c | 26 +++--
src/bytecode.c | 20 ++--
src/callproc.c | 18 +---
src/data.c | 50 ----------
src/dired.c | 3 -
src/doc.c | 9 +-
src/editfns.c | 10 +-
src/eval.c | 15 ++-
src/fileio.c | 74 +++++---------
src/filelock.c | 7 +-
src/fns.c | 99 ++++++-------------
src/indent.c | 13 ++-
src/keyboard.c | 93 +++++-------------
src/lisp.h | 42 ++++----
src/lread.c | 2 +-
src/process.c | 10 +-
src/regex.c | 10 +-
src/search.c | 98 +++++++------------
src/syntax.c | 140 ++++++++++++++-------------
src/sysdep.c | 129 ++++++++++++++++---------
src/w32fns.c | 11 +--
src/window.c | 2 -
test/lisp/vc/diff-mode-tests.el | 203 +++++++++++++++++++++++++++++++++++++++
41 files changed, 735 insertions(+), 662 deletions(-)
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index b58180e..d0096ad 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1239,9 +1239,8 @@ DIARY OF CHANGES
(Update: OK, it all seems so easy now (NOT). Input could be done
synchronously (with wait_reading_process_input), or asynchronously
by SIGIO or polling (SIGALRM). C-g either sets the Vquit_flag,
- signals a 'quit condition (when immediate_quit), or throws to
- 'getcjmp' when Emacs was waiting for input when the C-g event
- arrived.)
+ signals a 'quit condition, or throws to 'getcjmp' when Emacs was
+ waiting for input when the C-g event arrived.)
-- Replace wrong_kboard_jmpbuf with a special return value of
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 68a16c0..14981c9 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}.
@item brace-list-close
Close brace of an enum or static array list. @ref{Brace List Symbols}.
@item brace-list-intro
-First line in an enum or static array list. @ref{Brace List Symbols}.
+First line after the opening @address@hidden in an enum or static array
+list. @ref{Brace List Symbols}.
@item brace-list-entry
Subsequent lines in an enum or static array list. @ref{Brace List
Symbols}.
@@ -4635,11 +4636,18 @@ example:
Here, you've already seen the analysis of lines 1, 2, 3, and 11. On
line 4, things get interesting; this line is assigned
address@hidden syntactic symbol because it's a bracelist entry
-line that starts with an open brace. Lines 5 and 6 (and line 9) are
-pretty standard, and line 7 is a @code{brace-list-close} as you'd
-expect. Once again, line 8 is assigned as @code{brace-entry-open} as is
-line 10.
address@hidden syntactic symbol because it's a bracelist
+entry line that starts with an open brace. Lines 5 and 6 are pretty
+standard, and line 7 is a @code{brace-list-close} as you'd expect.
+Once again, line 8 is assigned as @code{brace-entry-open} as is line
+10. Line 9 is assigned two syntactic elements, @code{brace-list-intro}
+with anchor point at the @address@hidden of line address@hidden extra
+syntactic element was introduced in @ccmode{} 5.33.1 to allow extra
+flexibility in indenting the second line of such a construct. You can
+preserve the behaviour resulting from the former syntactic analysis by
+giving @code{brace-list-entry} an offset of
address@hidden (@pxref{Misc Line-Up}).}, and
address@hidden anchored on the @samp{1} of line 8.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@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.
@comment ------------------------------------------------------------
address@hidden c-lineup-under-anchor
+
+Line up a line directly underneath its anchor point. This is like
address@hidden, except any previously calculated offset contributions are
+disregarded.
+
address@hidden Any syntactic symbol which has an anchor point.
address@hidden defun
+
address@hidden ------------------------------------------------------------
+
@defun c-lineup-cpp-define
@findex lineup-cpp-define (c-)
Line up macro continuation lines according to the indentation of the
diff --git a/etc/NEWS b/etc/NEWS
index 18ab162..86a8385 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -614,7 +614,7 @@ Completion candidates for HTML classes and IDs are
retrieved from open
HTML mode buffers.
---
-*** CSS mode now binds 'C-h s' to a function that will show
+*** CSS mode now binds 'C-h S' to a function that will show
information about a CSS construct (an at-rule, property, pseudo-class,
pseudo-element, with the default being guessed from context). By
default the information is looked up on the Mozilla Developer Network,
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index c26935f..7402ab2 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -2129,7 +2129,7 @@ MODE can be \"login\" or \"password\"."
(if user
(auth-source-search
:host host
- :user "yourusername"
+ :user user
:max 1
:require '(:user :secret)
:create nil)
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 7651c5d..b781cb0 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -1,4 +1,4 @@
-;;; parse-time.el --- parsing time strings
+;;; parse-time.el --- parsing time strings -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc.
@@ -203,12 +203,9 @@ any values that are unknown are returned as nil."
(time-second 2digit)
(time-secfrac "\\(\\.[0-9]+\\)?")
(time-numoffset (concat "\\([-+]\\)" time-hour ":?" time-minute "?"))
- (time-offset (concat "Z" time-numoffset))
(partial-time (concat time-hour colon time-minute colon time-second
time-secfrac))
- (full-date (concat date-fullyear dash date-month dash date-mday))
- (full-time (concat partial-time time-offset))
- (date-time (concat full-date "T" full-time)))
+ (full-date (concat date-fullyear dash date-month dash date-mday)))
(list (concat "^" full-date)
(concat "T" partial-time)
(concat "\\(Z\\|" time-numoffset "\\)")))
@@ -225,7 +222,7 @@ If DATE-STRING cannot be parsed, it falls back to
(time-re (nth 1 parse-time-iso8601-regexp))
(tz-re (nth 2 parse-time-iso8601-regexp))
re-start
- time seconds minute hour fractional-seconds
+ time seconds minute hour
day month year day-of-week dst tz)
;; We need to populate 'time' with
;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
@@ -240,9 +237,6 @@ If DATE-STRING cannot be parsed, it falls back to
(setq hour (string-to-number (match-string 1 date-string))
minute (string-to-number (match-string 2 date-string))
seconds (string-to-number (match-string 3 date-string))
- fractional-seconds (string-to-number (or
- (match-string 4
date-string)
- "0"))
re-start (match-end 0))
(when (string-match tz-re date-string re-start)
(if (string= "Z" (match-string 1 date-string))
diff --git a/lisp/comint.el b/lisp/comint.el
index c82c3d0..830f4ca 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1879,7 +1879,6 @@ Similarly for Soar, Scheme, etc."
(let ((echo-len (- comint-last-input-end
comint-last-input-start)))
;; Wait for all input to be echoed:
-
(while (and (> (+ comint-last-input-end echo-len)
(point-max))
(accept-process-output proc)
@@ -1891,7 +1890,6 @@ Similarly for Soar, Scheme, etc."
;; (+ comint-last-input-start
;; (- (point-max) comint-last-input-end))
nil comint-last-input-end (point-max)))))
-
(if (and
(<= (+ comint-last-input-end echo-len)
(point-max))
@@ -1903,7 +1901,6 @@ Similarly for Soar, Scheme, etc."
;; Certain parts of the text to be deleted may have
;; been mistaken for prompts. We have to prevent
;; problems when `comint-prompt-read-only' is non-nil.
-
(let ((inhibit-read-only t))
(delete-region comint-last-input-end
(+ comint-last-input-end echo-len))
@@ -1912,7 +1909,6 @@ Similarly for Soar, Scheme, etc."
(goto-char comint-last-input-end)
(comint-update-fence)))))))
-
;; This used to call comint-output-filter-functions,
;; but that scrolled the buffer in undesirable ways.
(run-hook-with-args 'comint-output-filter-functions "")))))
@@ -2243,7 +2239,10 @@ the current line with any initial string matching the
regexp
(null (get-char-property (setq bof (field-beginning)) 'field)))
(field-string-no-properties bof)
(comint-bol)
- (buffer-substring-no-properties (point) (line-end-position)))))
+ (buffer-substring-no-properties (point)
+ (if comint-use-prompt-regexp
+ (line-end-position)
+ (field-end))))))
(defun comint-copy-old-input ()
"Insert after prompt old input at point as new input to be edited.
@@ -2670,7 +2669,7 @@ This command is like `M-.' in bash."
(set-marker comint-insert-previous-argument-last-start-pos (point))
;; Insert the argument.
(let ((input-string (comint-previous-input-string 0)))
- (when (string-match "[ \t\n]*&[ \t\n]*$" input-string)
+ (when (string-match "[ \t\n]*&" input-string)
;; strip terminating '&'
(setq input-string (substring input-string 0 (match-beginning 0))))
(insert (comint-arguments input-string index index)))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index faa323f..cb77148 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -816,60 +816,6 @@ Redefining FUNCTION also cancels it."
'((depth . -100)))
function)
-;;;###autoload
-;; (defun debug-on-set (symbol)
-;; "Request FUNCTION to invoke debugger each time it is called.
-
-;; When called interactively, prompt for FUNCTION in the minibuffer.
-
-;; This works by modifying the definition of FUNCTION. If you tell the
-;; debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a
-;; normal function or a macro written in Lisp, you can also step through
-;; its execution. FUNCTION can also be a primitive that is not a special
-;; form, in which case stepping is not possible. Break-on-entry for
-;; primitive functions only works when that function is called from Lisp.
-
-;; Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-;; Redefining FUNCTION also cancels it."
-;; (interactive
-;; (let ((v (variable-at-point))
-;; (enable-recursive-minibuffers t)
-;; (orig-buffer (current-buffer))
-;; val)
-;; (setq val (completing-read
-;; (if (symbolp v)
-;; (format
-;; "Debug on set to symbol (default %s): " v)
-;; "Debug on set to symbol: ")
-;; #'help--symbol-completion-table
-;; (lambda (vv)
-;; ;; In case the variable only exists in the buffer
-;; ;; the command we switch back to that buffer before
-;; ;; we examine the variable.
-;; (with-current-buffer orig-buffer
-;; (or (get vv 'variable-documentation)
-;; (and (boundp vv) (not (keywordp vv))))))
-;; t nil nil
-;; (if (symbolp v) (symbol-name v))))
-;; (list (if (equal val "")
-;; v (intern val)))))
-
-
-
-;; (interactive
-;; (let* ((var-default (variable-at-point))
-;; (var (completing-read
-;; (if var-default
-;; (format "Debug on set to symbol (default %s): " var-default)
-;; "Debug on set to symbol: ")
-;; nil
-;; #'boundp
-;; t nil nil (symbol-name var-default))))
-;; (list (if (equal var "") var-default (intern var)))))
-;; (advice-add function :before #'debug--implement-debug-on-entry
-;; '((depth . -100)))
-;; function)
-
(defun debug--function-list ()
"List of functions currently set for debug on entry."
(let ((funs '()))
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index a45fc0a..cf82fe3 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -4,7 +4,7 @@
;; Author: Artur Malabarba <address@hidden>
;; Package-Requires: ((emacs "24.1"))
-;; Version: 1.0.4
+;; Version: 1.0.5
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 7736225..52331b9 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,
perform the requested window recentering or scrolling and ask
again.
+When `use-dialog-box' is t (the default), this function can pop
+up a dialog window to collect the user input. That functionality
+requires `display-popup-menus-p' to return t. Otherwise, a text
+dialog will be used.
+
The return value is the matching entry from the CHOICES list.
Usage example:
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 43e1231..a4ff840 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1713,9 +1713,10 @@ regexp."
;; (modify-syntax-entry ?- "w" table)
(modify-syntax-entry ?> ")<" table)
(modify-syntax-entry ?< "(>" table)
- ;; make M-. in article buffers work for `foo' strings
- (modify-syntax-entry ?' " " table)
- (modify-syntax-entry ?` " " table)
+ ;; make M-. in article buffers work for `foo' strings,
+ ;; and still allow C-s C-w to yank ' to the search ring
+ (modify-syntax-entry ?' "'" table)
+ (modify-syntax-entry ?` "'" table)
table)
"Syntax table used in article mode buffers.
Initialized from `text-mode-syntax-table'.")
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 901225f..2a40645 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -94,6 +94,7 @@
;; * WARNING: The "database" format used might be changed so keep a
;; backup of `image-dired-db-file' when testing new versions.
;;
+;; * `image-dired-display-image-mode' does not support animation
;;
;; TODO
;; ====
@@ -228,7 +229,7 @@ Used together with
`image-dired-cmd-create-thumbnail-options'."
:group 'image-dired)
(defcustom image-dired-cmd-create-thumbnail-options
- '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
"Options of command used to create thumbnail image.
Used with `image-dired-cmd-create-thumbnail-program'.
Available format specifiers are: %w which is replaced by
@@ -246,7 +247,7 @@ Used together with
`image-dired-cmd-create-temp-image-options'."
:group 'image-dired)
(defcustom image-dired-cmd-create-temp-image-options
- '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ '("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
"Options of command used to create temporary image for display window.
Used together with `image-dired-cmd-create-temp-image-program',
Available format specifiers are: %w and %h which are replaced by
@@ -316,7 +317,7 @@ Available format specifiers are described in
:group 'image-dired)
(defcustom image-dired-cmd-create-standard-thumbnail-options
- (append '("-size" "%wx%h" "%f")
+ (append '("-size" "%wx%h" "%f[0]")
(unless (or image-dired-cmd-pngcrush-program
image-dired-cmd-pngnq-program)
(list
@@ -1626,6 +1627,7 @@ Resized or in full-size."
:group 'image-dired
(buffer-disable-undo)
(image-mode-setup-winprops)
+ (setq cursor-type nil)
(add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil
t))
(defvar image-dired-minor-mode-map
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index fc7fdd3..48dcd5e 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3614,18 +3614,36 @@ connection buffer."
;;; Utility functions:
-(defun tramp-accept-process-output (&optional proc timeout timeout-msecs)
+(defun tramp-accept-process-output (proc timeout)
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
for process communication also."
+ ;; FIXME: There are problems, when an asynchronous process runs in
+ ;; parallel, and also timers are active. See
+ ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>.
+ (when (and timer-event-last
+ (string-prefix-p "*tramp/" (process-name proc))
+ (let (result)
+ (maphash
+ (lambda (key _value)
+ (and (processp key)
+ (not (string-prefix-p "*tramp/" (process-name key)))
+ (tramp-compat-process-live-p key)
+ (setq result t)))
+ tramp-cache-data)
+ result))
+ (sit-for 0.01 'nodisp))
(with-current-buffer (process-buffer proc)
(let (buffer-read-only last-coding-system-used)
;; Under Windows XP, accept-process-output doesn't return
- ;; sometimes. So we add an additional timeout.
- (with-timeout ((or timeout 1))
- (accept-process-output proc timeout timeout-msecs (and proc t)))
- (tramp-message proc 10 "%s %s\n%s"
- proc (process-status proc) (buffer-string)))))
+ ;; sometimes. So we add an additional timeout. JUST-THIS-ONE
+ ;; is set due to Bug#12145.
+ (tramp-message
+ proc 10 "%s %s %s\n%s"
+ proc (process-status proc)
+ (with-timeout (timeout)
+ (accept-process-output proc timeout nil t))
+ (buffer-string)))))
(defun tramp-check-for-regexp (proc regexp)
"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 7cb36c4..0f7e4b5 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1221,6 +1221,18 @@ Works with: arglist-cont, arglist-cont-nonempty."
(vector (progn (goto-char alignto) (current-column)))))))
+(defun c-lineup-under-anchor (langelem)
+ "Line up the current line directly under the anchor position in LANGELEM.
+
+This is like 0, except it supersedes any indentation already calculated for
+previous syntactic elements in the syntactic context.
+
+Works with: Any syntactic symbol which has an anchor position."
+ (save-excursion
+ (goto-char (c-langelem-pos langelem))
+ (vector (current-column))))
+
+
(defun c-lineup-dont-change (langelem)
"Do not change the indentation of the current line.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index fd7aa50..dfd7aeb 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."
(t nil)))))
(setq pos (point))
- (if (and after-type-id-pos
- (goto-char after-type-id-pos)
- (setq res (c-back-over-member-initializers))
- (goto-char res)
- (eq (car (c-beginning-of-decl-1 lim)) 'same))
- (cons (point) nil) ; Return value.
-
+ (cond
+ ((and after-type-id-pos
+ (goto-char after-type-id-pos)
+ (setq res (c-back-over-member-initializers))
+ (goto-char res)
+ (eq (car (c-beginning-of-decl-1 lim)) 'same))
+ (cons (point) nil)) ; Return value.
+
+ ((and after-type-id-pos
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\()))
+ ;; Single identifier between '(' and '{'. We have a bracelist.
+ (cons after-type-id-pos nil))
+
+ (t
(goto-char pos)
;; Checks to do on all sexps before the brace, up to the
;; beginning of the statement.
@@ -10368,7 +10377,7 @@ comment at the start of cc-engine.el for more info."
; languages where
; `c-opt-inexpr-brace-list-key' is
; non-nil and we have macros.
- (t t))) ;; The caller can go up one level.
+ (t t)))) ;; The caller can go up one level.
)))
(defun c-inside-bracelist-p (containing-sexp paren-state)
@@ -10493,6 +10502,30 @@ comment at the start of cc-engine.el for more info."
(c-at-statement-start-p))
(make-obsolete 'c-looking-at-bos 'c-at-statement-start-p "22.1")
+(defun c-looking-at-statement-block ()
+ ;; Point is at an opening brace. If this is a statement block (i.e. the
+ ;; elements in it are terminated by semicolons) return t. Otherwise, return
+ ;; nil.
+ (let ((here (point)))
+ (prog1
+ (if (c-go-list-forward)
+ (let ((there (point)))
+ (backward-char)
+ (c-syntactic-skip-backward
+ "^;," here t)
+ (cond
+ ((eq (char-before) ?\;) t)
+ ((eq (char-before) ?,) nil)
+ (t (goto-char here)
+ (forward-char)
+ (and (c-syntactic-re-search-forward "{" there t t)
+ (progn (backward-char)
+ (c-looking-at-statement-block))))))
+ (forward-char)
+ (and (c-syntactic-re-search-forward "[;,]" nil t t)
+ (eq (char-before) ?\;)))
+ (goto-char here))))
+
(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end)
;; Return non-nil if we're looking at the beginning of a block
;; 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."
(and (c-major-mode-is 'c++-mode)
(save-excursion
(goto-char block-follows)
- (if (c-go-list-forward)
- (progn
- (backward-char)
- (c-syntactic-skip-backward
- "^;," block-follows t)
- (not (eq (char-before) ?\;)))
- (or (not (c-syntactic-re-search-forward
- "[;,]" nil t t))
- (not (eq (char-before) ?\;)))))))
+ (not (c-looking-at-statement-block)))))
nil
(cons 'inexpr-statement (point)))))
@@ -10792,17 +10817,20 @@ comment at the start of cc-engine.el for more info."
syntax-extra-args
stop-at-boi-only
containing-sexp
- paren-state)
+ paren-state
+ &optional fixed-anchor)
;; Add the indicated SYNTAX-SYMBOL to `c-syntactic-context', extending it as
;; needed with further syntax elements of the types `substatement',
- ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro', and
- ;; `defun-block-intro'.
+ ;; `inexpr-statement', `arglist-cont-nonempty', `statement-block-intro',
+ ;; `defun-block-intro', and `brace-list-intro'.
;;
- ;; Do the generic processing to anchor the given syntax symbol on
- ;; the preceding statement: Skip over any labels and containing
- ;; statements on the same line, and then search backward until we
- ;; find a statement or block start that begins at boi without a
- ;; label or comment.
+ ;; Do the generic processing to anchor the given syntax symbol on the
+ ;; preceding statement: First skip over any labels and containing statements
+ ;; on the same line. If FIXED-ANCHOR is non-nil, use this as the
+ ;; anchor-point for the given syntactic symbol, and don't make syntactic
+ ;; entries for constructs beginning on lines before that containing
+ ;; ANCHOR-POINT. Otherwise search backward until we find a statement or
+ ;; block start that begins at boi without a label or comment.
;;
;; Point is assumed to be at the prospective anchor point for the
;; 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."
(let ((syntax-last c-syntactic-context)
(boi (c-point 'boi))
+ (anchor-boi (c-point 'boi))
;; Set when we're on a label, so that we don't stop there.
;; FIXME: To be complete we should check if we're on a label
;; now at the start.
@@ -10908,7 +10937,9 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'substatement nil))))
)))
- containing-sexp)
+ containing-sexp
+ (or (null fixed-anchor)
+ (> containing-sexp anchor-boi)))
;; Now we have to go out of this block.
(goto-char containing-sexp)
@@ -10982,6 +11013,14 @@ comment at the start of cc-engine.el for more info."
(cdr (assoc (match-string 1)
c-other-decl-block-key-in-symbols-alist))
(max (c-point 'boi paren-pos) (point))))
+ ((save-excursion
+ (goto-char paren-pos)
+ (c-looking-at-or-maybe-in-bracelist containing-sexp))
+ (if (save-excursion
+ (goto-char paren-pos)
+ (c-looking-at-statement-block))
+ (c-add-syntax 'defun-block-intro nil)
+ (c-add-syntax 'brace-list-intro nil)))
(t (c-add-syntax 'defun-block-intro nil))))
(c-add-syntax 'statement-block-intro nil)))
@@ -11001,7 +11040,10 @@ comment at the start of cc-engine.el for more info."
(setq q (cdr (car p))) ; e.g. (nil 28) [from (arglist-cont-nonempty
nil 28)]
(while q
(unless (car q)
- (setcar q (point)))
+ (setcar q (if (or (cdr p)
+ (null fixed-anchor))
+ (point)
+ fixed-anchor)))
(setq q (cdr q)))
(setq p (cdr p))))
)))
@@ -12354,7 +12396,8 @@ comment at the start of cc-engine.el for more info."
(c-forward-syntactic-ws (c-point 'eol))
(c-looking-at-special-brace-list (point)))))
(c-add-syntax 'brace-entry-open (point))
- (c-add-syntax 'brace-list-entry (point))
+ (c-add-stmt-syntax 'brace-list-entry nil t containing-sexp
+ paren-state (point))
))
))))
@@ -12848,7 +12891,7 @@ Cannot combine absolute offsets %S and %S in `add'
method"
;;
;; Note that topmost-intro always has an anchor position at bol, for
;; historical reasons. It's often used together with other symbols
- ;; that has more sane positions. Since we always use the first
+ ;; that have more sane positions. Since we always use the first
;; found anchor position, we rely on that these other symbols always
;; precede topmost-intro in the LANGELEMS list.
;;
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index d350549..b3848a7 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -67,6 +67,7 @@
(arglist-close . c-lineup-arglist)
(inline-open . 0)
(brace-list-open . +)
+ (brace-list-intro . c-lineup-arglist-intro-after-paren)
(topmost-intro-cont
. (first c-lineup-topmost-intro-cont
c-lineup-gnu-DEFUN-intro-cont))))
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index a6a96d1..1114b21 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
;; Anchor pos: At the brace list decl start(*).
(brace-list-intro . +)
;; Anchor pos: At the brace list decl start(*).
- (brace-list-entry . 0)
+ (brace-list-entry . c-lineup-under-anchor)
;; Anchor pos: At the first non-ws char after the open paren if
;; the first token is on the same line, otherwise boi at that
;; token.
diff --git a/lisp/shell.el b/lisp/shell.el
index c7ba64e..c8a8555 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1000,8 +1000,6 @@ command again."
(let ((pt (point))
(regexp
(concat
- ;; comint-process-echoes is the thing that breaks the
- ;; throbber
(if comint-process-echoes
;; Skip command echo if the process echoes
(concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)")
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index e609ca9..7ffa115 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";)
(defconst diff-hunk-header-re
(concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\*
.+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$"))
(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\*
.+\n--- \\|[^-+!<>address@hidden \n]\\).+\n" (substring diff-hunk-header-re 1)))
+
+(defconst diff-separator-re "^--+ ?$")
+
(defvar diff-narrowed-to nil)
(defun diff-hunk-style (&optional style)
@@ -1537,15 +1540,20 @@ Only works for unified diffs."
(pcase (char-after)
(?\s (cl-decf before) (cl-decf after) t)
(?-
- (if (and (looking-at diff-file-header-re)
- (zerop before) (zerop after))
- ;; No need to query: this is a case where two patches
- ;; are concatenated and only counting the lines will
- ;; give the right result. Let's just add an empty
- ;; line so that our code which doesn't count lines
- ;; will not get confused.
- (progn (save-excursion (insert "\n")) nil)
- (cl-decf before) t))
+ (cond
+ ((and (looking-at diff-separator-re)
+ (zerop before) (zerop after))
+ nil)
+ ((and (looking-at diff-file-header-re)
+ (zerop before) (zerop after))
+ ;; No need to query: this is a case where two patches
+ ;; are concatenated and only counting the lines will
+ ;; give the right result. Let's just add an empty
+ ;; line so that our code which doesn't count lines
+ ;; will not get confused.
+ (save-excursion (insert "\n")) nil)
+ (t
+ (cl-decf before) t)))
(?+ (cl-decf after) t)
(_
(cond
diff --git a/src/alloc.c b/src/alloc.c
index 8c9b116..a2302a6 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2884,7 +2884,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
{
val = Fcons (init, val);
- maybe_quit ();
+ rarely_quit (size);
}
return val;
@@ -5452,7 +5452,8 @@ make_pure_vector (ptrdiff_t len)
/* Copy all contents and parameters of TABLE to a new table allocated
from pure space, return the purified table. */
static struct Lisp_Hash_Table *
-purecopy_hash_table (struct Lisp_Hash_Table *table) {
+purecopy_hash_table (struct Lisp_Hash_Table *table)
+{
eassert (NILP (table->weak));
eassert (!NILP (table->pure));
@@ -5495,14 +5496,12 @@ Does not copy symbols. Copies strings without text
properties. */)
return purecopy (obj);
}
-struct pinned_object
+/* Pinned objects are marked before every GC cycle. */
+static struct pinned_object
{
Lisp_Object object;
struct pinned_object *next;
-};
-
-/* Pinned objects are marked before every GC cycle. */
-static struct pinned_object *pinned_objects;
+} *pinned_objects;
static Lisp_Object
purecopy (Lisp_Object obj)
@@ -5534,13 +5533,13 @@ purecopy (Lisp_Object obj)
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
- /* We cannot purify hash tables which haven't been defined with
+ /* Do not purify hash tables which haven't been defined with
:purecopy as non-nil or are weak - they aren't guaranteed to
not change. */
if (!NILP (table->weak) || NILP (table->pure))
{
- /* Instead, the hash table is added to the list of pinned objects,
- and is marked before GC. */
+ /* Instead, add the hash table to the list of pinned objects,
+ so that it will be marked during GC. */
struct pinned_object *o = xmalloc (sizeof *o);
o->object = obj;
o->next = pinned_objects;
@@ -5770,11 +5769,8 @@ compact_undo_list (Lisp_Object list)
static void
mark_pinned_objects (void)
{
- struct pinned_object *pobj;
- for (pobj = pinned_objects; pobj; pobj = pobj->next)
- {
- mark_object (pobj->object);
- }
+ for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next)
+ mark_object (pobj->object);
}
static void
diff --git a/src/bytecode.c b/src/bytecode.c
index 88df30c..a6019f7 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,
{
Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER (v1);
- EMACS_INT n = XINT (v1);
- immediate_quit = true;
- while (--n >= 0 && CONSP (v2))
- v2 = XCDR (v2);
- immediate_quit = false;
+ for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
+ {
+ v2 = XCDR (v2);
+ rarely_quit (n);
+ }
TOP = CAR (v2);
NEXT;
}
@@ -1051,11 +1051,11 @@ exec_byte_code__ (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
/* Exchange args and then do nth. */
Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER (v2);
- EMACS_INT n = XINT (v2);
- immediate_quit = true;
- while (--n >= 0 && CONSP (v1))
- v1 = XCDR (v1);
- immediate_quit = false;
+ for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
+ {
+ v1 = XCDR (v1);
+ rarely_quit (n);
+ }
TOP = CAR (v1);
}
else
diff --git a/src/callproc.c b/src/callproc.c
index 301ccf3..84324c4 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -198,11 +198,11 @@ call_process_cleanup (Lisp_Object buffer)
{
kill (-synch_process_pid, SIGINT);
message1 ("Waiting for process to die...(type C-g again to kill it
instantly)");
- immediate_quit = true;
- maybe_quit ();
+
+ /* This will quit on C-g. */
wait_for_termination (synch_process_pid, 0, 1);
+
synch_process_pid = 0;
- immediate_quit = false;
message1 ("Waiting for process to die...done");
}
#endif /* !MSDOS */
@@ -726,9 +726,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
process_coding.src_multibyte = 0;
}
- immediate_quit = true;
- maybe_quit ();
-
if (0 <= fd0)
{
enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
@@ -749,8 +746,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
nread = carryover;
while (nread < bufsize - 1024)
{
- int this_read = emacs_read (fd0, buf + nread,
- bufsize - nread);
+ int this_read = emacs_read_quit (fd0, buf + nread,
+ bufsize - nread);
if (this_read < 0)
goto give_up;
@@ -769,7 +766,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
}
/* Now NREAD is the total amount of data in the buffer. */
- immediate_quit = false;
if (!nread)
;
@@ -842,8 +838,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
we should have already detected a coding system. */
display_on_the_fly = true;
}
- immediate_quit = true;
- maybe_quit ();
}
give_up: ;
@@ -860,8 +854,6 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
wait_for_termination (pid, &status, fd0 < 0);
#endif
- immediate_quit = false;
-
/* Don't kill any children that the subprocess may have left behind
when exiting. */
synch_process_pid = 0;
diff --git a/src/data.c b/src/data.c
index 0984072..c73f04c 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1304,56 +1304,6 @@ set_internal (Lisp_Object symbol, Lisp_Object newval,
Lisp_Object where,
default: emacs_abort ();
}
-
- const char* symname = SDATA(sym->name);
-
- if( EQ(Vwatch_object, symbol) )
- {
- static int nest_level = 0;
- if(nest_level++ == 0)
- {
- switch(sym->redirect)
- {
- case SYMBOL_PLAINVAL:
- {
- AUTO_STRING (format, "Setting symbol '%s'; redirect:
SYMBOL_PLAINVAL");
- CALLN (Fmessage, format, SYMBOL_NAME (symbol));
- break;
- }
- case SYMBOL_VARALIAS:
- {
- AUTO_STRING (format, "Setting symbol '%s'; redirect:
SYMBOL_VARALIAS");
- CALLN (Fmessage, format, SYMBOL_NAME (symbol));
- break;
- }
- case SYMBOL_LOCALIZED:
- {
- AUTO_STRING (format, "Setting symbol '%s'; redirect:
SYMBOL_LOCALIZED");
- CALLN (Fmessage, format, SYMBOL_NAME (symbol));
- break;
- }
- case SYMBOL_FORWARDED:
- {
- AUTO_STRING (format, "Setting symbol '%s'; redirect:
SYMBOL_FORWARDED");
- CALLN (Fmessage, format, SYMBOL_NAME (symbol));
- break;
- }
-
- default:
- {
- AUTO_STRING (format, "Setting symbol '%s'; redirect:
UNKNOWN");
- CALLN (Fmessage, format, SYMBOL_NAME (symbol));
- break;
- }
- }
- }
- nest_level--;
- }
-
-
-
-
-
start:
switch (sym->redirect)
{
diff --git a/src/dired.c b/src/dired.c
index 52e81fb..5ea00fb 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -248,14 +248,11 @@ directory_files_internal (Lisp_Object directory,
Lisp_Object full,
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
- immediate_quit = true;
maybe_quit ();
bool wanted = (NILP (match)
|| re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
- immediate_quit = false;
-
if (wanted)
{
if (!NILP (full))
diff --git a/src/doc.c b/src/doc.c
index 361d09a..1e7e3fc 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -186,7 +186,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool
definition)
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
- nread = emacs_read (fd, p, space_left);
+ nread = emacs_read_quit (fd, p, space_left);
if (nread < 0)
report_file_error ("Read error on documentation file", file);
p[nread] = 0;
@@ -590,16 +590,15 @@ the same file name is found in the `doc-directory'. */)
Vdoc_file_name = filename;
filled = 0;
pos = 0;
- while (1)
+ while (true)
{
- register char *end;
if (filled < 512)
- filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
+ filled += emacs_read_quit (fd, &buf[filled], sizeof buf - 1 - filled);
if (!filled)
break;
buf[filled] = 0;
- end = buf + (filled < 512 ? filled : filled - 128);
+ char *end = buf + (filled < 512 ? filled : filled - 128);
p = memchr (buf, '\037', end - buf);
/* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */
if (p)
diff --git a/src/editfns.c b/src/editfns.c
index 82c6abb..4618164 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3053,7 +3053,6 @@ determines whether case is significant or ignored. */)
i2 = begp2;
i1_byte = buf_charpos_to_bytepos (bp1, i1);
i2_byte = buf_charpos_to_bytepos (bp2, i2);
- immediate_quit = true;
while (i1 < endp1 && i2 < endp2)
{
@@ -3092,17 +3091,14 @@ determines whether case is significant or ignored. */)
c1 = char_table_translate (trt, c1);
c2 = char_table_translate (trt, c2);
}
+
if (c1 != c2)
- {
- immediate_quit = false;
- return make_number (c1 < c2 ? -1 - chars : chars + 1);
- }
+ return make_number (c1 < c2 ? -1 - chars : chars + 1);
chars++;
+ rarely_quit (chars);
}
- immediate_quit = false;
-
/* The strings match as far as they go.
If one is shorter, that one is less. */
if (chars < endp1 - begp1)
diff --git a/src/eval.c b/src/eval.c
index 68b48f9..54a646b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1131,7 +1131,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
/* Restore certain special C variables. */
set_poll_suppress_count (catch->poll_suppress_count);
unblock_input_to (catch->interrupt_input_blocked);
- immediate_quit = false;
do
{
@@ -1462,6 +1461,19 @@ process_quit_flag (void)
quit ();
}
+/* Check quit-flag and quit if it is non-nil. Typing C-g does not
+ directly cause a quit; it only sets Vquit_flag. So the program
+ needs to call maybe_quit at times when it is safe to quit. Every
+ loop that might run for a long time or might not exit ought to call
+ maybe_quit at least once, at a safe place. Unless that is
+ impossible, of course. But it is very desirable to avoid creating
+ loops where maybe_quit is impossible.
+
+ If quit-flag is set to `kill-emacs' the SIGINT handler has received
+ a request to exit Emacs when it is safe to do.
+
+ When not quitting, process any pending signals. */
+
void
maybe_quit (void)
{
@@ -1517,7 +1529,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
Lisp_Object clause = Qnil;
struct handler *h;
- immediate_quit = false;
if (gc_in_progress || waiting_for_input)
emacs_abort ();
diff --git a/src/fileio.c b/src/fileio.c
index a46cfc7..3840062 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1960,9 +1960,7 @@ permissions. */)
report_file_error ("Copying permissions to", newname);
}
#else /* not WINDOWSNT */
- immediate_quit = true;
ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
- immediate_quit = false;
if (ifd < 0)
report_file_error ("Opening input file", file);
@@ -2024,7 +2022,6 @@ permissions. */)
oldsize = out_st.st_size;
}
- immediate_quit = true;
maybe_quit ();
if (clone_file (ofd, ifd))
@@ -2033,9 +2030,9 @@ permissions. */)
{
char buf[MAX_ALLOCA];
ptrdiff_t n;
- for (newsize = 0; 0 < (n = emacs_read (ifd, buf, sizeof buf));
+ for (newsize = 0; 0 < (n = emacs_read_quit (ifd, buf, sizeof buf));
newsize += n)
- if (emacs_write_sig (ofd, buf, n) != n)
+ if (emacs_write_quit (ofd, buf, n) != n)
report_file_error ("Write error", newname);
if (n < 0)
report_file_error ("Read error", file);
@@ -2047,8 +2044,6 @@ permissions. */)
if (newsize < oldsize && ftruncate (ofd, newsize) != 0)
report_file_error ("Truncating output file", newname);
- immediate_quit = false;
-
#ifndef MSDOS
/* Preserve the original file permissions, and if requested, also its
owner and group. */
@@ -3401,15 +3396,10 @@ decide_coding_unwind (Lisp_Object unwind_data)
static Lisp_Object
read_non_regular (Lisp_Object state)
{
- int nbytes;
-
- immediate_quit = true;
- maybe_quit ();
- nbytes = emacs_read (XSAVE_INTEGER (state, 0),
- ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
- + XSAVE_INTEGER (state, 1)),
- XSAVE_INTEGER (state, 2));
- immediate_quit = false;
+ int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
+ ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ + XSAVE_INTEGER (state, 1)),
+ XSAVE_INTEGER (state, 2));
/* Fast recycle this object for the likely next call. */
free_misc (state);
return make_number (nbytes);
@@ -3753,17 +3743,17 @@ by calling `format-decode', which see. */)
int nread;
if (st.st_size <= (1024 * 4))
- nread = emacs_read (fd, read_buf, 1024 * 4);
+ nread = emacs_read_quit (fd, read_buf, 1024 * 4);
else
{
- nread = emacs_read (fd, read_buf, 1024);
+ nread = emacs_read_quit (fd, read_buf, 1024);
if (nread == 1024)
{
int ntail;
if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
report_file_error ("Setting file position",
orig_filename);
- ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
+ ntail = emacs_read_quit (fd, read_buf + nread, 1024 * 3);
nread = ntail < 0 ? ntail : nread + ntail;
}
}
@@ -3868,15 +3858,11 @@ by calling `format-decode', which see. */)
report_file_error ("Setting file position", orig_filename);
}
- immediate_quit = true;
- maybe_quit ();
/* Count how many chars at the start of the file
match the text at the beginning of the buffer. */
- while (1)
+ while (true)
{
- int nread, bufpos;
-
- nread = emacs_read (fd, read_buf, sizeof read_buf);
+ int nread = emacs_read_quit (fd, read_buf, sizeof read_buf);
if (nread < 0)
report_file_error ("Read error", orig_filename);
else if (nread == 0)
@@ -3898,7 +3884,7 @@ by calling `format-decode', which see. */)
break;
}
- bufpos = 0;
+ int bufpos = 0;
while (bufpos < nread && same_at_start < ZV_BYTE
&& FETCH_BYTE (same_at_start) == read_buf[bufpos])
same_at_start++, bufpos++;
@@ -3907,7 +3893,6 @@ by calling `format-decode', which see. */)
if (bufpos != nread)
break;
}
- immediate_quit = false;
/* If the file matches the buffer completely,
there's no need to replace anything. */
if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
@@ -3919,8 +3904,7 @@ by calling `format-decode', which see. */)
del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
}
- immediate_quit = true;
- maybe_quit ();
+
/* Count how many chars at the end of the file
match the text at the end of the buffer. But, if we have
already found that decoding is necessary, don't waste time. */
@@ -3942,7 +3926,8 @@ by calling `format-decode', which see. */)
total_read = nread = 0;
while (total_read < trial)
{
- nread = emacs_read (fd, read_buf + total_read, trial -
total_read);
+ nread = emacs_read_quit (fd, read_buf + total_read,
+ trial - total_read);
if (nread < 0)
report_file_error ("Read error", orig_filename);
else if (nread == 0)
@@ -3977,7 +3962,6 @@ by calling `format-decode', which see. */)
if (nread == 0)
break;
}
- immediate_quit = false;
if (! giveup_match_end)
{
@@ -4069,18 +4053,13 @@ by calling `format-decode', which see. */)
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
unprocessed = 0; /* Bytes not processed in previous loop. */
- while (1)
+ while (true)
{
/* Read at most READ_BUF_SIZE bytes at a time, to allow
quitting while reading a huge file. */
- /* Allow quitting out of the actual I/O. */
- immediate_quit = true;
- maybe_quit ();
- this = emacs_read (fd, read_buf + unprocessed,
- READ_BUF_SIZE - unprocessed);
- immediate_quit = false;
-
+ this = emacs_read_quit (fd, read_buf + unprocessed,
+ READ_BUF_SIZE - unprocessed);
if (this <= 0)
break;
@@ -4294,13 +4273,10 @@ by calling `format-decode', which see. */)
/* Allow quitting out of the actual I/O. We don't make text
part of the buffer until all the reading is done, so a C-g
here doesn't do any harm. */
- immediate_quit = true;
- maybe_quit ();
- this = emacs_read (fd,
- ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
- + inserted),
- trytry);
- immediate_quit = false;
+ this = emacs_read_quit (fd,
+ ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ + inserted),
+ trytry);
}
if (this <= 0)
@@ -5002,8 +4978,6 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
}
}
- immediate_quit = true;
-
if (STRINGP (start))
ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
else if (XINT (start) != XINT (end))
@@ -5026,8 +5000,6 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
save_errno = errno;
}
- immediate_quit = false;
-
/* fsync is not crucial for temporary files. Nor for auto-save
files, since they might lose some work anyway. */
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,
: (STRINGP (coding->dst_object)
? SSDATA (coding->dst_object)
: (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
- coding->produced -= emacs_write_sig (desc, buf, coding->produced);
+ coding->produced -= emacs_write_quit (desc, buf, coding->produced);
if (coding->raw_destination)
{
diff --git a/src/filelock.c b/src/filelock.c
index de65c52..67e8dbd 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -407,9 +407,7 @@ create_lock_file (char *lfname, char *lock_info_str, bool
force)
fcntl (fd, F_SETFD, FD_CLOEXEC);
lock_info_len = strlen (lock_info_str);
err = 0;
- /* Use 'write', not 'emacs_write', as garbage collection
- might signal an error, which would leak FD. */
- if (write (fd, lock_info_str, lock_info_len) != lock_info_len
+ if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
|| fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0)
err = errno;
/* 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])
int fd = emacs_open (lfname, O_RDONLY | O_NOFOLLOW, 0);
if (0 <= fd)
{
- /* Use read, not emacs_read, since FD isn't unwind-protected. */
- ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1);
+ ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1);
int read_errno = errno;
if (emacs_close (fd) != 0)
return -1;
diff --git a/src/fns.c b/src/fns.c
index 9eabc14..ac7c1f2 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -84,22 +84,6 @@ See Info node `(elisp)Random Numbers' for more details. */)
return make_number (val);
}
-/* Heuristic on how many iterations of a tight loop can be safely done
- before it's time to do a quit. This must be a power of 2. It
- is nice but not necessary for it to equal USHRT_MAX + 1. */
-enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-
-/* Process a quit, but do it only rarely, for efficiency. "Rarely"
- means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1 times,
- whichever is smaller. Use *QUIT_COUNT to count this. */
-
-static void
-rarely_quit (unsigned short int *quit_count)
-{
- if (! (++*quit_count & (QUIT_COUNT_HEURISTIC - 1)))
- maybe_quit ();
-}
-
/* Random data-structure functions. */
DEFUN ("length", Flength, Slength, 1, 1, 0,
@@ -1359,20 +1343,17 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
(Lisp_Object n, Lisp_Object list)
{
CHECK_NUMBER (n);
- EMACS_INT num = XINT (n);
Lisp_Object tail = list;
- immediate_quit = true;
- for (EMACS_INT i = 0; i < num; i++)
+ for (EMACS_INT num = XINT (n); 0 < num; num--)
{
if (! CONSP (tail))
{
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
tail = XCDR (tail);
+ rarely_quit (num);
}
- immediate_quit = false;
return tail;
}
@@ -1408,7 +1389,7 @@ The value is actually the tail of LIST whose car is ELT.
*/)
{
if (! NILP (Fequal (elt, XCAR (tail))))
return tail;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1419,17 +1400,14 @@ DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
The value is actually the tail of LIST whose car is ELT. */)
(Lisp_Object elt, Lisp_Object list)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
if (EQ (XCAR (tail), elt))
- {
- immediate_quit = false;
- return tail;
- }
+ return tail;
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1442,18 +1420,15 @@ The value is actually the tail of LIST whose car is
ELT. */)
if (!FLOATP (elt))
return Fmemq (elt, list);
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object tem = XCAR (tail);
if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil))
- {
- immediate_quit = false;
- return tail;
- }
+ return tail;
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1464,15 +1439,14 @@ The value is actually the first element of LIST whose
car is KEY.
Elements of LIST that are not conses are ignored. */)
(Lisp_Object key, Lisp_Object list)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
- if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
- {
- immediate_quit = false;
+ {
+ if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
- }
- immediate_quit = false;
+ rarely_quit (++quit_count);
+ }
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1502,7 +1476,7 @@ The value is actually the first element of LIST whose car
equals KEY. */)
if (CONSP (car)
&& (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
return car;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1529,15 +1503,14 @@ DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
The value is actually the first element of LIST whose cdr is KEY. */)
(Lisp_Object key, Lisp_Object list)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
- if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
- {
- immediate_quit = false;
+ {
+ if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
return XCAR (tail);
- }
- immediate_quit = false;
+ rarely_quit (++quit_count);
+ }
CHECK_LIST_END (tail, list);
return Qnil;
}
@@ -1555,7 +1528,7 @@ The value is actually the first element of LIST whose cdr
equals KEY. */)
if (CONSP (car)
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
return car;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, list);
return Qnil;
@@ -1711,7 +1684,7 @@ changing the value of a sequence `foo'. */)
}
else
prev = tail;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
}
@@ -1736,10 +1709,10 @@ This function may destructively modify SEQ to produce
the value. */)
for (prev = Qnil, tail = seq; CONSP (tail); tail = next)
{
- rarely_quit (&quit_count);
next = XCDR (tail);
Fsetcdr (tail, prev);
prev = tail;
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, seq);
seq = prev;
@@ -1785,8 +1758,8 @@ See also the function `nreverse', which is used more
often. */)
unsigned short int quit_count = 0;
for (new = Qnil; CONSP (seq); seq = XCDR (seq))
{
- rarely_quit (&quit_count);
new = Fcons (XCAR (seq), new);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (seq, seq);
}
@@ -2077,21 +2050,20 @@ use `(setq x (plist-put x prop val))' to be sure to use
the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
Lisp_Object prev = Qnil;
for (Lisp_Object tail = plist; CONSP (tail) && CONSP (XCDR (tail));
tail = XCDR (XCDR (tail)))
{
if (EQ (prop, XCAR (tail)))
{
- immediate_quit = false;
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
@@ -2128,7 +2100,7 @@ one of the properties on the list. */)
{
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
CHECK_LIST_END (tail, prop);
@@ -2158,7 +2130,7 @@ The PLIST is modified by side effects. */)
}
prev = tail;
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
}
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
@@ -2238,7 +2210,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int
depth, bool props,
unsigned short int quit_count = 0;
tail_recurse:
- rarely_quit (&quit_count);
+ rarely_quit (++quit_count);
if (EQ (o1, o2))
return 1;
if (XTYPE (o1) != XTYPE (o2))
@@ -2442,18 +2414,15 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
- immediate_quit = true;
Lisp_Object tail;
do
{
tail = tem;
tem = XCDR (tail);
+ rarely_quit (++quit_count);
}
while (CONSP (tem));
- immediate_quit = false;
- rarely_quit (&quit_count);
-
tem = args[argnum + 1];
Fsetcdr (tail, tem);
if (NILP (tem))
@@ -2874,13 +2843,13 @@ property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
(Lisp_Object plist, Lisp_Object prop)
{
- immediate_quit = true;
+ unsigned short int quit_count = 0;
while (CONSP (plist) && !EQ (XCAR (plist), prop))
{
plist = XCDR (plist);
plist = CDR (plist);
+ rarely_quit (++quit_count);
}
- immediate_quit = false;
return plist;
}
@@ -5120,10 +5089,6 @@ On some platforms, file selection dialogs are also
enabled if this is
non-nil. */);
use_dialog_box = 1;
- DEFVAR_LISP("watch-object", Vwatch_object,
- doc: /* Symbol to watch. */);
- Vwatch_object = Qnil;
-
DEFVAR_BOOL ("use-file-dialog", use_file_dialog,
doc: /* Non-nil means mouse commands use a file dialog to ask for files.
This applies to commands from menus and tool bar buttons even when
diff --git a/src/indent.c b/src/indent.c
index 23951a1..f630ebb 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1200,9 +1200,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
continuation_glyph_width = 0; /* In the fringe. */
#endif
- immediate_quit = true;
- maybe_quit ();
-
/* It's just impossible to be too paranoid here. */
eassert (from == BYTE_TO_CHAR (frombyte) && frombyte == CHAR_TO_BYTE (from));
@@ -1214,8 +1211,12 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
cmp_it.id = -1;
composition_compute_stop_pos (&cmp_it, pos, pos_byte, to, Qnil);
- while (1)
+ unsigned short int quit_count = 0;
+
+ while (true)
{
+ rarely_quit (++quit_count);
+
while (pos == next_boundary)
{
ptrdiff_t pos_here = pos;
@@ -1280,6 +1281,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
pos = newpos;
pos_byte = CHAR_TO_BYTE (pos);
}
+
+ rarely_quit (++quit_count);
}
/* Handle right margin. */
@@ -1602,6 +1605,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
pos = find_before_next_newline (pos, to, 1,
&pos_byte);
if (pos < to)
INC_BOTH (pos, pos_byte);
+ rarely_quit (++quit_count);
}
while (pos < to
&& indented_beyond_p (pos, pos_byte,
@@ -1694,7 +1698,6 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
/* Nonzero if have just continued a line */
val_compute_motion.contin = (contin_hpos && prev_hpos == 0);
- immediate_quit = false;
return &val_compute_motion;
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 0c04d95..a86e7c5 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -169,9 +169,6 @@ struct kboard *echo_kboard;
Lisp_Object echo_message_buffer;
-/* True means C-g should cause immediate error-signal. */
-bool immediate_quit;
-
/* Character that causes a quit. Normally C-g.
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,
as input, set quit-flag to cause an interrupt. */
if (!NILP (Vthrow_on_input)
&& NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)))
- {
- Vquit_flag = Vthrow_on_input;
- /* If we're inside a function that wants immediate quits,
- do it now. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- immediate_quit = false;
- maybe_quit ();
- }
- }
+ Vquit_flag = Vthrow_on_input;
}
@@ -7053,40 +7041,22 @@ tty_read_avail_input (struct terminal *terminal,
/* Now read; for one reason or another, this will not block.
NREAD is set to the number of chars read. */
- do
- {
- nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
- /* POSIX infers that processes which are not in the session leader's
- process group won't get SIGHUPs at logout time. BSDI adheres to
- this part standard and returns -1 from read (0) with errno==EIO
- when the control tty is taken away.
- Jeffrey Honig <address@hidden> says this is generally safe. */
- if (nread == -1 && errno == EIO)
- return -2; /* Close this terminal. */
-#if defined (AIX) && defined (_BSD)
- /* The kernel sometimes fails to deliver SIGHUP for ptys.
- This looks incorrect, but it isn't, because _BSD causes
- O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
- and that causes a value other than 0 when there is no input. */
- if (nread == 0)
- return -2; /* Close this terminal. */
-#endif
- }
- while (
- /* We used to retry the read if it was interrupted.
- But this does the wrong thing when O_NONBLOCK causes
- an EAGAIN error. Does anybody know of a situation
- where a retry is actually needed? */
-#if 0
- nread < 0 && (errno == EAGAIN || errno == EFAULT
-#ifdef EBADSLT
- || errno == EBADSLT
-#endif
- )
-#else
- 0
+ nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
+ /* POSIX infers that processes which are not in the session leader's
+ process group won't get SIGHUPs at logout time. BSDI adheres to
+ this part standard and returns -1 from read (0) with errno==EIO
+ when the control tty is taken away.
+ Jeffrey Honig <address@hidden> says this is generally safe. */
+ if (nread == -1 && errno == EIO)
+ return -2; /* Close this terminal. */
+#if defined AIX && defined _BSD
+ /* The kernel sometimes fails to deliver SIGHUP for ptys.
+ This looks incorrect, but it isn't, because _BSD causes
+ O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
+ and that causes a value other than 0 when there is no input. */
+ if (nread == 0)
+ return -2; /* Close this terminal. */
#endif
- );
#ifndef USABLE_FIONREAD
#if defined (USG) || defined (CYGWIN)
@@ -10445,30 +10415,12 @@ handle_interrupt (bool in_signal_handler)
}
else
{
- /* If executing a function that wants to be interrupted out of
- and the user has not deferred quitting by binding `inhibit-quit'
- then quit right away. */
- if (immediate_quit && NILP (Vinhibit_quit) && !waiting_for_input)
- {
- struct gl_state_s saved;
-
- immediate_quit = false;
- pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
- saved = gl_state;
- quit ();
- gl_state = saved;
- }
- else
- { /* Else request quit when it's safe. */
- int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
- force_quit_count = count;
- if (count == 3)
- {
- immediate_quit = true;
- Vinhibit_quit = Qnil;
- }
- Vquit_flag = Qt;
- }
+ /* Request quit when it's safe. */
+ int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
+ force_quit_count = count;
+ if (count == 3)
+ Vinhibit_quit = Qnil;
+ Vquit_flag = Qt;
}
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
@@ -10907,7 +10859,6 @@ init_keyboard (void)
{
/* This is correct before outermost invocation of the editor loop. */
command_loop_level = -1;
- immediate_quit = false;
quit_char = Ctl ('g');
Vunread_command_events = Qnil;
timer_idleness_start_time = invalid_timespec ();
diff --git a/src/lisp.h b/src/lisp.h
index a293359..44b59f6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1995,8 +1995,8 @@ struct Lisp_Hash_Table
hash table size to reduce collisions. */
Lisp_Object index;
- /* Non-nil if the table can be purecopied. Any changes the table after
- purecopy will result in an error. */
+ /* Non-nil if the table can be purecopied. The table cannot be
+ changed afterwards. */
Lisp_Object pure;
/* Only the fields above are traced normally by the GC. The ones below
@@ -3132,29 +3132,28 @@ struct handler
extern Lisp_Object memory_signal_data;
-/* Check quit-flag and quit if it is non-nil. Typing C-g does not
- directly cause a quit; it only sets Vquit_flag. So the program
- needs to call maybe_quit at times when it is safe to quit. Every
- loop that might run for a long time or might not exit ought to call
- maybe_quit at least once, at a safe place. Unless that is
- impossible, of course. But it is very desirable to avoid creating
- loops where maybe_quit is impossible.
+extern void maybe_quit (void);
- Exception: if you set immediate_quit, the handler that responds to
- the C-g does the quit itself. This is a good thing to do around a
- loop that has no side effects and (in particular) cannot call
- arbitrary Lisp code.
+/* True if ought to quit now. */
- If quit-flag is set to `kill-emacs' the SIGINT handler has received
- a request to exit Emacs when it is safe to do.
+#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
- When not quitting, process any pending signals. */
+/* Heuristic on how many iterations of a tight loop can be safely done
+ before it's time to do a quit. This must be a power of 2. It
+ is nice but not necessary for it to equal USHRT_MAX + 1. */
-extern void maybe_quit (void);
+enum { QUIT_COUNT_HEURISTIC = 1 << 16 };
-/* True if ought to quit now. */
+/* Process a quit rarely, based on a counter COUNT, for efficiency.
+ "Rarely" means once per QUIT_COUNT_HEURISTIC or per USHRT_MAX + 1
+ times, whichever is smaller (somewhat arbitrary, but often faster). */
-#define QUITP (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+INLINE void
+rarely_quit (unsigned short int count)
+{
+ if (! (count & (QUIT_COUNT_HEURISTIC - 1)))
+ maybe_quit ();
+}
extern Lisp_Object Vascii_downcase_table;
extern Lisp_Object Vascii_canon_table;
@@ -4233,8 +4232,10 @@ extern int emacs_open (const char *, int, int);
extern int emacs_pipe (int[2]);
extern int emacs_close (int);
extern ptrdiff_t emacs_read (int, void *, ptrdiff_t);
+extern ptrdiff_t emacs_read_quit (int, void *, ptrdiff_t);
extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
+extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
extern void unlock_all_files (void);
@@ -4360,9 +4361,6 @@ extern char my_edata[];
extern char my_endbss[];
extern char *my_endbss_static;
-/* True means ^G can quit instantly. */
-extern bool immediate_quit;
-
extern void *xmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *xzalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
extern void *xrealloc (void *, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
diff --git a/src/lread.c b/src/lread.c
index 0a818c3..f0a764f 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -910,7 +910,7 @@ safe_to_load_version (int fd)
/* Read the first few bytes from the file, and look for a line
specifying the byte compiler version used. */
- nbytes = emacs_read (fd, buf, sizeof buf);
+ nbytes = emacs_read_quit (fd, buf, sizeof buf);
if (nbytes > 0)
{
/* Skip to the next newline, skipping over the initial `ELC'
diff --git a/src/process.c b/src/process.c
index dbd4358..434a395 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3431,7 +3431,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
break;
}
- immediate_quit = true;
maybe_quit ();
ret = connect (s, sa, addrlen);
@@ -3439,8 +3438,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
if (ret == 0 || xerrno == EISCONN)
{
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
+ /* The unwind-protect will be discarded afterwards. */
break;
}
@@ -3481,8 +3479,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
}
#endif /* !WINDOWSNT */
- immediate_quit = false;
-
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count;
emacs_close (s);
@@ -3539,8 +3535,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object
addrinfos,
#endif
}
- immediate_quit = false;
-
if (s < 0)
{
/* If non-blocking got this far - and failed - assume non-blocking is
@@ -4012,7 +4006,6 @@ usage: (make-network-process &rest ARGS) */)
struct addrinfo *res, *lres;
int ret;
- immediate_quit = true;
maybe_quit ();
struct addrinfo hints;
@@ -4034,7 +4027,6 @@ usage: (make-network-process &rest ARGS) */)
#else
error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
- immediate_quit = false;
for (lres = res; lres; lres = lres->ai_next)
addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
diff --git a/src/regex.c b/src/regex.c
index f6e67af..796f868 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1728,10 +1728,8 @@ typedef struct
/* Explicit quit checking is needed for Emacs, which uses polling to
process input events. */
-#ifdef emacs
-# define IMMEDIATE_QUIT_CHECK (immediate_quit ? maybe_quit () : (void) 0)
-#else
-# define IMMEDIATE_QUIT_CHECK ((void) 0)
+#ifndef emacs
+static void maybe_quit (void) {}
#endif
/* 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,
/* Unconditionally jump (without popping any failure points). */
case jump:
unconditional_jump:
- IMMEDIATE_QUIT_CHECK;
+ maybe_quit ();
EXTRACT_NUMBER_AND_INCR (mcnt, p); /* Get the amount to jump. */
DEBUG_PRINT ("EXECUTING jump %d ", mcnt);
p += mcnt; /* Do the jump. */
@@ -6168,7 +6166,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
const_re_char *string1,
/* We goto here if a matching operation fails. */
fail:
- IMMEDIATE_QUIT_CHECK;
+ maybe_quit ();
if (!FAIL_STACK_EMPTY ())
{
re_char *str, *pat;
diff --git a/src/search.c b/src/search.c
index f54f44c..33cb02a 100644
--- a/src/search.c
+++ b/src/search.c
@@ -99,6 +99,25 @@ matcher_overflow (void)
error ("Stack overflow in regexp matcher");
}
+static void
+freeze_buffer_relocation (void)
+{
+#ifdef REL_ALLOC
+ /* Prevent ralloc.c from relocating the current buffer while
+ searching it. */
+ r_alloc_inhibit_buffer_relocation (1);
+ record_unwind_protect_int (r_alloc_inhibit_buffer_relocation, 0);
+#endif
+}
+
+static void
+thaw_buffer_relocation (void)
+{
+#ifdef REL_ALLOC
+ unbind_to (SPECPDL_INDEX () - 1, Qnil);
+#endif
+}
+
/* Compile a regexp and signal a Lisp error if anything goes wrong.
PATTERN is the pattern to compile.
CP is the place to put the result.
@@ -277,7 +296,6 @@ looking_at_1 (Lisp_Object string, bool posix)
!NILP (BVAR (current_buffer,
enable_multibyte_characters)));
/* Do a pending quit right away, to avoid paradoxical behavior */
- immediate_quit = true;
maybe_quit ();
/* Get pointers and sizes of the two strings
@@ -301,20 +319,13 @@ looking_at_1 (Lisp_Object string, bool posix)
re_match_object = Qnil;
-#ifdef REL_ALLOC
- /* Prevent ralloc.c from relocating the current buffer while
- searching it. */
- r_alloc_inhibit_buffer_relocation (1);
-#endif
+ freeze_buffer_relocation ();
i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2,
PT_BYTE - BEGV_BYTE,
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL),
ZV_BYTE - BEGV_BYTE);
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
if (i == -2)
matcher_overflow ();
@@ -399,7 +410,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string,
Lisp_Object start,
? BVAR (current_buffer, case_canon_table) : Qnil),
posix,
STRING_MULTIBYTE (string));
- immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
@@ -407,7 +417,6 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string,
Lisp_Object start,
SBYTES (string) - pos_byte,
(NILP (Vinhibit_changing_match_data)
? &search_regs : NULL));
- immediate_quit = false;
/* Set last_thing_searched only when match data is changed. */
if (NILP (Vinhibit_changing_match_data))
@@ -471,13 +480,11 @@ fast_string_match_internal (Lisp_Object regexp,
Lisp_Object string,
bufp = compile_pattern (regexp, 0, table,
0, STRING_MULTIBYTE (string));
- immediate_quit = true;
re_match_object = string;
val = re_search (bufp, SSDATA (string),
SBYTES (string), 0,
SBYTES (string), 0);
- immediate_quit = false;
return val;
}
@@ -498,9 +505,7 @@ fast_c_string_match_ignore_case (Lisp_Object regexp,
bufp = compile_pattern (regexp, 0,
Vascii_canon_table, 0,
0);
- immediate_quit = true;
val = re_search (bufp, string, len, 0, len, 0);
- immediate_quit = false;
return val;
}
@@ -561,18 +566,10 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
buf = compile_pattern (regexp, 0, Qnil, 0, multibyte);
- immediate_quit = true;
-#ifdef REL_ALLOC
- /* Prevent ralloc.c from relocating the current buffer while
- searching it. */
- r_alloc_inhibit_buffer_relocation (1);
-#endif
+ freeze_buffer_relocation ();
len = re_match_2 (buf, (char *) p1, s1, (char *) p2, s2,
pos_byte, NULL, limit_byte);
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
- immediate_quit = false;
+ thaw_buffer_relocation ();
return len;
}
@@ -649,7 +646,7 @@ newline_cache_on_off (struct buffer *buf)
If BYTEPOS is not NULL, set *BYTEPOS to the byte position corresponding
to the returned character position.
- If ALLOW_QUIT, set immediate_quit. That's good to do
+ If ALLOW_QUIT, check for quitting. That's good to do
except when inside redisplay. */
ptrdiff_t
@@ -685,8 +682,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (shortage != 0)
*shortage = 0;
- immediate_quit = allow_quit;
-
if (count > 0)
while (start != end)
{
@@ -704,7 +699,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = false;
while (start < end && result)
{
ptrdiff_t lim1;
@@ -757,7 +751,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
start_byte = end_byte;
break;
}
- immediate_quit = allow_quit;
/* START should never be after END. */
if (start_byte > ceiling_byte)
@@ -810,11 +803,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
}
+ if (allow_quit)
+ maybe_quit ();
}
start_byte = lim_byte;
@@ -833,7 +827,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
ptrdiff_t next_change;
int result = 1;
- immediate_quit = false;
while (start > end && result)
{
ptrdiff_t lim1;
@@ -870,7 +863,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
start_byte = end_byte;
break;
}
- immediate_quit = allow_quit;
/* Start should never be at or before end. */
if (start_byte <= ceiling_byte)
@@ -918,11 +910,12 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (++count >= 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = ceiling_byte + prev + 1;
return BYTE_TO_CHAR (ceiling_byte + prev + 1);
}
+ if (allow_quit)
+ maybe_quit ();
}
start_byte = ceiling_byte;
@@ -930,7 +923,6 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
}
}
- immediate_quit = false;
if (shortage)
*shortage = count * direction;
if (bytepos)
@@ -954,7 +946,7 @@ find_newline (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
the number of line boundaries left unfound, and position at
the limit we bumped up against.
- If ALLOW_QUIT, set immediate_quit. That's good to do
+ If ALLOW_QUIT, check for quitting. That's good to do
except in special cases. */
ptrdiff_t
@@ -1197,9 +1189,6 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
trt, posix,
!NILP (BVAR (current_buffer,
enable_multibyte_characters)));
- immediate_quit = true; /* Quit immediately if user types ^G,
- because letting this function finish
- can take too long. */
maybe_quit (); /* Do a pending quit right away,
to avoid paradoxical behavior */
/* Get pointers and sizes of the two strings
@@ -1222,11 +1211,7 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
re_match_object = Qnil;
-#ifdef REL_ALLOC
- /* Prevent ralloc.c from relocating the current buffer while
- searching it. */
- r_alloc_inhibit_buffer_relocation (1);
-#endif
+ freeze_buffer_relocation ();
while (n < 0)
{
@@ -1268,13 +1253,11 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
else
{
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
return (n);
}
n++;
+ maybe_quit ();
}
while (n > 0)
{
@@ -1313,18 +1296,13 @@ search_buffer (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
}
else
{
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
return (0 - n);
}
n--;
+ maybe_quit ();
}
- immediate_quit = false;
-#ifdef REL_ALLOC
- r_alloc_inhibit_buffer_relocation (0);
-#endif
+ thaw_buffer_relocation ();
return (pos);
}
else /* non-RE case */
@@ -3231,8 +3209,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (shortage != 0)
*shortage = 0;
- immediate_quit = allow_quit;
-
if (count > 0)
while (start != end)
{
@@ -3275,11 +3251,12 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
if (--count == 0)
{
- immediate_quit = false;
if (bytepos)
*bytepos = lim_byte + next;
return BYTE_TO_CHAR (lim_byte + next);
}
+ if (allow_quit)
+ maybe_quit ();
}
start_byte = lim_byte;
@@ -3287,7 +3264,6 @@ find_newline1 (ptrdiff_t start, ptrdiff_t start_byte,
ptrdiff_t end,
}
}
- immediate_quit = false;
if (shortage)
*shortage = count;
if (bytepos)
diff --git a/src/syntax.c b/src/syntax.c
index f9e4093..7aa43e6 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -621,11 +621,9 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
SETUP_BUFFER_SYNTAX_TABLE ();
while (PT > BEGV)
{
- int c;
-
/* Open-paren at start of line means we may have found our
defun-start. */
- c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
+ int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
if (SYNTAX (c) == Sopen)
{
SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
@@ -715,6 +713,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
ptrdiff_t nesting = 1; /* Current comment nesting. */
int c;
int syntax = 0;
+ unsigned short int quit_count = 0;
/* FIXME: A }} comment-ender style leads to incorrect behavior
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,
that determines quote parity to the comment-end. */
while (from != stop)
{
+ rarely_quit (++quit_count);
+
ptrdiff_t temp_byte;
int prev_syntax;
bool com2start, com2end, comstart;
@@ -951,7 +952,9 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
defun_start_byte = CHAR_TO_BYTE (defun_start);
}
}
- } while (defun_start < comment_end);
+ rarely_quit (++quit_count);
+ }
+ while (defun_start < comment_end);
from_byte = CHAR_TO_BYTE (from);
UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
@@ -1417,29 +1420,23 @@ DEFUN ("internal-describe-syntax-value",
Finternal_describe_syntax_value,
COUNT negative means scan backward and stop at word beginning. */
ptrdiff_t
-scan_words (register ptrdiff_t from, register EMACS_INT count)
+scan_words (ptrdiff_t from, EMACS_INT count)
{
- register ptrdiff_t beg = BEGV;
- register ptrdiff_t end = ZV;
- register ptrdiff_t from_byte = CHAR_TO_BYTE (from);
- register enum syntaxcode code;
+ ptrdiff_t beg = BEGV;
+ ptrdiff_t end = ZV;
+ ptrdiff_t from_byte = CHAR_TO_BYTE (from);
+ enum syntaxcode code;
int ch0, ch1;
Lisp_Object func, pos;
- immediate_quit = true;
- maybe_quit ();
-
SETUP_SYNTAX_TABLE (from, count);
while (count > 0)
{
- while (1)
+ while (true)
{
if (from == end)
- {
- immediate_quit = false;
- return 0;
- }
+ return 0;
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
@@ -1449,6 +1446,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
break;
if (code == Sword)
break;
+ rarely_quit (from);
}
/* Now CH0 is a character which begins a word and FROM is the
position of the next character. */
@@ -1477,19 +1475,17 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
break;
INC_BOTH (from, from_byte);
ch0 = ch1;
+ rarely_quit (from);
}
}
count--;
}
while (count < 0)
{
- while (1)
+ while (true)
{
if (from == beg)
- {
- immediate_quit = false;
- return 0;
- }
+ return 0;
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -1499,6 +1495,7 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
break;
if (code == Sword)
break;
+ rarely_quit (from);
}
/* Now CH1 is a character which ends a word and FROM is the
position of it. */
@@ -1531,13 +1528,12 @@ scan_words (register ptrdiff_t from, register EMACS_INT
count)
break;
}
ch1 = ch0;
+ rarely_quit (from);
}
}
count++;
}
- immediate_quit = false;
-
return from;
}
@@ -1921,7 +1917,6 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
}
- immediate_quit = true;
/* This code may look up syntax tables using functions that rely on the
gl_state object. To make sure this object is not out of date,
let's initialize it manually.
@@ -1971,9 +1966,10 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
}
fwd_ok:
p += nbytes, pos++, pos_byte += nbytes;
+ rarely_quit (pos);
}
else
- while (1)
+ while (true)
{
if (p >= stop)
{
@@ -1995,15 +1991,14 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
break;
fwd_unibyte_ok:
p++, pos++, pos_byte++;
+ rarely_quit (pos);
}
}
else
{
if (multibyte)
- while (1)
+ while (true)
{
- unsigned char *prev_p;
-
if (p <= stop)
{
if (p <= endp)
@@ -2011,8 +2006,11 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
p = GPT_ADDR;
stop = endp;
}
- prev_p = p;
- while (--p >= stop && ! CHAR_HEAD_P (*p));
+ unsigned char *prev_p = p;
+ do
+ p--;
+ while (stop <= p && ! CHAR_HEAD_P (*p));
+
c = STRING_CHAR (p);
if (! NILP (iso_classes) && in_classes (c, iso_classes))
@@ -2036,9 +2034,10 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
}
back_ok:
pos--, pos_byte -= prev_p - p;
+ rarely_quit (pos);
}
else
- while (1)
+ while (true)
{
if (p <= stop)
{
@@ -2060,11 +2059,11 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
break;
back_unibyte_ok:
p--, pos--, pos_byte--;
+ rarely_quit (pos);
}
}
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = false;
SAFE_FREE ();
return make_number (PT - start_point);
@@ -2138,7 +2137,6 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
ptrdiff_t pos_byte = PT_BYTE;
unsigned char *p, *endp, *stop;
- immediate_quit = true;
SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
if (forwardp)
@@ -2167,6 +2165,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
if (! fastmap[SYNTAX (c)])
goto done;
p += nbytes, pos++, pos_byte += nbytes;
+ rarely_quit (pos);
}
while (!parse_sexp_lookup_properties
|| pos < gl_state.e_property);
@@ -2183,10 +2182,8 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
if (multibyte)
{
- while (1)
+ while (true)
{
- unsigned char *prev_p;
-
if (p <= stop)
{
if (p <= endp)
@@ -2195,17 +2192,22 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
stop = endp;
}
UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
- prev_p = p;
- while (--p >= stop && ! CHAR_HEAD_P (*p));
+
+ unsigned char *prev_p = p;
+ do
+ p--;
+ while (stop <= p && ! CHAR_HEAD_P (*p));
+
c = STRING_CHAR (p);
if (! fastmap[SYNTAX (c)])
break;
pos--, pos_byte -= prev_p - p;
+ rarely_quit (pos);
}
}
else
{
- while (1)
+ while (true)
{
if (p <= stop)
{
@@ -2218,13 +2220,13 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
if (! fastmap[SYNTAX (p[-1])])
break;
p--, pos--, pos_byte--;
+ rarely_quit (pos);
}
}
}
done:
SET_PT_BOTH (pos, pos_byte);
- immediate_quit = false;
return make_number (PT - start_point);
}
@@ -2286,9 +2288,10 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
EMACS_INT *incomment_ptr, int *last_syntax_ptr)
{
- register int c, c1;
- register enum syntaxcode code;
- register int syntax, other_syntax;
+ unsigned short int quit_count = 0;
+ int c, c1;
+ enum syntaxcode code;
+ int syntax, other_syntax;
if (nesting <= 0) nesting = -1;
@@ -2380,6 +2383,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
UPDATE_SYNTAX_TABLE_FORWARD (from);
nesting++;
}
+
+ rarely_quit (++quit_count);
}
*charpos_ptr = from;
*bytepos_ptr = from_byte;
@@ -2407,14 +2412,12 @@ between them, return t; otherwise return nil. */)
ptrdiff_t out_charpos, out_bytepos;
EMACS_INT dummy;
int dummy2;
+ unsigned short int quit_count = 0;
CHECK_NUMBER (count);
count1 = XINT (count);
stop = count1 > 0 ? ZV : BEGV;
- immediate_quit = true;
- maybe_quit ();
-
from = PT;
from_byte = PT_BYTE;
@@ -2429,7 +2432,6 @@ between them, return t; otherwise return nil. */)
if (from == stop)
{
SET_PT_BOTH (from, from_byte);
- immediate_quit = false;
return Qnil;
}
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2456,6 +2458,7 @@ between them, return t; otherwise return nil. */)
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
+ rarely_quit (++quit_count);
}
while (code == Swhitespace || (code == Sendcomment && c == '\n'));
@@ -2463,7 +2466,6 @@ between them, return t; otherwise return nil. */)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
- immediate_quit = false;
DEC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
@@ -2474,7 +2476,6 @@ between them, return t; otherwise return nil. */)
from = out_charpos; from_byte = out_bytepos;
if (!found)
{
- immediate_quit = false;
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2486,23 +2487,19 @@ between them, return t; otherwise return nil. */)
while (count1 < 0)
{
- while (1)
+ while (true)
{
- bool quoted;
- int syntax;
-
if (from <= stop)
{
SET_PT_BOTH (BEGV, BEGV_BYTE);
- immediate_quit = false;
return Qnil;
}
DEC_BOTH (from, from_byte);
/* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
- quoted = char_quoted (from, from_byte);
+ bool quoted = char_quoted (from, from_byte);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
- syntax = SYNTAX_WITH_FLAGS (c);
+ int syntax = SYNTAX_WITH_FLAGS (c);
code = SYNTAX (c);
comstyle = 0;
comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
@@ -2545,6 +2542,7 @@ between them, return t; otherwise return nil. */)
}
else if (from == stop)
break;
+ rarely_quit (++quit_count);
}
if (fence_found == 0)
{
@@ -2587,18 +2585,18 @@ between them, return t; otherwise return nil. */)
else if (code != Swhitespace || quoted)
{
leave:
- immediate_quit = false;
INC_BOTH (from, from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
+
+ rarely_quit (++quit_count);
}
count1++;
}
SET_PT_BOTH (from, from_byte);
- immediate_quit = false;
return Qt;
}
@@ -2632,6 +2630,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
EMACS_INT dummy;
int dummy2;
bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
+ unsigned short int quit_count = 0;
if (depth > 0) min_depth = 0;
@@ -2640,7 +2639,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
from_byte = CHAR_TO_BYTE (from);
- immediate_quit = true;
maybe_quit ();
SETUP_SYNTAX_TABLE (from, count);
@@ -2648,6 +2646,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
{
while (from < stop)
{
+ rarely_quit (++quit_count);
bool comstart_first, prefix;
int syntax, other_syntax;
UPDATE_SYNTAX_TABLE_FORWARD (from);
@@ -2716,6 +2715,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
goto done;
}
INC_BOTH (from, from_byte);
+ rarely_quit (++quit_count);
}
goto done;
@@ -2787,6 +2787,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (c_code == Scharquote || c_code == Sescape)
INC_BOTH (from, from_byte);
INC_BOTH (from, from_byte);
+ rarely_quit (++quit_count);
}
INC_BOTH (from, from_byte);
if (!depth && sexpflag) goto done;
@@ -2801,7 +2802,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = false;
return Qnil;
/* End of object reached */
@@ -2813,11 +2813,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
{
while (from > stop)
{
- int syntax;
+ rarely_quit (++quit_count);
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
- syntax= SYNTAX_WITH_FLAGS (c);
+ int syntax = SYNTAX_WITH_FLAGS (c);
code = syntax_multibyte (c, multibyte_symbol_p);
if (depth == min_depth)
last_good = from;
@@ -2889,6 +2889,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
default: goto done2;
}
DEC_BOTH (from, from_byte);
+ rarely_quit (++quit_count);
}
goto done2;
@@ -2951,13 +2952,14 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (syntax_multibyte (c, multibyte_symbol_p) == code)
break;
}
+ rarely_quit (++quit_count);
}
if (code == Sstring_fence && !depth && sexpflag) goto done2;
break;
case Sstring:
stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
- while (1)
+ while (true)
{
if (from == stop)
goto lose;
@@ -2971,6 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
== Sstring))
break;
}
+ rarely_quit (++quit_count);
}
if (!depth && sexpflag) goto done2;
break;
@@ -2984,7 +2987,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (depth)
goto lose;
- immediate_quit = false;
return Qnil;
done2:
@@ -2992,7 +2994,6 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
}
- immediate_quit = false;
XSETFASTINT (val, from);
return val;
@@ -3085,6 +3086,7 @@ the prefix syntax flag (p). */)
if (pos <= beg)
break;
DEC_BOTH (pos, pos_byte);
+ rarely_quit (pos);
}
SET_PT_BOTH (opoint, opoint_byte);
@@ -3155,6 +3157,7 @@ scan_sexps_forward (struct lisp_parse_state *state,
bool found;
ptrdiff_t out_bytepos, out_charpos;
int temp;
+ unsigned short int quit_count = 0;
prev_from = from;
prev_from_byte = from_byte;
@@ -3173,7 +3176,6 @@ do { prev_from = from; \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
- immediate_quit = true;
maybe_quit ();
depth = state->depth;
@@ -3225,6 +3227,7 @@ do { prev_from = from; \
while (from < end)
{
+ rarely_quit (++quit_count);
INC_FROM;
if ((from < end)
@@ -3281,6 +3284,7 @@ do { prev_from = from; \
goto symdone;
}
INC_FROM;
+ rarely_quit (++quit_count);
}
symdone:
curlevel->prev = curlevel->last;
@@ -3391,6 +3395,7 @@ do { prev_from = from; \
break;
}
INC_FROM;
+ rarely_quit (++quit_count);
}
}
string_end:
@@ -3432,7 +3437,6 @@ do { prev_from = from; \
state->levelstarts);
state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
|| state->quoted) ? prev_from_syntax : Smax;
- immediate_quit = false;
}
/* Convert a (lisp) parse state to the internal form used in
diff --git a/src/sysdep.c b/src/sysdep.c
index e172dc0..91b2a5c 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)
so that another thread running glib won't find them. */
eassert (child > 0);
- while ((pid = waitpid (child, status, options)) < 0)
+ while (true)
{
+ /* Note: the MS-Windows emulation of waitpid calls maybe_quit
+ internally. */
+ if (interruptible)
+ maybe_quit ();
+
+ pid = waitpid (child, status, options);
+ if (0 <= pid)
+ break;
+
/* Check that CHILD is a child process that has not been reaped,
and that STATUS and OPTIONS are valid. Otherwise abort,
as continuing after this internal error could cause Emacs to
become confused and kill innocent-victim processes. */
if (errno != EINTR)
emacs_abort ();
-
- /* Note: the MS-Windows emulation of waitpid calls maybe_quit
- internally. */
- if (interruptible)
- maybe_quit ();
}
/* If successful and status is requested, tell wait_reading_process_output
@@ -2503,78 +2507,113 @@ emacs_close (int fd)
#define MAX_RW_COUNT (INT_MAX >> 18 << 18)
#endif
-/* Read from FILEDESC to a buffer BUF with size NBYTE, retrying if interrupted.
+/* Read from FD to a buffer BUF with size NBYTE.
+ If interrupted, process any quits and pending signals immediately
+ if INTERRUPTIBLE, and then retry the read unless quitting.
Return the number of bytes read, which might be less than NBYTE.
- On error, set errno and return -1. */
-ptrdiff_t
-emacs_read (int fildes, void *buf, ptrdiff_t nbyte)
+ On error, set errno to a value other than EINTR, and return -1. */
+static ptrdiff_t
+emacs_intr_read (int fd, void *buf, ptrdiff_t nbyte, bool interruptible)
{
- ssize_t rtnval;
+ ssize_t result;
/* There is no need to check against MAX_RW_COUNT, since no caller ever
passes a size that large to emacs_read. */
+ do
+ {
+ if (interruptible)
+ maybe_quit ();
+ result = read (fd, buf, nbyte);
+ }
+ while (result < 0 && errno == EINTR);
- while ((rtnval = read (fildes, buf, nbyte)) == -1
- && (errno == EINTR))
- maybe_quit ();
- return (rtnval);
+ return result;
}
-/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if interrupted
- or if a partial write occurs. If interrupted, process pending
- signals if PROCESS SIGNALS. Return the number of bytes written, setting
- errno if this is less than NBYTE. */
+/* Read from FD to a buffer BUF with size NBYTE.
+ If interrupted, retry the read. Return the number of bytes read,
+ which might be less than NBYTE. On error, set errno to a value
+ other than EINTR, and return -1. */
+ptrdiff_t
+emacs_read (int fd, void *buf, ptrdiff_t nbyte)
+{
+ return emacs_intr_read (fd, buf, nbyte, false);
+}
+
+/* Like emacs_read, but also process quits and pending signals. */
+ptrdiff_t
+emacs_read_quit (int fd, void *buf, ptrdiff_t nbyte)
+{
+ return emacs_intr_read (fd, buf, nbyte, true);
+}
+
+/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
+ interrupted or if a partial write occurs. Process any quits
+ immediately if INTERRUPTIBLE is positive, and process any pending
+ signals immediately if INTERRUPTIBLE is nonzero. Return the number
+ of bytes written; if this is less than NBYTE, set errno to a value
+ other than EINTR. */
static ptrdiff_t
-emacs_full_write (int fildes, char const *buf, ptrdiff_t nbyte,
- bool process_signals)
+emacs_full_write (int fd, char const *buf, ptrdiff_t nbyte,
+ int interruptible)
{
ptrdiff_t bytes_written = 0;
while (nbyte > 0)
{
- ssize_t n = write (fildes, buf, min (nbyte, MAX_RW_COUNT));
+ ssize_t n = write (fd, buf, min (nbyte, MAX_RW_COUNT));
if (n < 0)
{
- if (errno == EINTR)
+ if (errno != EINTR)
+ break;
+
+ if (interruptible)
{
- /* I originally used maybe_quit but that might cause files to
- be truncated if you hit C-g in the middle of it. --Stef */
- if (process_signals && pending_signals)
+ if (0 < interruptible)
+ maybe_quit ();
+ if (pending_signals)
process_pending_signals ();
- continue;
}
- else
- break;
}
-
- buf += n;
- nbyte -= n;
- bytes_written += n;
+ else
+ {
+ buf += n;
+ nbyte -= n;
+ bytes_written += n;
+ }
}
return bytes_written;
}
-/* Write to FILEDES from a buffer BUF with size NBYTE, retrying if
- interrupted or if a partial write occurs. Return the number of
- bytes written, setting errno if this is less than NBYTE. */
+/* Write to FD from a buffer BUF with size NBYTE, retrying if
+ interrupted or if a partial write occurs. Do not process quits or
+ pending signals. Return the number of bytes written, setting errno
+ if this is less than NBYTE. */
+ptrdiff_t
+emacs_write (int fd, void const *buf, ptrdiff_t nbyte)
+{
+ return emacs_full_write (fd, buf, nbyte, 0);
+}
+
+/* Like emacs_write, but also process pending signals. */
ptrdiff_t
-emacs_write (int fildes, void const *buf, ptrdiff_t nbyte)
+emacs_write_sig (int fd, void const *buf, ptrdiff_t nbyte)
{
- return emacs_full_write (fildes, buf, nbyte, 0);
+ return emacs_full_write (fd, buf, nbyte, -1);
}
-/* Like emacs_write, but also process pending signals if interrupted. */
+/* Like emacs_write, but also process quits and pending signals. */
ptrdiff_t
-emacs_write_sig (int fildes, void const *buf, ptrdiff_t nbyte)
+emacs_write_quit (int fd, void const *buf, ptrdiff_t nbyte)
{
- return emacs_full_write (fildes, buf, nbyte, 1);
+ return emacs_full_write (fd, buf, nbyte, 1);
}
/* Write a diagnostic to standard error that contains MESSAGE and a
string derived from errno. Preserve errno. Do not buffer stderr.
- Do not process pending signals if interrupted. */
+ Do not process quits or pending signals if interrupted. */
void
emacs_perror (char const *message)
{
@@ -3168,7 +3207,7 @@ system_process_attributes (Lisp_Object pid)
else
{
record_unwind_protect_int (close_file_unwind, fd);
- nread = emacs_read (fd, procbuf, sizeof procbuf - 1);
+ nread = emacs_read_quit (fd, procbuf, sizeof procbuf - 1);
}
if (0 < nread)
{
@@ -3289,7 +3328,7 @@ system_process_attributes (Lisp_Object pid)
/* Leave room even if every byte needs escaping below. */
readsize = (cmdline_size >> 1) - nread;
- nread_incr = emacs_read (fd, cmdline + nread, readsize);
+ nread_incr = emacs_read_quit (fd, cmdline + nread, readsize);
nread += max (0, nread_incr);
}
while (nread_incr == readsize);
@@ -3402,7 +3441,7 @@ system_process_attributes (Lisp_Object pid)
else
{
record_unwind_protect_int (close_file_unwind, fd);
- nread = emacs_read (fd, &pinfo, sizeof pinfo);
+ nread = emacs_read_quit (fd, &pinfo, sizeof pinfo);
}
if (nread == sizeof pinfo)
diff --git a/src/w32fns.c b/src/w32fns.c
index 6a576fc..1b628b0 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -3168,16 +3168,7 @@ signal_user_input (void)
Vquit_flag = Vthrow_on_input;
/* Calling maybe_quit from this thread is a bad idea, since this
unwinds the stack of the Lisp thread, and the Windows runtime
- rightfully barfs. Disabled. */
-#if 0
- /* If we're inside a function that wants immediate quits,
- do it now. */
- if (immediate_quit && NILP (Vinhibit_quit))
- {
- immediate_quit = false;
- maybe_quit ();
- }
-#endif
+ rightfully barfs. */
}
}
diff --git a/src/window.c b/src/window.c
index 71a82b5..bc3f488 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)
{
ptrdiff_t count = SPECPDL_INDEX ();
- immediate_quit = true;
n = clip_to_bounds (INT_MIN, n, INT_MAX);
wset_redisplay (XWINDOW (window));
@@ -4789,7 +4788,6 @@ window_scroll (Lisp_Object window, EMACS_INT n, bool
whole, bool noerror)
/* Bug#15957. */
XWINDOW (window)->window_end_valid = false;
- immediate_quit = false;
}
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
new file mode 100644
index 0000000..807a411
--- /dev/null
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -0,0 +1,203 @@
+;; Copyright (C) 2017 Free Software Foundation, Inc
+
+;; Author: Dima Kogan <address@hidden>
+;; Maintainer: address@hidden
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'diff-mode)
+
+
+(ert-deftest diff-mode-test-ignore-trailing-dashes ()
+ "Check to make sure we successfully ignore trailing -- made by
+'git format-patch'. This is bug #9597"
+
+ ;; I made a test repo, put some files in it, made arbitrary changes
+ ;; and invoked 'git format-patch' to get a patch out of it. The
+ ;; patch and the before and after versions of the files appear here.
+ ;; The test simply tries to apply the patch. The patch contains
+ ;; trailing --, which confused diff-mode previously
+ (let ((patch "From 18ed35640be496647e0a02fc155b4ee4a0490eca Mon Sep 17
00:00:00 2001
+From: Dima Kogan <address@hidden>
+Date: Mon, 30 Jan 2017 22:24:13 -0800
+Subject: [PATCH] test commit
+
+---
+ fil | 3 ---
+ fil2 | 4 ----
+ 2 files changed, 7 deletions(-)
+
+diff --git a/fil b/fil
+index 10344f1..2a56245 100644
+--- a/fil
++++ b/fil
+@@ -2,10 +2,8 @@ Afrocentrism
+ Americanisms
+ Americanization
+ Americanizations
+-Americanized
+ Americanizes
+ Americanizing
+-Andrianampoinimerina
+ Anglicanisms
+ Antananarivo
+ Apalachicola
+@@ -15,6 +13,5 @@ Aristophanes
+ Aristotelian
+ Ashurbanipal
+ Australopithecus
+-Austronesian
+ Bangladeshis
+ Barquisimeto
+diff --git a/fil2 b/fil2
+index 8858f0d..86e8ea5 100644
+--- a/fil2
++++ b/fil2
+@@ -1,20 +1,16 @@
+ whippoorwills
+ whitewashing
+ wholehearted
+-wholeheartedly
+ wholesomeness
+ wildernesses
+ windbreakers
+ wisecracking
+ withstanding
+-woodcarvings
+ woolgathering
+ workstations
+ worthlessness
+ wretchedness
+ wristwatches
+-wrongfulness
+ wrongheadedly
+ wrongheadedness
+-xylophonists
+ youthfulness
+--
+2.11.0
+
+")
+ (fil_before "Afrocentrism
+Americanisms
+Americanization
+Americanizations
+Americanized
+Americanizes
+Americanizing
+Andrianampoinimerina
+Anglicanisms
+Antananarivo
+Apalachicola
+Appalachians
+Argentinians
+Aristophanes
+Aristotelian
+Ashurbanipal
+Australopithecus
+Austronesian
+Bangladeshis
+Barquisimeto
+")
+ (fil_after "Afrocentrism
+Americanisms
+Americanization
+Americanizations
+Americanizes
+Americanizing
+Anglicanisms
+Antananarivo
+Apalachicola
+Appalachians
+Argentinians
+Aristophanes
+Aristotelian
+Ashurbanipal
+Australopithecus
+Bangladeshis
+Barquisimeto
+")
+ (fil2_before "whippoorwills
+whitewashing
+wholehearted
+wholeheartedly
+wholesomeness
+wildernesses
+windbreakers
+wisecracking
+withstanding
+woodcarvings
+woolgathering
+workstations
+worthlessness
+wretchedness
+wristwatches
+wrongfulness
+wrongheadedly
+wrongheadedness
+xylophonists
+youthfulness
+")
+ (fil2_after "whippoorwills
+whitewashing
+wholehearted
+wholesomeness
+wildernesses
+windbreakers
+wisecracking
+withstanding
+woolgathering
+workstations
+worthlessness
+wretchedness
+wristwatches
+wrongheadedly
+wrongheadedness
+youthfulness
+")
+ (temp-dir (make-temp-file "diff-mode-test" 'dir)))
+
+ (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
+ (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
+ (unwind-protect
+ (progn
+ (with-current-buffer buf (insert fil_before) (save-buffer))
+ (with-current-buffer buf2 (insert fil2_before) (save-buffer))
+
+ (with-temp-buffer
+ (cd temp-dir)
+ (insert patch)
+ (beginning-of-buffer)
+ (diff-apply-hunk)
+ (diff-apply-hunk)
+ (diff-apply-hunk))
+
+ (should (equal (with-current-buffer buf (buffer-string))
+ fil_after))
+ (should (equal (with-current-buffer buf2 (buffer-string))
+ fil2_after)))
+
+ (ignore-errors
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf)
+ (with-current-buffer buf2 (set-buffer-modified-p nil))
+ (kill-buffer buf2)
+ (delete-directory temp-dir 'recursive))))))
+
+
+(provide 'diff-mode-tests)