branch: externals/phps-mode commit ad75e7576683c266fd1d2c13f7d83e1823b15894 Author: Christian Johansson <christ...@cvj.se> Commit: Christian Johansson <christ...@cvj.se>
Serial commands now captures all kinds of signals --- phps-mode-lex-analyzer.el | 2 +- phps-mode-serial.el | 164 +++++++++++++++++++++++----------------------- phps-mode.el | 4 +- 3 files changed, 84 insertions(+), 86 deletions(-) diff --git a/phps-mode-lex-analyzer.el b/phps-mode-lex-analyzer.el index 51d2460..dd65d9a 100644 --- a/phps-mode-lex-analyzer.el +++ b/phps-mode-lex-analyzer.el @@ -2164,7 +2164,7 @@ SQUARE-BRACKET-LEVEL and ROUND-BRACKET-LEVEL." (phps-mode-lex-analyzer--reset-imenu) (phps-mode-lex-analyzer--start-idle-timer) - (phps-mode-serial-commands--kill-active (buffer-name))) + (phps-mode-serial--kill-active (buffer-name))) (when (or (not phps-mode-lex-analyzer--change-min) diff --git a/phps-mode-serial.el b/phps-mode-serial.el index 276bf34..b4f59a2 100644 --- a/phps-mode-serial.el +++ b/phps-mode-serial.el @@ -1,4 +1,4 @@ -;;; phps-mode-serial.el --- Functions for synchronity -*- lexical-binding: t -*- +;;; phps-mode-serial.el --- Functions for serial commands with varied synchronicity -*- lexical-binding: t -*- ;; Copyright (C) 2018-2020 Free Software Foundation, Inc. @@ -10,6 +10,7 @@ ;; VARIABLES + (defvar phps-mode-serial--async-processes (make-hash-table :test 'equal) "Table of active asynchronous processes.") @@ -38,20 +39,19 @@ "Current status of serial-commands.") (defconst phps-mode-serial--mode-line-status-run - '(" [" + '(":" (:propertize (:eval (if (equal phps-mode-serial--status 'running) "Running.." "")) face phps-mode-serial--mode-line-face-running) (: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))) ;; FUNCTIONS -(defun phps-mode-serial-commands--kill-active (key) +(defun phps-mode-serial--kill-active (key) "Kill active command KEY." (when (and (gethash key phps-mode-serial--async-processes) @@ -65,89 +65,87 @@ (thread-signal (gethash key phps-mode-serial--async-threads) 'quit nil))) (defun phps-mode-serial-commands (key start end &optional async async-by-process) - "Run command with KEY, first START and if successfully then END with the result of START as argument. Optional arguments ASYNC ASYNC-BY-PROCESS specifies additional opions." + "Run command with KEY, first START and if successfully then END with the result of START as argument. Optional arguments ASYNC ASYNC-BY-PROCESS specifies additional options." (let ((start-time (current-time))) (when phps-mode-serial--profiling (message "PHPs - Starting serial commands for buffer '%s'.." key)) (with-current-buffer key (setq mode-line-process phps-mode-serial--mode-line-status-run) (setq phps-mode-serial--status 'running)) - (phps-mode-serial-commands--kill-active key) + (phps-mode-serial--kill-active key) (if async (if async-by-process - (progn - (unless (fboundp 'async-start) - (signal 'error (list "Async-start function is missing"))) - - ;; Run command(s) asynchronously - (let ((script-filename - (file-name-directory - (symbol-file 'phps-mode)))) - (puthash - key - (async-start - (lambda() - (add-to-list 'load-path script-filename) - (require 'phps-mode) - - ;; Execute start lambda - (condition-case conditions - (progn - (let ((start-return (funcall start))) - (list 'success start-return start-time))) - (error (list 'error (cdr conditions) start-time)))) - (lambda (start-return) - (let ((status (car start-return)) - (value (car (cdr start-return))) - (start-time (car (cdr (cdr start-return)))) - (end-return nil)) - - ;; 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 process start finished, elapsed: %fs" elapsed))) - - (if (string= status "success") + (if (fboundp 'async-start) + ;; Run command(s) asynchronously + (let ((script-filename + (file-name-directory + (symbol-file 'phps-mode)))) + (puthash + key + (async-start + (lambda() + (add-to-list 'load-path script-filename) + (require 'phps-mode) + + ;; Execute start lambda + (condition-case conditions (progn - - ;; Execute end lambda - (condition-case conditions - (progn - (let ((return (funcall end value))) - (setq end-return (list 'success return start-time)))) - (error (setq end-return (list 'error (cdr 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 finished, elapsed: %fs" elapsed))) - - (let ((status (car end-return)) - (value (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)) - (display-warning 'phps-mode (format "%s" (car value)))))) - (when (string= status "error") - (with-current-buffer key - (setq phps-mode-serial--status 'error)) - (display-warning 'phps-mode (format "%s" (car value)))))))) - phps-mode-serial--async-processes))) + (let ((start-return (funcall start))) + (list 'success start-return start-time))) + (t (list 'error (cdr conditions) start-time)))) + (lambda (start-return) + (let ((status (car start-return)) + (value (car (cdr start-return))) + (start-time (car (cdr (cdr start-return)))) + (end-return nil)) + + ;; 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 process start finished, elapsed: %fs" elapsed))) + + (if (string= status "success") + (progn + + ;; Execute end lambda + (condition-case conditions + (progn + (let ((return (funcall end value))) + (setq end-return (list 'success return start-time)))) + (t (setq end-return (list 'error (cdr 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 finished, elapsed: %fs" elapsed))) + + (let ((status (car end-return)) + (value (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)) + (display-warning 'phps-mode (format "%s" (car value)))))) + (when (string= status "error") + (with-current-buffer key + (setq phps-mode-serial--status 'error)) + (display-warning 'phps-mode (format "%s" (car value)))))))) + phps-mode-serial--async-processes)) + (signal 'error (list "Async-start function is missing"))) ;; Run command(s) asynchronously (puthash @@ -161,7 +159,7 @@ (condition-case conditions (let ((return (funcall start))) (setq start-return (list 'success return start-time))) - (error (setq start-return (list 'error (cdr conditions) start-time)))) + (t (setq start-return (list 'error (cdr conditions) start-time)))) ;; Profile execution in debug mode (when phps-mode-serial--profiling @@ -183,7 +181,7 @@ (condition-case conditions (let ((return (funcall end value))) (setq end-return (list 'success return start-time))) - (error (setq end-return (list 'error (cdr conditions) start-time)))) + (t (setq end-return (list 'error (cdr conditions) start-time)))) ;; Profile execution (when phps-mode-serial--profiling @@ -222,7 +220,7 @@ (progn (let ((return (funcall start))) (setq start-return (list 'success return start-time)))) - (error (setq start-return (list 'error (cdr conditions) start-time)))) + (t (setq start-return (list 'error (cdr conditions) start-time)))) ;; Profile execution in debug mode (when phps-mode-serial--profiling @@ -245,7 +243,7 @@ (condition-case conditions (let ((return (funcall end value))) (setq end-return (list 'success return start-time))) - (error (setq end-return (list 'error (cdr conditions) start-time)))) + (t (setq end-return (list 'error (cdr conditions) start-time)))) ;; Profile execution in debug mode (when phps-mode-serial--profiling diff --git a/phps-mode.el b/phps-mode.el index 9bdd4e1..139a3b0 100644 --- a/phps-mode.el +++ b/phps-mode.el @@ -5,8 +5,8 @@ ;; Author: Christian Johansson <christ...@cvj.se> ;; Maintainer: Christian Johansson <christ...@cvj.se> ;; Created: 3 Mar 2018 -;; Modified: 23 Feb 2020 -;; Version: 0.3.37 +;; Modified: 26 Feb 2020 +;; Version: 0.3.38 ;; Keywords: tools, convenience ;; URL: https://github.com/cjohansson/emacs-phps-mode