X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-debug.el;h=5473d1fa2aadc95d705bea4a3d57890e8a304fad;hp=24b7f57f1836d608d4f15b91729f80abe92ea771;hb=deee2c444fb26a3e2ea4a4ccb913ea695f1d7087;hpb=942d2ac48f8501eb0c4e8bb6c92827eb5653a463 diff --git a/lisp/riece-debug.el b/lisp/riece-debug.el index 24b7f57..5473d1f 100644 --- a/lisp/riece-debug.el +++ b/lisp/riece-debug.el @@ -24,28 +24,27 @@ ;;; Code: -(defvar riece-debug-standard-output - (make-string 4096 ?\x0)) +(require 'riece-globals) -(defvar riece-debug-standard-output-index 0) +(defvar riece-debug-standard-output-buffer nil) -(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)))) +(defun riece-debug-reset-standard-output () + (unless riece-debug-standard-output-buffer + (setq riece-debug-standard-output-buffer + (generate-new-buffer " *riece-debug-standard-output*") + riece-buffer-list + (cons riece-debug-standard-output-buffer + riece-buffer-list))) + (save-excursion + (set-buffer riece-debug-standard-output-buffer) + (buffer-disable-undo) + (erase-buffer))) (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)) + (riece-debug-reset-standard-output) + (let ((standard-output riece-debug-standard-output-buffer)) (backtrace)))) (put 'riece-debug-with-backtrace 'lisp-indent-function 0) @@ -58,11 +57,11 @@ ,@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))) + (save-excursion + (set-buffer riece-debug-standard-output-buffer) + (if (re-search-forward "^ signal(" nil t) + (delete-region (point-min) (match-beginning 0))) + (message "Error in `%s': %S\n%s" ,location error (buffer-string)))) nil))) (put 'riece-ignore-errors 'lisp-indent-function 1)