From: ueno Date: Wed, 2 Feb 2005 04:06:38 +0000 (+0000) Subject: * Makefile.am (EXTRA_DIST): Add riece-debug.el. X-Git-Tag: riece-1_0_7~72 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=83b074062d25d50f37435e5c723535bcd8dbbef7;p=elisp%2Friece.git * Makefile.am (EXTRA_DIST): Add riece-debug.el. * COMPILE (riece-modules): Add riece-debug. * riece-signal.el (riece-emit-signal): Use riece-ignore-errors. * riece-filter.el (riece-handle-numeric-reply): Use riece-ignore-errors. (riece-handle-message): Ditto. * riece-ctcp.el (riece-handle-ctcp-request): Use riece-ignore-errors. (riece-handle-ctcp-response): Ditto. * riece-debug.el: New file. --- diff --git a/lisp/COMPILE b/lisp/COMPILE index 99de9fd..82d3438 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -7,6 +7,7 @@ 'riece-emacs) '(riece-globals riece-options + riece-debug riece-version riece-coding riece-complete diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1721594..12e5b48 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,21 @@ +2005-02-02 Daiki Ueno + + * Makefile.am (EXTRA_DIST): Add riece-debug.el. + + * COMPILE (riece-modules): Add riece-debug. + + * riece-signal.el (riece-emit-signal): Use riece-ignore-errors. + + * riece-filter.el (riece-handle-numeric-reply): Use + riece-ignore-errors. + (riece-handle-message): Ditto. + + * riece-ctcp.el (riece-handle-ctcp-request): Use + riece-ignore-errors. + (riece-handle-ctcp-response): Ditto. + + * riece-debug.el: New file. + 2005-02-02 OHASHI Akira * riece-eval.el (riece-eval-regexp): Fix regexp. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 1c527ea..3116515 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -3,12 +3,12 @@ SUBDIRS = test EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-000.el riece-200.el riece-300.el riece-400.el riece-500.el \ riece-addon.el riece-channel.el riece-coding.el riece-commands.el \ - riece-compat.el riece-complete.el riece-display.el riece-emacs.el \ - riece-filter.el riece-globals.el riece-handle.el riece-highlight.el \ - riece-identity.el riece-message.el riece-misc.el riece-mode.el \ - riece-naming.el riece-options.el riece-server.el riece-signal.el \ - riece-user.el riece-version.el riece-xemacs.el riece-irc.el riece.el \ - riece-ctcp.el riece-url.el riece-unread.el \ + riece-compat.el riece-complete.el riece-debug.el riece-display.el \ + riece-emacs.el riece-filter.el riece-globals.el riece-handle.el \ + riece-highlight.el riece-identity.el riece-message.el riece-misc.el \ + riece-mode.el riece-naming.el riece-options.el riece-server.el \ + riece-signal.el riece-user.el riece-version.el riece-xemacs.el \ + riece-irc.el riece.el riece-ctcp.el riece-url.el riece-unread.el \ riece-ndcc.el riece-rdcc.el riece-log.el riece-mini.el \ riece-doctor.el riece-alias.el riece-layout.el riece-skk-kakutei.el \ riece-guess.el riece-history.el riece-button.el riece-keyword.el \ diff --git a/lisp/riece-ctcp.el b/lisp/riece-ctcp.el index 5fc14e0..8c45869 100644 --- a/lisp/riece-ctcp.el +++ b/lisp/riece-ctcp.el @@ -28,6 +28,7 @@ (require 'riece-misc) (require 'riece-highlight) (require 'riece-display) +(require 'riece-debug) (defface riece-ctcp-action-face '((((class color) @@ -72,27 +73,15 @@ (after-hook (intern (concat "riece-ctcp-after-" request "-request-hook")))) - (unless (condition-case error - (run-hook-with-args-until-success - hook prefix (car targets) message) - (error - (if riece-debug - (message "Error in `%S': %S" hook error)) - nil)) + (unless (riece-ignore-errors (symbol-name hook) + (run-hook-with-args-until-success + hook prefix (car targets) message)) (if function - (condition-case error - (funcall function prefix (car targets) message) - (error - (if riece-debug - (message "Error in `%S': %S" - function error)))))) - (condition-case error + (riece-ignore-errors (symbol-name function) + (funcall function prefix (car targets) message))) + (riece-ignore-errors (symbol-name after-hook) (run-hook-with-args-until-success - after-hook prefix (car targets) message) - (error - (if riece-debug - (message "Error in `%S': %S" - after-hook error))))) + after-hook prefix (car targets) message)))) t))))) (defun riece-handle-ctcp-version-request (prefix target string) @@ -207,27 +196,15 @@ (after-hook (intern (concat "riece-ctcp-after-" response "-response-hook")))) - (unless (condition-case error - (run-hook-with-args-until-success - hook prefix (car targets) message) - (error - (if riece-debug - (message "Error in `%S': %S" hook error)) - nil)) + (unless (riece-ignore-errors (symbol-name hook) + (run-hook-with-args-until-success + hook prefix (car targets) message)) (if function - (condition-case error - (funcall function prefix (car targets) message) - (error - (if riece-debug - (message "Error in `%S': %S" - function error)))))) - (condition-case error + (riece-ignore-errors (symbol-name function) + (funcall function prefix (car targets) message))) + (riece-ignore-errors (symbol-name after-hook) (run-hook-with-args-until-success - after-hook prefix (car targets) message) - (error - (if riece-debug - (message "Error in `%S': %S" - after-hook error))))) + after-hook prefix (car targets) message)))) t))))) (defun riece-handle-ctcp-version-response (prefix target string) diff --git a/lisp/riece-debug.el b/lisp/riece-debug.el new file mode 100644 index 0000000..24b7f57 --- /dev/null +++ b/lisp/riece-debug.el @@ -0,0 +1,73 @@ +;;; riece-debug.el --- debug support +;; Copyright (C) 1998-2005 Daiki Ueno + +;; Author: Daiki Ueno +;; Created: 1998-09-28 +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; 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 2, or (at your option) +;; any later version. + +;; This program 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(defvar riece-debug-standard-output + (make-string 4096 ?\x0)) + +(defvar riece-debug-standard-output-index 0) + +(defun riece-debug-standard-output (character) + (let ((length (length riece-debug-standard-output))) + (if (= riece-debug-standard-output-index length) + (setq riece-debug-standard-output + (concat riece-debug-standard-output + (make-string length ?\x0)))) + (aset riece-debug-standard-output + riece-debug-standard-output-index + character) + (setq riece-debug-standard-output-index + (1+ riece-debug-standard-output-index)))) + +(defmacro riece-debug-with-backtrace (&rest body) + `(unwind-protect + (progn ,@body) + (setq riece-debug-standard-output-index 0) + (let ((standard-output #'riece-debug-standard-output)) + (backtrace)))) + +(put 'riece-debug-with-backtrace 'lisp-indent-function 0) +(put 'riece-debug-with-backtrace 'edebug-form-spec '(form body)) + +(defmacro riece-ignore-errors (location &rest body) + `(condition-case error + (if riece-debug + (riece-debug-with-backtrace ,@body) + ,@body) + (error + (if riece-debug + (let ((backtrace (substring riece-debug-standard-output + 0 riece-debug-standard-output-index))) + (if (string-match "^ signal(" backtrace) + (setq backtrace (substring backtrace 0 (match-beginning 0)))) + (message "Error in `%s': %S\n%s" ,location error backtrace))) + nil))) + +(put 'riece-ignore-errors 'lisp-indent-function 1) +(put 'riece-ignore-errors 'edebug-form-spec '(form body)) + +(provide 'riece-debug) + +;;; riece-debug.el ends here diff --git a/lisp/riece-filter.el b/lisp/riece-filter.el index 91ac12c..685205a 100644 --- a/lisp/riece-filter.el +++ b/lisp/riece-filter.el @@ -28,6 +28,7 @@ (require 'riece-misc) (require 'riece-server) ;riece-close-server (require 'riece-identity) +(require 'riece-debug) (defun riece-handle-numeric-reply (prefix number name string) (let ((base-number (* (/ number 100) 100)) @@ -40,12 +41,9 @@ (format "riece-handle-default-%03d-message" base-number)))) (if (and function (symbol-function function)) - (condition-case error - (funcall function prefix number name - (riece-decode-coding-string string)) - (error - (if riece-debug - (message "Error in `%S': %S" function error))))))) + (riece-ignore-errors (symbol-name function) + (funcall function prefix number name + (riece-decode-coding-string string)))))) (defun riece-handle-message (prefix message string) (if (and prefix @@ -58,23 +56,13 @@ (let ((function (intern-soft (concat "riece-handle-" message "-message"))) (hook (intern (concat "riece-" message "-hook"))) (after-hook (intern (concat "riece-after-" message "-hook")))) - (unless (condition-case error - (run-hook-with-args-until-success hook prefix string) - (error - (if riece-debug - (message "Error in `%S': %S" hook error)) - nil)) + (unless (riece-ignore-errors (symbol-name hook) + (run-hook-with-args-until-success hook prefix string)) (if function - (condition-case error - (funcall function prefix string) - (error - (if riece-debug - (message "Error in `%S': %S" function error))))) - (condition-case error - (run-hook-with-args-until-success after-hook prefix string) - (error - (if riece-debug - (message "Error in `%S': %S" after-hook error))))))) + (riece-ignore-errors (symbol-name function) + (funcall function prefix string))) + (riece-ignore-errors (symbol-name after-hook) + (run-hook-with-args-until-success after-hook prefix string))))) (defun riece-filter (process input) (save-excursion diff --git a/lisp/riece-signal.el b/lisp/riece-signal.el index 2191825..522e5a4 100644 --- a/lisp/riece-signal.el +++ b/lisp/riece-signal.el @@ -30,6 +30,7 @@ ;;; Code: (require 'riece-options) +(require 'riece-debug) (defvar riece-signal-slot-obarray (make-vector 31 0)) @@ -103,22 +104,14 @@ This function is for internal use only." (setq signal (riece-make-signal signal-name args) slots (symbol-value symbol)) (while slots - (condition-case error - (if (or (null (riece-slot-filter (car slots))) - (condition-case error - (funcall (riece-slot-filter (car slots)) signal) - (error - (if riece-debug - (message - "Error in signal filter for \"%S\": %S" - signal-name error))) - nil)) - (funcall (riece-slot-function (car slots)) - signal (riece-slot-handback (car slots)))) - (error - (if riece-debug - (message "Error in slot function for \"%S\": %S" - signal-name error)))) + (riece-ignore-errors (format "slot function for \"%S\"" + signal-name) + (if (or (null (riece-slot-filter (car slots))) + (riece-ignore-errors (format "signal filter for \"%S\"" + symbol-name) + (funcall (riece-slot-filter (car slots)) signal))) + (funcall (riece-slot-function (car slots)) + signal (riece-slot-handback (car slots))))) (setq slots (cdr slots)))))) (provide 'riece-signal)