branch: externals/phps-mode commit 12ed875deddceb8ecbcddab00cd1e96156de71e9 Author: Christian Johansson <christ...@cvj.se> Commit: Christian Johansson <christ...@cvj.se>
Added quit-detection in synchronous processing --- phps-mode-serial.el | 117 ++++++++++++++++++++++++++++------------------------ 1 file changed, 62 insertions(+), 55 deletions(-) diff --git a/phps-mode-serial.el b/phps-mode-serial.el index e830cd5793..36069ea6e5 100644 --- a/phps-mode-serial.el +++ b/phps-mode-serial.el @@ -265,66 +265,73 @@ (setq phps-mode-serial--status 'aborted))))))) (let ((start-return) - (end-return)) - - ;; Run start and catch potential errors - (condition-case conditions + (end-return) + (quitted t)) + (unwind-protect (progn - (let ((return (funcall start))) - (setq start-return (list 'success return start-time)))) - (error (setq start-return (list 'error conditions start-time)))) - - ;; Profile execution in debug mode - (when phps-mode-serial--profiling - (let* ((end-time (current-time)) - (end-time-float - (+ (car end-time) (car (cdr end-time)) (* (car (cdr (cdr end-time))) 0.000001))) - (start-time-float - (+ (car start-time) (car (cdr start-time)) (* (car (cdr (cdr start-time))) 0.000001))) - (elapsed (- end-time-float start-time-float))) - (message "Serial synchronous thread start finished, elapsed: %fs" elapsed))) - - (let ((status (car start-return)) - (value (car (cdr start-return))) - (start-time (car (cdr (cdr start-return))))) - - (if (string= status "success") - (progn - - ;; Then execute end lambda - (condition-case conditions - (let ((return (funcall end value))) - (setq end-return (list 'success return start-time))) - (error (setq end-return (list 'error conditions start-time)))) - - ;; Profile execution in debug mode - (when phps-mode-serial--profiling - (let* ((end-time (current-time)) - (end-time-float - (+ (car end-time) (car (cdr end-time)) (* (car (cdr (cdr end-time))) 0.000001))) - (start-time-float - (+ (car start-time) (car (cdr start-time)) (* (car (cdr (cdr start-time))) 0.000001))) - (elapsed (- end-time-float start-time-float))) - (message "Serial synchronous thread end finished, elapsed: %fs" elapsed))) - - (let ((status (car end-return)) - (value (car (cdr end-return)))) - - (when (string= status "success") - (with-current-buffer key - (setq phps-mode-serial--status 'success))) + + ;; Run start and catch potential errors + (condition-case conditions + (progn + (let ((return (funcall start))) + (setq start-return (list 'success return start-time)))) + (error (setq start-return (list 'error conditions start-time)))) + + ;; Profile execution in debug mode + (when phps-mode-serial--profiling + (let* ((end-time (current-time)) + (end-time-float + (+ (car end-time) (car (cdr end-time)) (* (car (cdr (cdr end-time))) 0.000001))) + (start-time-float + (+ (car start-time) (car (cdr start-time)) (* (car (cdr (cdr start-time))) 0.000001))) + (elapsed (- end-time-float start-time-float))) + (message "Serial synchronous thread start finished, elapsed: %fs" elapsed))) + + (let ((status (car start-return)) + (value (car (cdr start-return))) + (start-time (car (cdr (cdr start-return))))) + + (if (string= status "success") + (progn + + ;; Then execute end lambda + (condition-case conditions + (let ((return (funcall end value))) + (setq end-return (list 'success return start-time))) + (error (setq end-return (list 'error conditions start-time)))) + + ;; Profile execution in debug mode + (when phps-mode-serial--profiling + (let* ((end-time (current-time)) + (end-time-float + (+ (car end-time) (car (cdr end-time)) (* (car (cdr (cdr end-time))) 0.000001))) + (start-time-float + (+ (car start-time) (car (cdr start-time)) (* (car (cdr (cdr start-time))) 0.000001))) + (elapsed (- end-time-float start-time-float))) + (message "Serial synchronous thread end finished, elapsed: %fs" elapsed))) + + (let ((status (car end-return)) + (value (car (cdr end-return)))) + + (when (string= status "success") + (with-current-buffer key + (setq phps-mode-serial--status 'success))) + + (when (string= status "error") + (with-current-buffer key + (setq phps-mode-serial--status 'error)) + (when end-error + (funcall end-error value))))) (when (string= status "error") (with-current-buffer key (setq phps-mode-serial--status 'error)) - (when end-error - (funcall end-error value))))) - - (when (string= status "error") - (with-current-buffer key - (setq phps-mode-serial--status 'error)) - (when start-error - (funcall start-error value))))) + (when start-error + (funcall start-error value))))) + (setq quitted nil)) + (when quitted + (with-current-buffer key + (setq phps-mode-serial--status 'aborted)))) end-return)))) (provide 'phps-mode-serial)