summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-24 02:18:28 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-24 02:18:28 +0100
commit8bf2c578f184837968b1a16cf07235e9ba616a91 (patch)
treed65d8d84454bf5813cd0c8f261d28b7c26a2c595
parent540a2cb21e9d8b84ddd3be629b7f2937f76cf6e9 (diff)
downloadgeiser-8bf2c578f184837968b1a16cf07235e9ba616a91.tar.gz
geiser-8bf2c578f184837968b1a16cf07235e9ba616a91.tar.bz2
Partial support for stack trace display.
-rw-r--r--elisp/geiser-autodoc.el57
-rw-r--r--elisp/geiser-compile.el34
-rw-r--r--elisp/geiser-debug.el96
-rw-r--r--elisp/geiser-eval.el1
-rw-r--r--elisp/geiser-mode.el17
5 files changed, 131 insertions, 74 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 3c23b32..7460aa1 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -75,8 +75,7 @@ when `geiser-autodoc-display-module-p' is on."
(cdr pr))
(setq geiser-autodoc--last-funs funs)
(geiser-eval--send
- `(:eval ((:ge arguments)
- ,@(mapcar (lambda (f) (list 'quote (car f))) funs)))
+ `(:eval ((:ge arguments) ,@(mapcar (lambda (f) (list 'quote (car f))) funs)))
'geiser-autodoc--function-args-cont)
""))))
@@ -84,12 +83,9 @@ when `geiser-autodoc-display-module-p' is on."
(let ((result (geiser-eval--retort-result ret)))
(when (and result (listp result))
(setq geiser-autodoc--last result)
- (eldoc-message
- (geiser-autodoc--fun-args-str (car result)
- (cdr result)
- (or (cdr (assoc (car result)
- geiser-autodoc--last-funs))
- 0))))))
+ (let* ((pos (or (cdr (assoc (car result) geiser-autodoc--last-funs)) 0))
+ (msg (geiser-autodoc--fun-args-str (car result) (cdr result) pos)))
+ (when msg (eldoc-message msg))))))
(defun geiser-autodoc--insert (sym current pos)
(let ((str (format "%s" sym)))
@@ -100,34 +96,35 @@ when `geiser-autodoc-display-module-p' is on."
(insert str)))
(defun geiser-autodoc--fun-args-str (fun args pos)
- (save-current-buffer
- (set-buffer (geiser-syntax--font-lock-buffer))
- (erase-buffer)
- (let* ((current 0)
- (module (and geiser-autodoc-display-module-p
- (cdr (assoc 'module args))))
- (fun (if module
- (format geiser-autodoc-procedure-name-format module fun)
- fun)))
- (insert "(")
- (geiser-autodoc--insert fun current pos)
- (dolist (arg (cdr (assoc 'required args)))
+ (when fun
+ (save-current-buffer
+ (set-buffer (geiser-syntax--font-lock-buffer))
+ (erase-buffer)
+ (let* ((current 0)
+ (module (and geiser-autodoc-display-module-p
+ (cdr (assoc 'module args))))
+ (fun (if module
+ (format geiser-autodoc-procedure-name-format module fun)
+ fun)))
+ (insert "(")
+ (geiser-autodoc--insert fun current pos)
+ (dolist (arg (cdr (assoc 'required args)))
+ (setq current (1+ current))
+ (insert " ")
+ (geiser-autodoc--insert arg current pos))
(setq current (1+ current))
- (insert " ")
- (geiser-autodoc--insert arg current pos))
- (setq current (1+ current))
- (when (cdr (assoc 'optional args))
- (when (> pos current) (setq current pos))
- (insert " . ")
- (geiser-autodoc--insert (cdr (assoc 'optional args)) current pos))
- (insert ")")
- (buffer-string))))
+ (when (cdr (assoc 'optional args))
+ (when (> pos current) (setq current pos))
+ (insert " . ")
+ (geiser-autodoc--insert (cdr (assoc 'optional args)) current pos))
+ (insert ")")
+ (buffer-string)))))
;;; Autodoc function:
(defun geiser-autodoc--eldoc-function ()
- (geiser-autodoc--function-args (geiser-syntax--enclosing-form-data)))
+ (or (geiser-autodoc--function-args (geiser-syntax--enclosing-form-data)) ""))
;;; Autodoc mode:
diff --git a/elisp/geiser-compile.el b/elisp/geiser-compile.el
index 82200a5..8b4a4db 100644
--- a/elisp/geiser-compile.el
+++ b/elisp/geiser-compile.el
@@ -24,20 +24,11 @@
;;; Code:
+(require 'geiser-debug)
(require 'geiser-eval)
-(require 'geiser-popup)
(require 'geiser-base)
-;;; Compilation buffer:
-
-(define-derived-mode geiser-compile-mode compilation-mode "Geiser Compilation"
- "Major mode showing the results of compiling or loading scheme files.
-\{geiser-compile-mode-keymap}")
-
-(geiser-popup--define compile "*Geiser compilation*" geiser-compile-mode)
-
-
;;; Auxiliary functions:
(defun geiser-compile--buffer/path (&optional path)
@@ -49,25 +40,10 @@
(cons buffer path))))
(defun geiser-compile--display-result (title ret)
- (let ((err (geiser-eval--retort-error ret))
- (output (geiser-eval--retort-output ret)))
- (geiser-compile--with-buffer
- (erase-buffer)
- (insert title)
- (newline)
- (when output
- (insert output)
- (newline))
- (when err
- (insert "\n" (geiser-eval--error-msg err) "\n"))
- (goto-char (point-min)))
- (if (not err)
- (message "%s %s" title (if (> 0 (length output))
- (geiser--chomp output)
- (or (geiser-eval--retort-result ret)
- "OK!")))
- (message "")
- (geiser-compile--pop-to-buffer))))
+ (if (not (geiser-eval--retort-error ret))
+ (message "%s %s" title (or (geiser-eval--retort-result ret) "OK!"))
+ (message "")
+ (geiser-debug--display-retort title ret)))
(defun geiser-compile--file-op (path compile-p msg)
(let* ((b/p (geiser-compile--buffer/path path))
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
new file mode 100644
index 0000000..c32c895
--- /dev/null
+++ b/elisp/geiser-debug.el
@@ -0,0 +1,96 @@
+;; geiser-debug.el -- displaying debug information
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Mon Feb 23, 2009 22:34
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Buffer and associated mode for displaying results of evaluations
+;; and compilations.
+
+;;; Code:
+
+(require 'geiser-eval)
+(require 'geiser-popup)
+(require 'geiser-base)
+
+
+;;; Debug buffer mode:
+
+(defvar geiser-debug-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map "g" 'geiser-debug-goto-error)
+ (define-key map "\C-c\C-c" 'geiser-debug-goto-error)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ map))
+
+(define-derived-mode geiser-debug-mode compilation-mode "Geiser Dbg"
+ "A major mode for displaying Scheme compilation and evaluation results.
+\\{geiser-debug-mode-map}")
+
+
+;;; Buffer for displaying evaluation results:
+
+(geiser-popup--define debug "*Geiser dbg*" geiser-debug-mode)
+
+
+;;; Displaying retorts
+
+(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))
+ (step 2)
+ (indent step))
+ (when err
+ (geiser-debug--with-buffer
+ (erase-buffer)
+ (insert what)
+ (newline 2)
+ (insert (geiser-eval--error-str err) "\n\n")
+ (when output (insert output "\n\n"))
+ (dolist (f (reverse (cdr stack)))
+ (geiser-debug--display-stack-frame f indent)
+ (setq indent (+ step indent)))
+ (goto-char (point-min)))
+ (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-frame (frame offset)
+ (let ((procedure (geiser-debug--frame-proc frame))
+ (source (geiser-debug--frame-source frame))
+ (description (geiser-debug--frame-desc frame)))
+ (if source
+ (insert (format "%s:%s:%s\n"
+ (geiser-debug--frame-source-file source)
+ (geiser-debug--frame-source-line source)
+ (geiser-debug--frame-source-column source)))
+ (insert "In expression:\n"))
+ (insert (format "%s%s\n" (make-string offset ?\ ) description))))
+
+
+(provide 'geiser-debug)
+;;; geiser-debug.el ends here
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 785f441..09f12da 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -125,6 +125,7 @@
(defsubst geiser-eval--retort-result (ret) (cdr (assoc 'result ret)))
(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)))
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 3c2f1a9..e308c07 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -30,8 +30,8 @@
(require 'geiser-completion)
(require 'geiser-edit)
(require 'geiser-autodoc)
+(require 'geiser-debug)
(require 'geiser-eval)
-(require 'geiser-popup)
(require 'geiser-custom)
(require 'geiser-base)
@@ -57,19 +57,6 @@
;;; Auxiliary functions:
-(geiser-popup--define mode "*Geiser evaluation results*" scheme-mode)
-
-(defun geiser-eval--display-error (err output)
- (if (not output)
- (message (geiser-eval--error-str err))
- (geiser-mode--with-buffer
- (erase-buffer)
- (insert ";; " (geiser-eval--error-str err))
- (newline 2)
- (insert output)
- (newline))
- (geiser-mode--pop-to-buffer)))
-
(defun geiser-eval--send-region (compile start end and-go)
(let* ((str (buffer-substring-no-properties start end))
(code `(,(if compile :comp :eval) (:scm ,str)))
@@ -81,7 +68,7 @@
(goto-char (point-max)))
(if (not err)
(message (format "=> %s" (geiser-eval--retort-result ret)))
- (geiser-eval--display-error err (geiser-eval--retort-output ret)))))
+ (geiser-debug--display-retort str ret))))
;;; Evaluation commands: