diff options
| -rw-r--r-- | elisp/geiser-debug.el | 46 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 3 |
2 files changed, 16 insertions, 33 deletions
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 7ebd0b5..f0dc6ec 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -32,15 +32,23 @@ ;;; Debug buffer mode: -(defconst geiser-debug--error-alist - '(("^\\(In file +\\| +\\)\\([^ \n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 2 3 4) - ("^Error.+$" nil nil nil 0))) +(defvar geiser-debug-mode-map + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + map)) -(define-derived-mode geiser-debug-mode compilation-mode "Geiser Dbg" +(defun geiser-debug-mode () "A major mode for displaying Scheme compilation and evaluation results. \\{geiser-debug-mode-map}" - (set (make-local-variable 'compilation-error-regexp-alist) - geiser-debug--error-alist)) + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map geiser-debug-mode-map) + (set-syntax-table scheme-mode-syntax-table) + (setq mode-name "Geiser DBG") + (setq major-mode 'geiser-debug-mode) + (setq buffer-read-only t)) ;;; Buffer for displaying evaluation results: @@ -52,40 +60,16 @@ (defun geiser-debug--display-retort (what ret) (let* ((err (geiser-eval--retort-error ret)) - (output (geiser-eval--retort-output ret)) - (stack (geiser-eval--retort-stack ret))) + (output (geiser-eval--retort-output ret))) (geiser-debug--with-buffer (erase-buffer) (insert what) (newline 2) (when err (insert (geiser-eval--error-str err) "\n\n")) (when output (insert output "\n\n")) - (when stack (geiser-debug--display-stack stack)) (goto-char (point-min))) (when err (geiser-debug--pop-to-buffer)))) -(defsubst geiser-debug--frame-proc (frame) (cdr (assoc 'procedure frame))) -(defsubst geiser-debug--frame-desc (frame) (cdr (assoc 'description frame))) -(defsubst geiser-debug--frame-source (frame) (cdr (assoc 'source frame))) -(defsubst geiser-debug--frame-source-file (src) (car src)) -(defsubst geiser-debug--frame-source-line (src) (or (cadr src) 1)) -(defsubst geiser-debug--frame-source-column (src) (or (caddr src) 0)) - -(defun geiser-debug--display-stack (stack) - (mapc 'geiser-debug--display-stack-frame (reverse (cdr stack)))) - -(defun geiser-debug--display-stack-frame (frame) - (let ((procedure (geiser-debug--frame-proc frame)) - (source (geiser-debug--frame-source frame)) - (description (geiser-debug--frame-desc frame))) - (if source - (insert (format "In file %s:%s:%s\n" - (geiser-debug--frame-source-file source) - (geiser-debug--frame-source-line source) - (1+ (geiser-debug--frame-source-column source)))) - (insert "In expression:\n")) - (insert (format "%s\n" description)))) - (defsubst geiser-debug--wrap-region (str) (format "(begin %s)" str)) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index c493092..90be67c 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -149,7 +149,6 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) -(defsubst geiser-eval--retort-stack (ret) (cdr (assoc 'stack ret))) (defsubst geiser-eval--error-key (err) (cdr (assoc 'key err))) (defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err))) @@ -160,7 +159,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (let* ((key (geiser-eval--error-key err)) (key-str (if key (format ": %s" key) ":")) (subr (geiser-eval--error-subr err)) - (subr-str (if subr (format " (%s):" subr) ":")) + (subr-str (if subr (format " (%s):" subr) "")) (msg (geiser-eval--error-msg err)) (msg-str (if msg (format "\n %s" msg) "")) (rest (geiser-eval--error-rest err)) |