From 444a05258ee1355e73454669ba9dacce40a3d992 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Thu, 11 May 2023 18:26:33 +0200 Subject: [PATCH] add yaxception Signed-off-by: Andreas Gerler --- .../yaxception-autoloads.el | 22 + .../yaxception-pkg.el | 2 + elpa/yaxception-20150105.1540/yaxception.el | 457 ++++++++++++++++++ 3 files changed, 481 insertions(+) create mode 100644 elpa/yaxception-20150105.1540/yaxception-autoloads.el create mode 100644 elpa/yaxception-20150105.1540/yaxception-pkg.el create mode 100644 elpa/yaxception-20150105.1540/yaxception.el diff --git a/elpa/yaxception-20150105.1540/yaxception-autoloads.el b/elpa/yaxception-20150105.1540/yaxception-autoloads.el new file mode 100644 index 00000000..869f26ae --- /dev/null +++ b/elpa/yaxception-20150105.1540/yaxception-autoloads.el @@ -0,0 +1,22 @@ +;;; 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 new file mode 100644 index 00000000..64c900de --- /dev/null +++ b/elpa/yaxception-20150105.1540/yaxception-pkg.el @@ -0,0 +1,2 @@ +;;; 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 new file mode 100644 index 00000000..ca2cf101 --- /dev/null +++ b/elpa/yaxception-20150105.1540/yaxception.el @@ -0,0 +1,457 @@ +;;; 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 -- 2.47.3