From 230ca2d12926ecda1fe2946e2726079fcbd05ef4 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 16 Jun 2009 22:36:15 +0200 Subject: Elimination of dead code in stack trace display. --- elisp/geiser-debug.el | 46 +++++++++++++++------------------------------- 1 file changed, 15 insertions(+), 31 deletions(-) (limited to 'elisp/geiser-debug.el') 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)) -- cgit v1.2.3 From e582b04710dbbdb84ad9df350e3feb29dcad3c5a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Wed, 17 Jun 2009 03:13:38 +0200 Subject: Implementation-specific backtrace display. --- elisp/geiser-debug.el | 11 ++++++++--- elisp/geiser-impl.el | 3 +++ elisp/geiser.el | 2 +- 3 files changed, 12 insertions(+), 4 deletions(-) (limited to 'elisp/geiser-debug.el') diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index f0dc6ec..3bf262c 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -25,6 +25,7 @@ ;;; Code: +(require 'geiser-impl) (require 'geiser-eval) (require 'geiser-popup) (require 'geiser-base) @@ -60,13 +61,17 @@ (defun geiser-debug--display-retort (what ret) (let* ((err (geiser-eval--retort-error ret)) - (output (geiser-eval--retort-output ret))) + (key (geiser-eval--error-key err)) + (output (geiser-eval--retort-output ret)) + (impl geiser-impl--implementation) + (module (geiser-eval--get-module))) (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")) + (unless (geiser-impl--display-error impl module key output) + (when err (insert (geiser-eval--error-str err) "\n\n")) + (when output (insert output "\n\n"))) (goto-char (point-min))) (when err (geiser-debug--pop-to-buffer)))) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index b4c01c7..fadc8b6 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -186,6 +186,9 @@ (defsubst geiser-impl--external-help (impl symbol module) (geiser-impl--call-if-bound impl "external-help" symbol module)) +(defsubst geiser-impl--display-error (impl module key msg) + (geiser-impl--call-if-bound impl "display-error" module key msg)) + ;;; Access to implementation guessing function: diff --git a/elisp/geiser.el b/elisp/geiser.el index 926cb4f..748fb23 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -117,11 +117,11 @@ geiser-xref geiser-edit geiser-doc + geiser-debug geiser-impl geiser-completion geiser-autodoc geiser-compile - geiser-debug geiser-eval geiser-connection geiser-syntax -- cgit v1.2.3 From 64800ae4fa27b88ca8ee6c58d7edb0056e71ade6 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 19 Jun 2009 17:03:10 +0200 Subject: Better display of evaluation results. --- elisp/geiser-debug.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'elisp/geiser-debug.el') diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 3bf262c..ec2e93e 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -90,7 +90,7 @@ (ret (geiser-eval--send/wait code)) (err (geiser-eval--retort-error ret))) (when and-go (funcall and-go)) - (when (not err) (message (format "=> %s" (geiser-eval--retort-result ret)))) + (when (not err) (message (format "=> %S" (geiser-eval--retort-result ret)))) (geiser-debug--display-retort str ret))) (defun geiser-debug--expand-region (start end all wrap) -- cgit v1.2.3 From 710d0cec8854a4e89f4948d49e614f286913f711 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 2 Jul 2009 05:29:04 +0200 Subject: Simpler, nicer, more efficient handling of evaluation results. It comes with a pony too. --- elisp/geiser-connection.el | 1 - elisp/geiser-debug.el | 10 +++++--- elisp/geiser-eval.el | 9 ++++++- elisp/geiser-syntax.el | 10 -------- scheme/guile/geiser/evaluation.scm | 51 ++++++++++++++++++-------------------- scheme/plt/geiser/eval.ss | 8 ++++-- 6 files changed, 45 insertions(+), 44 deletions(-) (limited to 'elisp/geiser-debug.el') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 0ec6405..4f8592b 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -165,7 +165,6 @@ (goto-char (point-min)) (re-search-forward "((\\(result\\|error\\)\\>") (goto-char (match-beginning 0)) - (geiser-syntax--prepare-scheme-for-elisp-reader) (let ((form (read (current-buffer)))) (if (listp form) form (error)))) (error `((error (key . geiser-con-error)) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index ec2e93e..6d795df 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -59,7 +59,7 @@ ;;; Displaying retorts -(defun geiser-debug--display-retort (what ret) +(defun geiser-debug--display-retort (what ret &optional res) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) (output (geiser-eval--retort-output ret)) @@ -69,6 +69,9 @@ (erase-buffer) (insert what) (newline 2) + (when res + (insert res) + (newline 2)) (unless (geiser-impl--display-error impl module key output) (when err (insert (geiser-eval--error-str err) "\n\n")) (when output (insert output "\n\n"))) @@ -88,10 +91,11 @@ (wrapped (if wrap (geiser-debug--wrap-region str) str)) (code `(,(if compile :comp :eval) (:scm ,wrapped))) (ret (geiser-eval--send/wait code)) + (res (geiser-eval--retort-result-str ret)) (err (geiser-eval--retort-error ret))) (when and-go (funcall and-go)) - (when (not err) (message (format "=> %S" (geiser-eval--retort-result ret)))) - (geiser-debug--display-retort str ret))) + (when (not err) (message "%s" res)) + (geiser-debug--display-retort str ret res))) (defun geiser-debug--expand-region (start end all wrap) (let* ((str (buffer-substring-no-properties start end)) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 90be67c..428d057 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -145,7 +145,14 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defun geiser-eval--retort-result (ret) (let ((values (cdr (assoc 'result ret)))) - (if (> (length values) 1) (cons :values values) (car values)))) + (and (stringp (car values)) + (ignore-errors (car (read-from-string (car values))))))) + +(defun geiser-eval--retort-result-str (ret) + (let ((values (cdr (assoc 'result ret)))) + (if values + (concat "=> " (mapconcat 'identity values "\n=> ")) + "(No value)")))) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index c70aacb..db1c842 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -84,16 +84,6 @@ (geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode) -(defun geiser-syntax--prepare-scheme-for-elisp-reader () - (let ((end (save-excursion - (goto-char (point-max)) - (and (re-search-backward "(output \\. \"" nil t) - (point))))) - (save-excursion - (while (re-search-forward "#(" end t) (replace-match "(vector ")) - (goto-char (point-min)) - (while (re-search-forward "#" end t) (replace-match "\\\\#"))))) - (defsubst geiser-syntax--del-sexp (arg) (let ((p (point))) (forward-sexp arg) diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index 3e38843..c2147a1 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -47,40 +47,37 @@ (else (display (format "ERROR: ~a, args: ~a" (car args) (cdr args))))) `(error (key . ,(car args)))) -(define (evaluate form module-name evaluator) - (let ((module (or (and (list? module-name) - (resolve-module module-name)) - (current-module))) - (evaluator (lambda (f m) - (call-with-values (lambda () (evaluator f m)) list))) - (result #f) - (captured-stack #f) - (error #f)) +(define (ge:compile form module-name) + (let* ((module (or (and (list? module-name) + (resolve-module module-name)) + (current-module))) + (result #f) + (captured-stack #f) + (error #f) + (ev (lambda () + (save-module-excursion + (set-current-module module) + (set! result (call-with-values + (lambda () (compile form)) + (lambda vs + (map (lambda (v) + (with-output-to-string + (lambda () (write v)))) + vs)))))))) (let ((output (with-output-to-string (lambda () - (set! result - (catch #t - (lambda () - (start-stack 'geiser-eval (evaluator form module))) - (lambda args - (set! error #t) - (apply handle-error captured-stack args)) - (lambda args - (set! captured-stack (make-stack #t 2 15))))))))) + (catch #t + (lambda () (start-stack 'geiser-eval (ev))) + (lambda args + (set! error #t) + (apply handle-error captured-stack args)) + (lambda args + (set! captured-stack (make-stack #t 2 15)))))))) (write `(,(if error result (cons 'result result)) (output . ,output))) (newline)))) -(define (eval-compile form module) - (save-module-excursion - (lambda () - (set-current-module module) - (compile form)))) - -(define (ge:compile form module-name) - (evaluate form module-name eval-compile)) - (define ge:eval ge:compile) (define (ge:compile-file path) diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss index 435b73b..5ae81ed 100644 --- a/scheme/plt/geiser/eval.ss +++ b/scheme/plt/geiser/eval.ss @@ -49,8 +49,12 @@ (set! last-result `((error (key . ,(exn-key e))))) (display (exn-message e))) -(define (set-last-result v . vs) - (set! last-result `((result ,v ,@vs)))) +(define (write-value v) + (with-output-to-string + (lambda () (write v)))) + +(define (set-last-result . vs) + (set! last-result `((result ,@(map write-value vs))))) (define (eval-in form spec) (set-last-result (void)) -- cgit v1.2.3