[elpa] externals/phps-mode 12ed875ded 2/7: Added quit-detection in synchronous processing

[Christian Johansson]

branch: externals/phps-mode
commit 12ed875deddceb8ecbcddab00cd1e96156de71e9
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@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)