[elpa] externals/phps-mode 967e3c7db4 1/7: Showing new buffer status if threaded parse is quitted

[Christian Johansson]

branch: externals/phps-mode
commit 967e3c7db477225c7e63531fe8c3cf4b66aff0c9
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    Showing new buffer status if threaded parse is quitted
---
 phps-mode-serial.el | 191 ++++++++++++++++++++++++++++------------------------
 1 file changed, 102 insertions(+), 89 deletions(-)

diff --git a/phps-mode-serial.el b/phps-mode-serial.el
index 73e2a93701..e830cd5793 100644
--- a/phps-mode-serial.el
+++ b/phps-mode-serial.el
@@ -44,7 +44,9 @@
     (:propertize (:eval (if (equal phps-mode-serial--status 'error) "Error" 
""))
                  face phps-mode-serial--mode-line-face-error)
     (:propertize (:eval (if (equal phps-mode-serial--status 'success) "OK" ""))
-                 face phps-mode-serial--mode-line-face-success)))
+                 face phps-mode-serial--mode-line-face-success)
+    (:propertize (:eval (if (equal phps-mode-serial--status 'aborted) 
"Aborted" ""))
+                 face phps-mode-serial--mode-line-face-error)))
 
 
 ;; FUNCTIONS
@@ -154,38 +156,44 @@
           (let ((async-thread
                  (make-thread
                   (lambda()
-                    (let ((start-return))
-
-                      ;; First execute start lambda
-                      (condition-case conditions
-                          (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 asynchronous thread start finished, 
elapsed: %fs"
-                           elapsed)))
-
-                      start-return))
+                    (let ((quitted t))
+                      (unwind-protect
+                          (let ((start-return))
+
+                            ;; First execute start lambda
+                            (condition-case conditions
+                                (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 asynchronous thread start finished, 
elapsed: %fs"
+                                 elapsed)))
+
+                            (setq quitted nil)
+                            start-return)
+                        (when quitted
+                          (with-current-buffer key
+                            (setq phps-mode-serial--status 'aborted))))))
                   key)))
             (puthash
              key
@@ -194,62 +202,67 @@
 
             (make-thread
              (lambda()
-                (let ((start-return (thread-join async-thread))
-                      (end-return))
-                  (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
-                          (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 asynchronous 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 start-error
-                          (funcall start-error value))))))))))
+               (let ((quitted t))
+                 (let ((start-return (thread-join async-thread))
+                       (end-return))
+                   (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
+                           (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 asynchronous 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 start-error
+                           (funcall start-error value))))))
+                 (setq quitted nil))
+               (when quitted
+                 (with-current-buffer key
+                   (setq phps-mode-serial--status 'aborted)))))))
 
       (let ((start-return)
             (end-return))