+++ /dev/null
-;;; yaxception.el --- Provide framework about exception like Java for Elisp
-
-;; Copyright (C) 2013 Hiroaki Otsu
-
-;; Author: Hiroaki Otsu <ootsuhiroakiNOSPAMgmail.com>
-;; Keywords: exception error signal
-;; Package-Version: 20150105.1540
-;; Package-Commit: 4e94cf3e0b9b5631b0e90eb4b7de597ee7185875
-;; URL: https://github.com/aki2o/yaxception
-;; Version: 0.3.3
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This extension provides framework about exception for elisp.
-;; The framework features are the following.
-;; - try/catch/finally coding style like Java
-;; - custom error object
-;; - stacktrace like Java
-
-;;; Dependency:
-;;
-;; Nothing.
-
-;;; Installation:
-;;
-;; Put this to your load-path.
-;; And put the following lines in your elisp file.
-;;
-;; (require 'yaxception)
-
-;;; Configuration:
-;;
-;; Nothing
-
-;;; API:
-;;
-;; [EVAL] (autodoc-document-lisp-buffer :type 'macro :prefix "yaxception:" :docstring t)
-;; `yaxception:$'
-;; Start handling error.
-;; `yaxception:$~'
-;; Wrapper of `yaxception:$' to keep performance.
-;; `yaxception:try'
-;; Execute BODY.
-;; `yaxception:catch'
-;; Execute BODY if the error happened that has ERRSYMBOL in `error-conditions'.
-;; `yaxception:finally'
-;; Execute BODY.
-;; `yaxception:throw'
-;; Raise error directly or create and raise error from given value.
-;;
-;; *** END auto-documentation
-;;
-;; [EVAL] (autodoc-update-all)
-;;
-;; [EVAL] (autodoc-document-lisp-buffer :type 'function :prefix "yaxception:" :docstring t)
-;; `yaxception:deferror'
-;; Define custom error.
-;; `yaxception:get-text'
-;; Get message of error.
-;; `yaxception:get-prop'
-;; Get property of symbol of error.
-;; `yaxception:get-stack-trace-string'
-;; Get string like printStackTrace of Java abaut error.
-;;
-;; *** END auto-documentation
-;;
-;; [EVAL] (autodoc-update-all)
-;;
-;; For detail, see <https://github.com/aki2o/yaxception/blob/master/README.md>
-;;
-;; [Note] Other than listed above, Those specifications may be changed without notice.
-
-;;; Tested On:
-;;
-;; - Emacs ... GNU Emacs 23.3.1 (i386-mingw-nt5.1.2600) of 2011-08-15 on GNUPACK
-
-
-;; Enjoy!!!
-
-
-;;; Code:
-(require 'cl)
-
-
-(defvar yaxception-debug-enable nil)
-(defvar yaxception-debug-buffer-name "*YAX Debug*")
-
-(defmacro yaxception-debug (msg &rest args)
- `(when yaxception-debug-enable
- (condition-case e
- (with-current-buffer (get-buffer-create yaxception-debug-buffer-name)
- (goto-char (point-max))
- (insert (format ,msg ,@args) "\n"))
- (error (message "[yaxception-debug] %s" (error-message-string e))))))
-
-(defun yaxception:toggle-debug-enable ()
- "Toggle debug is enabled/disabled."
- (interactive)
- (message "Yaxception Debug: %s" (setq yaxception-debug-enable (not yaxception-debug-enable))))
-
-(defun yaxception:clear-debug-log ()
- "Clear debug log."
- (interactive)
- (with-current-buffer (get-buffer-create yaxception-debug-buffer-name)
- (erase-buffer)))
-
-
-(defstruct yaxception name msgtmpl parent tmplkeys)
-
-
-(defvar yaxception-custom-err-hash (make-hash-table :test 'equal))
-(defvar yaxception-err (gensym))
-(defvar yaxception-errsymbol (gensym))
-(defvar yaxception-errcatched (gensym))
-(defvar yaxception-active-p nil)
-(defvar yaxception-return-value (gensym))
-(defvar yaxception-signal-hook-function 'yaxception-build-stacktrace)
-
-
-(defun* yaxception:deferror (errsymbol parent errmsgtmpl &rest tmplkeys)
- "Define custom error.
-
-ERRSYMBOL is symbol for custom error. It's OK that not yet defined symbol.
-PARENT is symbol of parent error. If nil, means 'error.
-ERRMSGTMPL is string as a template used by `error-message-string'.
- This is like argument of `format'. '%s' in this value are replaced with TMPLKEYS.
-TMPLKEYS is symbol for replacing '%s' in ERRMSGTMPL with the given value when `yaxception:throw'."
- (condition-case e
- (when (symbolp errsymbol)
- (let* ((errnm (symbol-name errsymbol)))
- (when (not parent)
- (setq parent 'error))
- (put errsymbol 'error-conditions (list errsymbol parent))
- (put errsymbol 'error-message errmsgtmpl)
- (puthash errnm
- (make-yaxception :name errnm :parent parent :msgtmpl errmsgtmpl :tmplkeys tmplkeys)
- yaxception-custom-err-hash)))
- (error (message "[yaxception:deferror] %s" (error-message-string e))
- nil)))
-
-(defmacro* yaxception:$ (try &rest catch_or_finally)
- "Start handling error.
-
-TRY is a `yaxception:try' sexp.
-CATCH_OR_FINALLY is a `yaxception:catch' or `yaxception:finally' sexp.
-
-If error is happened while execute `yaxception:try', go to `yaxception:catch' that match it first.
-If not exist `yaxception:catch' matched it, raise its error.
-If has `yaxception:finally', execute it at last without relation to if error was happened.
-
-Return value is the following.
-- If error was not happened, it's a TRY returned value.
-- If error was happened and a matched `yaxception:catch' exist, it's the `yaxception:catch' returned value.
-
-If you mind the decrease of performance by this function, see `yaxception:$~'."
- (declare (indent 0))
- (lexical-let* (catches finally)
- (condition-case e
- (loop for e in catch_or_finally
- for s = (when (listp e) (car e))
- for symbolnm = (when s (format "%s" s))
- do (cond ((string= symbolnm "yaxception:catch") (cond (catches
- (setq catches (append catches (list e))))
- (t
- (setq catches (list e)))))
- ((string= symbolnm "yaxception:finally") (setq finally e))))
- (error (message "[yaxception:$] %s" (error-message-string e))))
- `(let* ((,yaxception-err)
- (signal-hook-function yaxception-signal-hook-function)
- (yaxception-active-p t))
- (unwind-protect
- (condition-case ,yaxception-err
- ,try
- (error (let* ((,yaxception-errsymbol (car ,yaxception-err))
- (,yaxception-errcatched)
- (,yaxception-return-value))
- ,@catches
- (when (not ,yaxception-errcatched)
- (signal ,yaxception-errsymbol (cdr ,yaxception-err)))
- ,yaxception-return-value)))
- ,finally))))
-
-(defmacro* yaxception:$~ (try &rest catch_or_finally)
- "Wrapper of `yaxception:$' to keep performance.
-
-This function has the following restriction in exchange for performance.
- - can't use `yaxception:get-stack-trace-string'."
- (declare (indent 0))
- `(let ((yaxception-signal-hook-function nil))
- (yaxception:$ ,try ,@catch_or_finally)))
-
-(defmacro* yaxception:try (&rest body)
- "Execute BODY.
-
-BODY is sexp.
-
-This can be used only in `yaxception:$'.
-Return value is a last sexp returned value."
- (declare (indent 0))
- `(progn ,@body))
-
-(defmacro* yaxception:catch (errsymbol errvar &rest body)
- "Execute BODY if the error happened that has ERRSYMBOL in `error-conditions'.
-
-ERRSYMBOL is symbol of a error or parent error that want to catch.
-ERRVAR is variable that using as error object in BODY. It's OK that not yet defined.
-BODY is sexp that executed if the error happened that has ERRSYMBOL in `error-conditions'.
-
-This can be used only in `yaxception:$'.
-Return value is a last sexp returned value in BODY."
- (declare (indent 2))
- `(when (and (not ,yaxception-errcatched)
- (memq ,errsymbol (get ,yaxception-errsymbol 'error-conditions)))
- (setq ,yaxception-return-value
- (let* ((,errvar ,yaxception-err))
- (setq ,yaxception-errcatched t)
- ,@body))))
-
-(defmacro* yaxception:finally (&rest body)
- "Execute BODY.
-
-BODY is sexp.
-
-This can be used only in `yaxception:$'.
-Return value is a last sexp returned value. But it's not used in `yaxception:$'."
- (declare (indent 0))
- `(progn ,@body))
-
-(defmacro* yaxception:throw (err_or_errsymbol &rest args &allow-other-keys)
- "Raise error directly or create and raise error from given value.
-
-ERR_OR_ERRSYMBOL is variable or symbol. Accept the following value.
- - If raise error directly, this is a variable of it.
- - If create error and raise it, this is a symbol of it.
-ARGS is anything.
- This is used if create error.
- This format is keyward arguments.
- If given this, get this by `yaxception:get-prop' in `yaxception:catch'."
- (declare (indent 0))
- `(progn
- (yaxception-debug "start throw\n err: %s\n args: %s\n car: %s\n cdr: %s"
- ',err_or_errsymbol
- ',args
- (ignore-errors (car ,err_or_errsymbol))
- (ignore-errors (cdr ,err_or_errsymbol)))
- (cond ((ignore-errors (boundp ',err_or_errsymbol))
- ;; re-throw err
- (signal (car ,err_or_errsymbol) (cdr ,err_or_errsymbol)))
- ((symbolp ,err_or_errsymbol)
- ;; throw create error
- (when (not (yaxception-err-symbol-p ,err_or_errsymbol))
- (yaxception:deferror ,err_or_errsymbol nil (get 'error 'error-message)))
- (yaxception-throw-custom-err ,err_or_errsymbol (yaxception-get-err-info-hash ,@args)))
- (t
- (message "[yaxception:throw] Illegal argument : %s" ,err_or_errsymbol)
- (error (format "%s" ,err_or_errsymbol))))))
-
-(defun yaxception:get-text (err)
- "Get message of error.
-
-ERR is variable of error.
-
-Return value is a `error-message-string' return value."
- (condition-case e
- (error-message-string err)
- (error (message "[yaxception:get-text] %s" (error-message-string e))
- "")))
-
-(defun yaxception:get-prop (err propsymbol)
- "Get property of symbol of error.
-
-ERR is variable of error.
-PROPSYMBOL is symbol of property. Give this like the following.
- If give `yaxception:throw' :hoge, this is 'hoge."
- (condition-case e
- (let* ((errsymbol (when (listp err)
- (intern-soft (car err))))
- (keysymbol (when (symbolp propsymbol)
- (intern-soft (concat ":" (symbol-name propsymbol))))))
- (when (and (yaxception-err-symbol-p errsymbol)
- (symbolp keysymbol))
- (get errsymbol keysymbol)))
- (error (message "[yaxception:get-prop] %s" (error-message-string e))
- nil)))
-
-(defun yaxception:get-stack-trace-string (err)
- "Get string like printStackTrace of Java abaut error.
-
-ERR is variable of error.
-
-This can be used only in `yaxception:catch'.
-List called function and its arguments until error was happened."
- (condition-case e
- (let* ((errsymbol (when (listp err)
- (intern-soft (car err))))
- (callstack (when (yaxception-err-symbol-p errsymbol)
- (get errsymbol 'yaxception-call-stack)))
- (calllist (when callstack
- (plist-get callstack :stack)))
- (getliner (lambda (c)
- (concat " at " (plist-get c :name) "(" (plist-get c :argstr) ")")))
- (ctxtype (plist-get callstack :type))
- (endline (cond
- ((member ctxtype '("try" "catch" "finally"))
- (concat " in yaxception:" ctxtype))
- (t
- (concat " in unknown-statment: " ctxtype)))))
- (if (not callstack)
- ""
- (concat "Exception is '" (symbol-name errsymbol) "'. " (error-message-string err) "\n"
- (mapconcat getliner calllist "\n") "\n"
- endline)))
- (error (message "[yaxception:get-stack-trace-string] %s" (error-message-string e))
- "")))
-
-
-(defun* yaxception-throw-custom-err (errsymbol errinfoh)
- (yaxception-debug "start throw custom err : %s" errsymbol)
- (let* ((parents (yaxception-get-err-parents errsymbol))
- (errmsg (yaxception-get-err-msg errsymbol errinfoh)))
- (condition-case e
- (progn
- (put errsymbol 'error-conditions parents)
- (put errsymbol 'error-message errmsg)
- (loop for k being the hash-keys in errinfoh using (hash-values v)
- if (and (symbolp k)
- (string-match "^:" (symbol-name k)))
- do (put errsymbol k v)))
- (error (message "[yaxception-throw-custom-err] %s" (error-message-string e))))
- (signal errsymbol (gethash " " errinfoh))))
-
-(defun* yaxception-get-err-info-hash (&rest args &allow-other-keys)
- (condition-case e
- (loop with s
- with h = (make-hash-table :test 'equal)
- for e in args
- do (cond ((and (symbolp e)
- (string-match "^:" (symbol-name e)))
- (puthash (setq s e) t h))
- (s
- (puthash s e h)
- (setq s nil))
- (t
- (puthash " " e h)))
- finally return h)
- (error (message "[yaxception-get-err-info-hash] %s" (error-message-string e))
- (make-hash-table :test 'equal))))
-
-(defun yaxception-get-err-parents (errsymbol)
- (condition-case e
- (let* ((e (or (gethash (symbol-name errsymbol) yaxception-custom-err-hash)
- errsymbol))
- (ret))
- (while (yaxception-p e)
- (setq ret (append ret (list (intern-soft (yaxception-name e)))))
- (setq e (or (gethash (symbol-name (yaxception-parent e)) yaxception-custom-err-hash)
- (yaxception-parent e))))
- (append ret (get e 'error-conditions)))
- (error (message "[yaxception-get-err-parents] %s" (error-message-string e))
- '(error))))
-
-(defun yaxception-get-err-msg (errsymbol errinfoh)
- (condition-case e
- (let* ((e (gethash (symbol-name errsymbol) yaxception-custom-err-hash))
- (tmplkeys (when (yaxception-p e)
- (yaxception-tmplkeys e)))
- (msgtmpl (cond ((yaxception-p e) (yaxception-msgtmpl e))
- (t (get errsymbol 'error-message))))
- (msgtmpl (if (functionp msgtmpl) (funcall msgtmpl) msgtmpl))
- (msgargs (loop for k in tmplkeys
- for s = (intern (concat ":" (symbol-name k)))
- collect (gethash s errinfoh))))
- (apply 'format msgtmpl msgargs))
- (error (message "[yaxception-get-err-msg] %s" (error-message-string e))
- "")))
-
-(defun yaxception-get-err-symbols ()
- (loop for s in (apropos-internal "^[a-z\\-:/]+$")
- when (yaxception-err-symbol-p s)
- collect s))
-
-(defun yaxception-err-symbol-p (s)
- (ignore-errors (and (memq 'error-conditions (symbol-plist s))
- (memq 'error-message (symbol-plist s))
- t)))
-
-(defvar yaxception-regexp-function-in-backtrace (rx-to-string `(and bos (+ space)
- (group (+ (not (any space "("))))
- "(" (group (* not-newline)) ")" (* space) eos)))
-(defvar yaxception-regexp-macro-in-backtrace (rx-to-string `(and bos (+ space) "("
- (group (+ (not (any space)))) (+ space)
- (group (* not-newline)) ")" (* space) eos)))
-(defvar yaxception-regexp-yaxception-in-backtrace (rx-to-string `(and bos (+ space) "("
- (group (or "yaxception:try"
- "yaxception:catch"
- "yaxception:finally"))
- (+ space))))
-(defun yaxception-build-stacktrace (error-symbol data)
- (ignore-errors
- (when yaxception-active-p
- (with-temp-buffer
- (let ((standard-output (current-buffer))
- (print-escape-newlines t)
- (print-level 50)
- (print-length 50))
- (backtrace))
- (goto-char (point-min))
- (if (not (re-search-forward "^\\s-+yaxception-build-stacktrace(" nil t))
- (message "[yaxception] failed get backtrace : not found called signal-hook-function")
- (forward-line 1)
- (beginning-of-line)
- (let* ((ctxtype)
- (calllist (loop for line = (replace-regexp-in-string "[\0\r\n]" "" (thing-at-point 'line))
- until (or (string-match yaxception-regexp-yaxception-in-backtrace line)
- (eobp))
- for c = (cond ((string-match yaxception-regexp-function-in-backtrace line)
- (let* ((funcnm (match-string-no-properties 1 line))
- (argtext (match-string-no-properties 2 line))
- (callinfo `(:name ,funcnm :argstr ,argtext)))
- (when (not (string= funcnm "yaxception-throw-custom-err"))
- callinfo)))
- ((string-match yaxception-regexp-macro-in-backtrace line)
- (let* ((macnm (match-string-no-properties 1 line))
- (argtext (match-string-no-properties 2 line))
- (macsym (intern-soft macnm))
- (callinfo `(:name ,macnm :argstr ,argtext)))
- (when (and macsym
- (fboundp macsym))
- (when (string= macnm "yaxception:throw")
- callinfo)))))
- if c collect c
- do (forward-line 1)
- finally (let* ((lastf (or (match-string-no-properties 1 line)
- "")))
- (setq ctxtype (cond ((string= lastf "yaxception:try") "try")
- ((string= lastf "yaxception:catch") "catch")
- ((string= lastf "yaxception:finally") "finally")
- (t lastf)))))))
- (put error-symbol 'yaxception-call-stack `(:type ,ctxtype :stack ,calllist)))
- nil)))))
-
-
-(provide 'yaxception)
-;;; yaxception.el ends here
--- /dev/null
+;;; yaxception.el --- Provide framework about exception like Java for Elisp
+
+;; Copyright (C) 2013 Hiroaki Otsu
+
+;; Author: Hiroaki Otsu <ootsuhiroakiNOSPAMgmail.com>
+;; Keywords: exception error signal
+;; URL: https://github.com/aki2o/yaxception
+;; Package-Version: 20240107.504
+;; Package-Revision: 5941de88b197
+;; Package-Requires: ((emacs "28") (dash "2.19.1"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This extension provides framework about exception for elisp.
+;; - try/catch/finally coding style like Java
+;; - custom error object
+;; - stacktrace like Java
+;;
+;; For detail, see <https://github.com/aki2o/yaxception/blob/master/README.md>
+;;
+;; Enjoy!!!
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'backtrace)
+(require 'dash)
+
+
+(defvar yaxception-debug-enable nil)
+(defvar yaxception-debug-buffer-name "*YAX Debug*")
+
+(cl-defmacro yaxception-debug (msg &rest args)
+ `(when yaxception-debug-enable
+ (condition-case e
+ (with-current-buffer (get-buffer-create yaxception-debug-buffer-name)
+ (goto-char (point-max))
+ (insert (format ,msg ,@args) "\n"))
+ (error (message "[yaxception-debug] %s" (error-message-string e))))))
+
+(defun yaxception:toggle-debug-enable ()
+ "Toggle debug is enabled/disabled."
+ (interactive)
+ (message "Yaxception Debug: %s" (setq yaxception-debug-enable (not yaxception-debug-enable))))
+
+(defun yaxception:clear-debug-log ()
+ "Clear debug log."
+ (interactive)
+ (with-current-buffer (get-buffer-create yaxception-debug-buffer-name)
+ (erase-buffer)))
+
+
+(defvar yaxception-err (gensym))
+(defvar yaxception-errsymbol (gensym))
+(defvar yaxception-errcatched (gensym))
+(defvar yaxception-return-value (gensym))
+(defvar yaxception-stack-trace-stores nil)
+
+(defun yaxception-signal-hook-function (error-symbol data)
+ (when yaxception-stack-trace-stores
+ (let ((signal-hook-function nil))
+ (set (nth 0 yaxception-stack-trace-stores) (backtrace-to-string))
+ (yaxception-debug "Called signal-hook-function with %s : %s\n%s" error-symbol (nth 0 yaxception-stack-trace-stores) (symbol-value (nth 0 yaxception-stack-trace-stores))))))
+
+(cl-defmacro yaxception:$ (try &rest catch_or_finally)
+ "Handle error like Java.
+TRY is a `yaxception:try' sexp.
+CATCH_OR_FINALLY is a `yaxception:catch' or `yaxception:finally' sexp."
+ (declare (indent 0))
+ (let (catches finally)
+ (condition-case err
+ (cl-loop for e in catch_or_finally
+ for s = (when (listp e) (car e))
+ for symbolnm = (when s (format "%s" s))
+ do (cond ((string= symbolnm "yaxception:catch") (setq catches (append catches (list e))))
+ ((string= symbolnm "yaxception:finally") (setq finally e))))
+ (error (message "[yaxception:$] %s" (error-message-string err))))
+ `(let* ((,yaxception-err)
+ (,yaxception-errcatched nil)
+ (signal-hook-function 'yaxception-signal-hook-function)
+ (yaxception-stack-trace-stores (append (list (gensym)) yaxception-stack-trace-stores)))
+ (unwind-protect
+ (condition-case ,yaxception-err
+ ,try
+ ,@(mapcar 'macroexpand catches))
+ (when (not ,yaxception-errcatched)
+ (let ((sym (pop yaxception-stack-trace-stores)))
+ (when (and (boundp sym) yaxception-stack-trace-stores)
+ (set (nth 0 yaxception-stack-trace-stores) (symbol-value sym)))))
+ ,finally))))
+
+(cl-defmacro yaxception:$~ (try &rest catch_or_finally)
+ "This is obsolete already. Use `yaxception:$'."
+ (declare (indent 0))
+ `(yaxception:$ ,try ,@catch_or_finally))
+(make-obsolete 'yaxception:$~ 'yaxception:$ "20231231")
+
+(cl-defmacro yaxception:try (&rest body)
+ "Expand to a bodyform of `condition-case'.
+This can be used only in `yaxception:$'."
+ (declare (indent 0))
+ `(progn ,@body))
+
+(cl-defmacro yaxception:catch (errsymbol errvar &rest body)
+ "Expand to a handler of `condition-case'.
+This can be used only in `yaxception:$'."
+ (declare (indent 2))
+ `(,errsymbol (let ((,errvar (list :symbol (car ,yaxception-err)
+ :data (cdr ,yaxception-err)
+ :backtrace (symbol-value (pop yaxception-stack-trace-stores)))))
+ (setq ,yaxception-errcatched t)
+ ,@body)))
+
+(cl-defmacro yaxception:finally (&rest body)
+ "Expand to a unwindform of `unwind-protect'
+This can be used only in `yaxception:$'."
+ (declare (indent 0))
+ `(progn ,@body))
+
+(cl-defmacro yaxception:throw (err_or_errsymbol &rest args)
+ "Call `signal'.
+ERR_OR_ERRSYMBOL is the value from `yaxception:catch' or symbol.
+ARGS will be pass `signal' and can be accessed by `yaxception:get-prop'."
+ (declare (indent 0))
+ `(progn
+ (cond ((and ,err_or_errsymbol (symbolp ,err_or_errsymbol))
+ (signal ,err_or_errsymbol ',args))
+ ((and ,err_or_errsymbol (listp ,err_or_errsymbol))
+ ;; re-throw err
+ (signal (plist-get ,err_or_errsymbol :symbol) (or ,args (plist-get ,err_or_errsymbol :data))))
+ (t
+ (error "[yaxception:throw] Invalid argument : %s" ,err_or_errsymbol)))))
+
+(defun yaxception:get-raw (err)
+ "Expose raw error object from ERR that's given to `yaxception:catch'."
+ (cons (or (plist-get err :symbol) (error "[yaxception:get-raw] Invalid argument : %s" err))
+ (plist-get err :data)))
+
+(defun yaxception:get-text (err)
+ "Call `error-message-string' with ERR that's given to `yaxception:catch'."
+ (error-message-string (yaxception:get-raw err)))
+
+(defun yaxception:get-data (err)
+ "Expose the data of raw error object from ERR that's given to `yaxception:catch'."
+ (plist-get err :data))
+
+(defun yaxception:get-prop (err name)
+ "Call `plist-get' with the value of `yaxception:get-data'."
+ (let* ((name (intern-soft (concat ":" (replace-regexp-in-string "^:" "" (symbol-name name))))))
+ (plist-get (yaxception:get-data err) name)))
+
+(cl-defun yaxception:get-stack-trace-string (err &key (filter nil) (limit nil))
+ "Return a string like printStackTrace of Java.
+FILTER is a function as predicate of `-filter' the stack traces.
+ - It's given function name.
+LIMIT is a number to `-take' the stack traces."
+ (let* ((traces (yaxception-expose-stack-traces err))
+ (traces (if filter (-filter (lambda (x) (funcall filter (plist-get x :name))) traces) traces))
+ (traces (if limit (-take limit traces) traces))
+ (formatter (lambda (c)
+ (concat " at " (plist-get c :name) "(" (plist-get c :argstr) ")"))))
+ (concat (yaxception:get-text err) "\n"
+ (mapconcat formatter traces "\n"))))
+
+(defvar yaxception-regexp-function-in-backtrace (rx-to-string `(and bos (+ space)
+ (group (+ (not (any space "("))))
+ "(" (group (* not-newline)) ")" (* space) eos)))
+(defun yaxception-expose-stack-traces (err)
+ (with-temp-buffer
+ (insert (plist-get err :backtrace))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^\\s-+yaxception-signal-hook-function(" nil t))
+ (error "[yaxception] Failed to expose stack traces : Not found yaxception-signal-hook-function called")
+ (forward-line 1)
+ (beginning-of-line)
+ (cl-loop for line = (replace-regexp-in-string "[\0\r\n]" "" (thing-at-point 'line))
+ until (eobp)
+ if (string-match yaxception-regexp-function-in-backtrace line)
+ collect (let* ((funcnm (match-string-no-properties 1 line))
+ (argtext (match-string-no-properties 2 line)))
+ `(:name ,funcnm :argstr ,argtext))
+ do (forward-line 1)))))
+
+
+(provide 'yaxception)
+;;; yaxception.el ends here
projects / emacsconfig.git / commitdiff