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