From: Andreas Gerler Date: Sun, 22 Dec 2024 12:24:55 +0000 (+0100) Subject: update yaxception X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=f30b5c8efebb1d26b67ec3344fccea360c775e8d;p=emacsconfig.git update yaxception Signed-off-by: Andreas Gerler --- diff --git a/elpa/yaxception-20150105.1540/yaxception-autoloads.el b/elpa/yaxception-20150105.1540/yaxception-autoloads.el deleted file mode 100644 index 869f26ae..00000000 --- a/elpa/yaxception-20150105.1540/yaxception-autoloads.el +++ /dev/null @@ -1,22 +0,0 @@ -;;; yaxception-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "yaxception" "yaxception.el" (0 0 0 0)) -;;; Generated autoloads from yaxception.el - -(register-definition-prefixes "yaxception" '("yaxception")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; yaxception-autoloads.el ends here diff --git a/elpa/yaxception-20150105.1540/yaxception-pkg.el b/elpa/yaxception-20150105.1540/yaxception-pkg.el deleted file mode 100644 index 64c900de..00000000 --- a/elpa/yaxception-20150105.1540/yaxception-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from yaxception.el -*- no-byte-compile: t -*- -(define-package "yaxception" "20150105.1540" "Provide framework about exception like Java for Elisp" 'nil :commit "4e94cf3e0b9b5631b0e90eb4b7de597ee7185875" :authors '(("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) :maintainers '(("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) :maintainer '("Hiroaki Otsu" . "ootsuhiroaki@gmail.com") :keywords '("exception" "error" "signal") :url "https://github.com/aki2o/yaxception") diff --git a/elpa/yaxception-20150105.1540/yaxception.el b/elpa/yaxception-20150105.1540/yaxception.el deleted file mode 100644 index ca2cf101..00000000 --- a/elpa/yaxception-20150105.1540/yaxception.el +++ /dev/null @@ -1,457 +0,0 @@ -;;; yaxception.el --- Provide framework about exception like Java for Elisp - -;; Copyright (C) 2013 Hiroaki Otsu - -;; Author: Hiroaki Otsu -;; 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 . - -;;; 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 -;; -;; [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 diff --git a/elpa/yaxception-20240107.504/yaxception-autoloads.el b/elpa/yaxception-20240107.504/yaxception-autoloads.el new file mode 100644 index 00000000..56f8085d --- /dev/null +++ b/elpa/yaxception-20240107.504/yaxception-autoloads.el @@ -0,0 +1,28 @@ +;;; yaxception-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from yaxception.el + +(register-definition-prefixes "yaxception" '("yaxception")) + +;;; End of scraped data + +(provide 'yaxception-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; yaxception-autoloads.el ends here diff --git a/elpa/yaxception-20240107.504/yaxception-pkg.el b/elpa/yaxception-20240107.504/yaxception-pkg.el new file mode 100644 index 00000000..4c20c1d6 --- /dev/null +++ b/elpa/yaxception-20240107.504/yaxception-pkg.el @@ -0,0 +1,11 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "yaxception" "20240107.504" + "Provide framework about exception like Java for Elisp." + '((emacs "28") + (dash "2.19.1")) + :url "https://github.com/aki2o/yaxception" + :commit "5941de88b19752c14e0dce0d2bf562b1288055a0" + :revdesc "5941de88b197" + :keywords '("exception" "error" "signal") + :authors '(("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) + :maintainers '(("Hiroaki Otsu" . "ootsuhiroaki@gmail.com"))) diff --git a/elpa/yaxception-20240107.504/yaxception.el b/elpa/yaxception-20240107.504/yaxception.el new file mode 100644 index 00000000..a11be9ac --- /dev/null +++ b/elpa/yaxception-20240107.504/yaxception.el @@ -0,0 +1,199 @@ +;;; yaxception.el --- Provide framework about exception like Java for Elisp + +;; Copyright (C) 2013 Hiroaki Otsu + +;; Author: Hiroaki Otsu +;; 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 . + +;;; 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 +;; +;; 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