[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/phps-mode d3ae8da: Improved error-handling and error-pr
|
From: |
Christian Johansson |
|
Subject: |
[elpa] externals/phps-mode d3ae8da: Improved error-handling and error-presentation |
|
Date: |
Mon, 18 May 2020 10:49:31 -0400 (EDT) |
branch: externals/phps-mode
commit d3ae8da2acf67db1717784132cc87071cfcb9057
Author: Christian Johansson <address@hidden>
Commit: Christian Johansson <address@hidden>
Improved error-handling and error-presentation
---
phps-mode-lex-analyzer.el | 123 ++++++++++++++++--------------
phps-mode-lexer.el | 185 ++++++++++++++++++++++++----------------------
phps-mode-serial.el | 40 +++++-----
phps-mode.el | 4 +-
4 files changed, 191 insertions(+), 161 deletions(-)
diff --git a/phps-mode-lex-analyzer.el b/phps-mode-lex-analyzer.el
index 89f79c1..d3a87b3 100644
--- a/phps-mode-lex-analyzer.el
+++ b/phps-mode-lex-analyzer.el
@@ -342,7 +342,9 @@
(setq async nil))
(phps-mode-serial-commands
buffer-name
- (lambda() (phps-mode-lex-analyzer--lex-string buffer-contents))
+ (lambda()
+ (phps-mode-lex-analyzer--lex-string buffer-contents))
+
(lambda(result)
(when (get-buffer buffer-name)
(with-current-buffer buffer-name
@@ -363,27 +365,33 @@
(let ((token-syntax-color
(phps-mode-lex-analyzer--get-token-syntax-color token-name)))
(if token-syntax-color
(phps-mode-lex-analyzer--set-region-syntax-color start
end token-syntax-color)
- (phps-mode-lex-analyzer--clear-region-syntax-color start
end)))))
+ (phps-mode-lex-analyzer--clear-region-syntax-color start
end))))))))
+
+ (lambda(result)
+ (when (get-buffer buffer-name)
+ (with-current-buffer buffer-name
+ (let ((error-type (nth 0 result))
+ (error-message (nth 1 result))
+ (error-start (nth 2 result))
+ (error-end (nth 3 result)))
+ (when error-message
+ (if (equal error-type 'phps-lexer-error)
+ (progn
+ (when error-start
+ (if error-end
+ (phps-mode-lex-analyzer--set-region-syntax-color
+ error-start
+ error-end
+ (list 'font-lock-face 'font-lock-warning-face))
+ (phps-mode-lex-analyzer--set-region-syntax-color
+ error-start
+ (point-max)
+ (list 'font-lock-face 'font-lock-warning-face))))
+ (display-warning 'phps-mode error-message :warning "*PHPs
Lexer Errors*"))
+ (display-warning error-type error-message :warning)))))))
+
+ nil
- (let ((errors (nth 4 result))
- (error-start)
- (error-end))
- (when errors
- (setq error-start (car (cdr errors)))
- (when error-start
- (if (car (cdr (cdr errors)))
- (progn
- (setq error-end (car (cdr (cdr (cdr errors)))))
- (phps-mode-lex-analyzer--set-region-syntax-color
- error-start
- error-end
- (list 'font-lock-face 'font-lock-warning-face)))
- (setq error-end (point-max))
- (phps-mode-lex-analyzer--set-region-syntax-color
- error-start
- error-end
- (list 'font-lock-face 'font-lock-warning-face))))
- (signal 'error (list (format "Lex Errors: %s" (car
errors)))))))))
async
async-by-process)))
@@ -407,6 +415,7 @@
incremental-state
incremental-state-stack
head-tokens))
+
(lambda(result)
(when (get-buffer buffer-name)
(with-current-buffer buffer-name
@@ -433,28 +442,33 @@
(phps-mode-lex-analyzer--set-region-syntax-color start
end token-syntax-color)
(phps-mode-lex-analyzer--clear-region-syntax-color start
end)))))
- (let ((errors (nth 4 result))
- (error-start)
- (error-end))
- (when errors
- (setq error-start (car (cdr errors)))
- (when error-start
- (if (car (cdr (cdr errors)))
- (progn
- (setq error-end (car (cdr (cdr (cdr errors)))))
- (phps-mode-lex-analyzer--set-region-syntax-color
- error-start
- error-end
- (list 'font-lock-face 'font-lock-warning-face)))
- (setq error-end (point-max))
- (phps-mode-lex-analyzer--set-region-syntax-color
- error-start
- error-end
- (list 'font-lock-face 'font-lock-warning-face))))
- (signal 'error (list (format "Incremental Lex Errors: %s" (car
errors))))))
-
(phps-mode-debug-message
(message "Incremental tokens: %s" incremental-tokens)))))
+
+ (lambda(result)
+ (when (get-buffer buffer-name)
+ (with-current-buffer buffer-name
+ (let ((error-type (nth 0 result))
+ (error-message (nth 1 result))
+ (error-start (nth 2 result))
+ (error-end (nth 3 result)))
+ (when error-message
+ (if (equal error-type 'phps-lexer-error)
+ (progn
+ (when error-start
+ (if error-end
+ (phps-mode-lex-analyzer--set-region-syntax-color
+ error-start
+ error-end
+ (list 'font-lock-face 'font-lock-warning-face))
+ (phps-mode-lex-analyzer--set-region-syntax-color
+ error-start
+ (point-max)
+ (list 'font-lock-face 'font-lock-warning-face))))
+ (display-warning 'phps-mode error-message :warning "*PHPs
Lexer Errors*"))
+ (display-warning error-type error-message :warning)))))))
+
+ nil
async
async-by-process)))
@@ -2407,20 +2421,21 @@ SQUARE-BRACKET-LEVEL and ROUND-BRACKET-LEVEL."
(setq semantic-lex-analyzer #'phps-mode-lex-analyzer--re2c-lex)
;; Catch errors to kill generated buffer
- (condition-case conditions
- (progn
+ (let ((got-error t))
+ (unwind-protect
;; Run lexer or incremental lexer
- (if (and start end)
- (let ((incremental-tokens (semantic-lex start end)))
- (setq
- phps-mode-lex-analyzer--tokens
- (append tokens incremental-tokens)))
- (setq
- phps-mode-lex-analyzer--tokens
- (semantic-lex-buffer))))
- ((error t) (progn
- (kill-buffer)
- (signal 'error (cdr conditions)))))
+ (progn
+ (if (and start end)
+ (let ((incremental-tokens (semantic-lex start end)))
+ (setq
+ phps-mode-lex-analyzer--tokens
+ (append tokens incremental-tokens)))
+ (setq
+ phps-mode-lex-analyzer--tokens
+ (semantic-lex-buffer)))
+ (setq got-error nil))
+ (when got-error
+ (kill-buffer))))
;; Copy variables outside of buffer
(setq state phps-mode-lexer--state)
diff --git a/phps-mode-lexer.el b/phps-mode-lexer.el
index 7f50ab2..d3dbeb6 100644
--- a/phps-mode-lexer.el
+++ b/phps-mode-lexer.el
@@ -39,6 +39,9 @@
(require 'subr-x)
+(define-error 'phps-lexer-error "PHPs Lexer Error")
+
+
;; INITIALIZE SETTINGS
@@ -147,7 +150,7 @@
(if old-state
(phps-mode-lexer--BEGIN old-state)
(signal
- 'error
+ 'phps-lexer-error
(list
(format "Trying to pop last state at %d" (point))
(point))))))
@@ -244,12 +247,14 @@
(defun phps-mode-lexer--re2c-execute ()
"Execute matching body (if any)."
(if phps-mode-lexer--match-body
- (progn
+ (progn
(set-match-data phps-mode-lexer--match-data)
(funcall phps-mode-lexer--match-body))
(signal
- 'error
- (list "Found no matching lexer rule to execute at %d" (point)))))
+ 'phps-lexer-error
+ (list
+ (format "Found no matching lexer rule to execute at %d" (point))
+ (point)))))
(defun phps-mode-lexer--reset-match-data ()
"Reset match data."
@@ -540,13 +545,13 @@
")")))
(when (phps-mode-wy-macros--CG 'PARSER_MODE)
(signal
- 'error (list
- (format
- "The (real) cast is deprecated, use (float) instead at %d"
- (match-beginning 0)
- )
- (match-beginning 0)
- (match-end 0)))
+ 'phps-lexer-error
+ (list
+ (format
+ "The (real) cast is deprecated, use (float) instead at %d"
+ (match-beginning 0))
+ (match-beginning 0)
+ (match-end 0)))
(phps-mode-lexer--RETURN_TOKEN 'T_DOUBLE_CAST (match-beginning 0)
(match-end 0))))
(phps-mode-lexer--match-macro
@@ -1101,12 +1106,12 @@
(phps-mode-lexer--RETURN_TOKEN 'T_COMMENT start (match-end
0)))
(progn
(signal
- 'error
- (list (format
- "Un-terminated comment starting at %d"
- (point))
- (point)
- )))))))
+ 'phps-lexer-error
+ (list
+ (format
+ "Un-terminated comment starting at %d"
+ start)
+ start)))))))
(phps-mode-lexer--match-macro
(and ST_IN_SCRIPTING (looking-at (concat "\\?>"
phps-mode-lexer--NEWLINE "?")))
@@ -1199,7 +1204,7 @@
(progn
(setq open-quote nil)
(signal
- 'error
+ 'phps-lexer-error
(list
(format "Found no ending of quote at %s" start)
start))))))))
@@ -1276,7 +1281,8 @@
(phps-mode-lexer--match-macro
(and ST_DOUBLE_QUOTES (looking-at phps-mode-lexer--ANY_CHAR))
- (let ((start (point)))
+ (let ((start (point))
+ (start-error (car (cdr (nth 2 phps-mode-lexer--tokens)))))
(let ((string-start (search-forward-regexp "[^\\\\]\"" nil t)))
(if string-start
(let* ((end (- (match-end 0) 1))
@@ -1296,92 +1302,95 @@
)))
(progn
(signal
- 'error
+ 'phps-lexer-error
(list
- (format "Found no ending of double quoted region starting at
%d" start)
- start)))))))
+ (format "Found no ending of double quoted region starting at
%d" start-error)
+ start-error)))))))
(phps-mode-lexer--match-macro
(and ST_BACKQUOTE (looking-at phps-mode-lexer--ANY_CHAR))
- (let ((string-start (search-forward-regexp "\\([^\\\\]`\\|\\$\\|{\\)"
nil t)))
- (if string-start
- (let ((start (- (match-end 0) 1)))
- ;; (message "Skipping backquote forward over %s"
(buffer-substring-no-properties old-start start))
- (phps-mode-lexer--RETURN_TOKEN 'T_CONSTANT_ENCAPSED_STRING
old-start start)
- )
- (progn
- (signal
- 'error
- (list
- (format "Found no ending of back-quoted string starting at %d"
(point))
- (point)))))))
+ (let ((start (car (cdr (car phps-mode-lexer--tokens)))))
+ (let ((string-start (search-forward-regexp "\\([^\\\\]`\\|\\$\\|{\\)"
nil t)))
+ (if string-start
+ (let ((start (- (match-end 0) 1)))
+ ;; (message "Skipping backquote forward over %s"
(buffer-substring-no-properties old-start start))
+ (phps-mode-lexer--RETURN_TOKEN 'T_CONSTANT_ENCAPSED_STRING
old-start start))
+ (progn
+ (signal
+ 'phps-lexer-error
+ (list
+ (format "Found no ending of back-quoted string starting at
%d" start)
+ start)))))))
(phps-mode-lexer--match-macro
(and ST_HEREDOC (looking-at phps-mode-lexer--ANY_CHAR))
;; Check for $, ${ and {$ forward
- (let ((string-start
- (search-forward-regexp
- (concat
- "\\(\n"
- heredoc-label
- ";?\n\\|\\$"
- phps-mode-lexer--LABEL
- "\\|{\\$"
- phps-mode-lexer--LABEL
- "\\|\\${"
- phps-mode-lexer--LABEL
- "\\)"
- ) nil t)))
- (if string-start
- (let* ((start (match-beginning 0))
- (end (match-end 0))
- (data (buffer-substring-no-properties start end)))
- ;; (message "Found something ending at %s" data)
-
- (cond
-
- ((string-match (concat "\n" heredoc-label ";?\n") data)
- ;; (message "Found heredoc end at %s-%s" start end)
- (phps-mode-lexer--BEGIN 'ST_END_HEREDOC)
- (phps-mode-lexer--RETURN_TOKEN 'T_ENCAPSED_AND_WHITESPACE
old-start start))
+ (let ((start (car (cdr (car phps-mode-lexer--tokens)))))
+ (let ((string-start
+ (search-forward-regexp
+ (concat
+ "\\(\n"
+ heredoc-label
+ ";?\n\\|\\$"
+ phps-mode-lexer--LABEL
+ "\\|{\\$"
+ phps-mode-lexer--LABEL
+ "\\|\\${"
+ phps-mode-lexer--LABEL
+ "\\)"
+ ) nil t)))
+ (if string-start
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (data (buffer-substring-no-properties start end)))
+ ;; (message "Found something ending at %s" data)
- (t
- ;; (message "Found variable at '%s'.. Skipping forward to %s"
data start)
- (phps-mode-lexer--RETURN_TOKEN 'T_ENCAPSED_AND_WHITESPACE
old-start start)
- )
+ (cond
- ))
- (progn
- (signal
- 'error
- (list
- (format "Found no ending of heredoc at %d" (point))
- (point)))))))
+ ((string-match (concat "\n" heredoc-label ";?\n") data)
+ ;; (message "Found heredoc end at %s-%s" start end)
+ (phps-mode-lexer--BEGIN 'ST_END_HEREDOC)
+ (phps-mode-lexer--RETURN_TOKEN 'T_ENCAPSED_AND_WHITESPACE
old-start start))
+
+ (t
+ ;; (message "Found variable at '%s'.. Skipping forward to
%s" data start)
+ (phps-mode-lexer--RETURN_TOKEN 'T_ENCAPSED_AND_WHITESPACE
old-start start)
+ )
+
+ ))
+ (progn
+ (signal
+ 'phps-lexer-error
+ (list
+ (format "Found no ending of heredoc starting at %d" start)
+ start)))))))
(phps-mode-lexer--match-macro
(and ST_NOWDOC (looking-at phps-mode-lexer--ANY_CHAR))
- (let ((string-start (search-forward-regexp (concat "\n" heredoc-label
";?\\\n") nil t)))
- (if string-start
- (let* ((start (match-beginning 0))
- (end (match-end 0))
- (_data (buffer-substring-no-properties start end)))
- ;; (message "Found something ending at %s" _data)
- ;; (message "Found nowdoc end at %s-%s" start end)
- (phps-mode-lexer--BEGIN 'ST_END_HEREDOC)
- (phps-mode-lexer--RETURN_TOKEN 'T_ENCAPSED_AND_WHITESPACE
old-start start))
- (progn
- (signal
- 'error
- (list
- (format "Found no ending of newdoc starting at %d" (point))
- (point)))))))
+ (let ((start (car (cdr (car phps-mode-lexer--tokens)))))
+ (let ((string-start (search-forward-regexp (concat "\n" heredoc-label
";?\\\n") nil t)))
+ (if string-start
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (_data (buffer-substring-no-properties start end)))
+ ;; (message "Found something ending at %s" _data)
+ ;; (message "Found nowdoc end at %s-%s" start end)
+ (phps-mode-lexer--BEGIN 'ST_END_HEREDOC)
+ (phps-mode-lexer--RETURN_TOKEN 'T_ENCAPSED_AND_WHITESPACE
old-start start))
+ (progn
+ (signal
+ 'phps-lexer-error
+ (list
+ (format "Found no ending of nowdoc starting at %d" start)
+ start)))))))
(phps-mode-lexer--match-macro
(and (or ST_IN_SCRIPTING ST_VAR_OFFSET) (looking-at
phps-mode-lexer--ANY_CHAR))
(signal
- 'error (list
- (format "Unexpected character at %d" (point))
- (point))))
+ 'phps-lexer-error
+ (list
+ (format "Unexpected character at %d" (match-beginning 0))
+ (match-beginning 0))))
(when phps-mode-lexer--match-length
(phps-mode-lexer--re2c-execute)))))
diff --git a/phps-mode-serial.el b/phps-mode-serial.el
index 1dc7d19..dccbc70 100644
--- a/phps-mode-serial.el
+++ b/phps-mode-serial.el
@@ -7,7 +7,6 @@
;;; Code:
-
;; VARIABLES
@@ -43,7 +42,7 @@
(: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)
+ 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)))
@@ -64,8 +63,8 @@
(thread-live-p (gethash key phps-mode-serial--async-threads)))
(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 options."
+(defun phps-mode-serial-commands (key start end &optional start-error
end-error async async-by-process)
+ "Run command with KEY, first START and if successfully then END with the
result of START as argument. Optional arguments START-ERROR, END-ERROR that
are called on errors. ASYNC ASYNC-BY-PROCESS specifies additional options for
synchronicity."
(let ((start-time (current-time)))
(when phps-mode-serial--profiling
(message "PHPs - Starting serial commands for buffer '%s'.." key))
@@ -92,7 +91,8 @@
(progn
(let ((start-return (funcall start)))
(list 'success start-return start-time)))
- ((error t) (list 'error (cdr conditions) start-time))))
+ (error (list 'error conditions start-time))))
+
(lambda (start-return)
(let ((status (car start-return))
(value (car (cdr start-return)))
@@ -117,7 +117,7 @@
(progn
(let ((return (funcall end value)))
(setq end-return (list 'success return
start-time))))
- ((error t) (setq end-return (list 'error (cdr
conditions) start-time))))
+ (error (setq end-return (list 'error
conditions start-time))))
;; Profile execution in debug mode
(when phps-mode-serial--profiling
@@ -139,11 +139,13 @@
(when (string= status "error")
(with-current-buffer key
(setq phps-mode-serial--status 'error))
- (display-warning 'phps-mode (format "%s"
(car value))))))
+ (when end-error
+ (funcall end-error value)))))
(when (string= status "error")
(with-current-buffer key
(setq phps-mode-serial--status 'error))
- (display-warning 'phps-mode (format "%s" (car
value))))))))
+ (when start-error
+ (funcall start-error value)))))))
phps-mode-serial--async-processes))
(signal 'error (list "Async-start function is missing")))
@@ -159,7 +161,7 @@
(condition-case conditions
(let ((return (funcall start)))
(setq start-return (list 'success return start-time)))
- ((error t) (setq start-return (list 'error (cdr conditions)
start-time))))
+ (error (setq start-return (list 'error conditions
start-time))))
;; Profile execution in debug mode
(when phps-mode-serial--profiling
@@ -177,11 +179,12 @@
(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 t) (setq end-return (list 'error (cdr
conditions) start-time))))
+ (error (setq end-return (list 'error conditions
start-time))))
;; Profile execution
(when phps-mode-serial--profiling
@@ -203,12 +206,14 @@
(when (string= status "error")
(with-current-buffer key
(setq phps-mode-serial--status 'error))
- (display-warning 'phps-mode (format "%s" (car
value))))))
+ (when end-error
+ (funcall end-error value)))))
(when (string= status "error")
(with-current-buffer key
(setq phps-mode-serial--status 'error))
- (display-warning 'phps-mode (format "%s" (car
value))))))))
+ (when start-error
+ (funcall start-error value)))))))
key)
phps-mode-serial--async-threads))
@@ -220,7 +225,7 @@
(progn
(let ((return (funcall start)))
(setq start-return (list 'success return start-time))))
- ((error t) (setq start-return (list 'error (cdr conditions)
start-time))))
+ (error (setq start-return (list 'error conditions start-time))))
;; Profile execution in debug mode
(when phps-mode-serial--profiling
@@ -243,7 +248,7 @@
(condition-case conditions
(let ((return (funcall end value)))
(setq end-return (list 'success return start-time)))
- ((error t) (setq end-return (list 'error (cdr conditions)
start-time))))
+ (error (setq end-return (list 'error conditions
start-time))))
;; Profile execution in debug mode
(when phps-mode-serial--profiling
@@ -265,13 +270,14 @@
(when (string= status "error")
(with-current-buffer key
(setq phps-mode-serial--status 'error))
- (display-warning 'phps-mode (format "%s" (car value))))))
+ (when end-error
+ (funcall end-error value)))))
(when (string= status "error")
(with-current-buffer key
(setq phps-mode-serial--status 'error))
- (display-warning 'phps-mode (format "%s" (car value))))))))))
-
+ (when start-error
+ (funcall start-error value)))))))))
(provide 'phps-mode-serial)
;;; phps-mode-serial.el ends here
diff --git a/phps-mode.el b/phps-mode.el
index b3db1aa..b248544 100644
--- a/phps-mode.el
+++ b/phps-mode.el
@@ -5,8 +5,8 @@
;; Author: Christian Johansson <address@hidden>
;; Maintainer: Christian Johansson <address@hidden>
;; Created: 3 Mar 2018
-;; Modified: 12 May 2020
-;; Version: 0.3.48
+;; Modified: 18 May 2020
+;; Version: 0.3.49
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-phps-mode
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/phps-mode d3ae8da: Improved error-handling and error-presentation,
Christian Johansson <=