* semantic/fw.el (semantic-exit-on-input)

(semantic-throw-on-input): Restore point before
accept-process-output because timers which redisplay can run.
(Bug#15045)
This commit is contained in:
Barry O'Reilly 2013-11-16 15:27:24 -05:00
parent 0010ca514d
commit 2bde2cf143
2 changed files with 21 additions and 2 deletions

View file

@ -1,3 +1,10 @@
2013-10-28 Barry O'Reilly <gundaetiapo@gmail.com>
* semantic/fw.el (semantic-exit-on-input)
(semantic-throw-on-input): Restore point before
accept-process-output because timers which redisplay can run.
(Bug#15045)
2013-11-03 Johan Bockgård <bojohan@gnu.org>
* semantic/lex.el (semantic-lex-start-block)

View file

@ -369,6 +369,8 @@ later installation should be done in MODE hook."
;;
(defvar semantic-current-input-throw-symbol nil
"The current throw symbol for `semantic-exit-on-input'.")
(defvar semantic--on-input-start-marker nil
"The marker when starting a semantic-exit-on-input form.")
(defmacro semantic-exit-on-input (symbol &rest forms)
"Using SYMBOL as an argument to `throw', execute FORMS.
@ -376,7 +378,8 @@ If FORMS includes a call to `semantic-throw-on-input', then
if a user presses any key during execution, this form macro
will exit with the value passed to `semantic-throw-on-input'.
If FORMS completes, then the return value is the same as `progn'."
`(let ((semantic-current-input-throw-symbol ,symbol))
`(let ((semantic-current-input-throw-symbol ,symbol)
(semantic--on-input-start-marker (point-marker)))
(catch ,symbol
,@forms)))
(put 'semantic-exit-on-input 'lisp-indent-function 1)
@ -387,7 +390,16 @@ FROM is an indication of where this function is called from as a value
to pass to `throw'. It is recommended to use the name of the function
calling this one."
`(when (and semantic-current-input-throw-symbol
(or (input-pending-p) (accept-process-output)))
(or (input-pending-p)
(save-excursion
;; Timers might run during accept-process-output.
;; If they redisplay, point must be where the user
;; expects. (Bug#15045)
(set-buffer (marker-buffer
semantic--on-input-start-marker))
(goto-char (marker-position
semantic--on-input-start-marker))
(accept-process-output))))
(throw semantic-current-input-throw-symbol ,from)))