Insert Greek letter lambda.
[geiser.git] / elisp / geiser-debug.el
blobc35f5774366792d50726ad8b5c2f838290a24603
1 ;;; geiser-debug.el -- displaying debug information and evaluation results
3 ;; Copyright (C) 2009, 2010, 2011, 2012 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Mon Feb 23, 2009 22:34
14 (require 'geiser-edit)
15 (require 'geiser-autodoc)
16 (require 'geiser-impl)
17 (require 'geiser-eval)
18 (require 'geiser-menu)
19 (require 'geiser-popup)
20 (require 'geiser-base)
23 ;;; Customization:
25 (defgroup geiser-debug nil
26 "Debugging and error display options."
27 :group 'geiser)
29 (geiser-custom--defcustom geiser-debug-always-display-sexp-after-p nil
30 "Whether to always display the sexp whose evaluation caused an
31 error after the error message in the debug pop-up. If nil,
32 expressions shorter than `geiser-debug-long-sexp-lines` lines are
33 show before the error message."
34 :group 'geiser-debug
35 :type 'boolean)
37 (geiser-custom--defcustom geiser-debug-long-sexp-lines 6
38 "Length of an expression in order to be relegated to the bottom
39 of the debug pop-up (after the error message). If
40 `geiser-debug-always-display-sexp-after-p` is t, this variable
41 has no effect."
42 :group 'geiser-debug
43 :type 'int)
46 (geiser-custom--defcustom geiser-debug-auto-display-images-p t
47 "Whether to automatically invoke the external viewer to display
48 images when they're evaluated.
50 See also `geiser-repl-auto-display-images-p'."
51 :group 'geiser-debug
52 :type 'boolean)
55 ;;; Debug buffer mode:
57 (defvar geiser-debug-mode-map
58 (let ((map (make-sparse-keymap)))
59 (suppress-keymap map)
60 (set-keymap-parent map button-buffer-map)
61 map))
63 (defun geiser-debug-mode ()
64 "A major mode for displaying Scheme compilation and evaluation results.
65 \\{geiser-debug-mode-map}"
66 (interactive)
67 (kill-all-local-variables)
68 (buffer-disable-undo)
69 (use-local-map geiser-debug-mode-map)
70 (set-syntax-table scheme-mode-syntax-table)
71 (setq mode-name "Geiser DBG")
72 (setq major-mode 'geiser-debug-mode)
73 (setq next-error-function 'geiser-edit--open-next)
74 (setq buffer-read-only t))
76 (defun geiser-debug--button-p (nextp)
77 (let ((m (funcall (if nextp 'next-button 'previous-button) (point))))
78 (and m (funcall (if nextp '< '>) (point) (marker-position m)))))
80 (geiser-menu--defmenu debug geiser-debug-mode-map
81 ("Next error" "n" forward-button :enable (geiser-debug--button-p t))
82 ("Previous error" "p" backward-button :enable (geiser-debug--button-p t))
84 ("Quit" nil View-quit))
87 ;;; Buffer for displaying evaluation results:
89 (geiser-popup--define debug "*Geiser dbg*" geiser-debug-mode)
92 ;;; Displaying retorts
94 (geiser-impl--define-caller geiser-debug--display-error
95 display-error (module key message)
96 "This method takes 3 parameters (a module name, the error key,
97 and the accompanying error message) and should display
98 (in the current buffer) a formatted version of the error. If the
99 error was successfully displayed, the call should evaluate to a
100 non-null value.")
102 (geiser-impl--define-caller geiser-debug--enter-debugger
103 enter-debugger ()
104 "This method is called upon entering the debugger, in the REPL
105 buffer.")
107 (defun geiser-debug--display-after (what)
108 (or geiser-debug-always-display-sexp-after-p
109 (>= (with-temp-buffer
110 (insert what)
111 (count-lines (point-min) (point-max)))
112 geiser-debug-long-sexp-lines)))
114 (defun geiser-debug--insert-res (res)
115 (let ((begin (point)))
116 (insert res)
117 (let ((end (point)))
118 (goto-char begin)
119 (let ((no
120 (geiser-image--replace-images t
121 geiser-debug-auto-display-images-p)))
122 (goto-char end)
123 (newline 2)
124 (and no (> no 0))))))
126 (defun geiser-debug--display-retort (what ret &optional res auto-p)
127 (let* ((err (geiser-eval--retort-error ret))
128 (key (geiser-eval--error-key err))
129 (output (geiser-eval--retort-output ret))
130 (impl geiser-impl--implementation)
131 (module (geiser-eval--get-module))
132 (dbg nil)
133 (img nil)
134 (dir default-directory)
135 (buffer (current-buffer))
136 (debug (eq key 'geiser-debugger))
137 (after (geiser-debug--display-after what)))
138 (when debug
139 (switch-to-geiser nil nil buffer)
140 (geiser-debug--enter-debugger impl))
141 (geiser-debug--with-buffer
142 (erase-buffer)
143 (when dir (setq default-directory dir))
144 (unless after
145 (geiser-debug--display-error impl module nil what)
146 (newline 2))
147 (setq img (when (and res (not err)) (geiser-debug--insert-res res)))
148 (setq dbg (geiser-debug--display-error impl module key output))
149 (when after
150 (goto-char (point-max))
151 (insert "\nExpression evaluated was:\n\n")
152 (geiser-debug--display-error impl module nil what))
153 (goto-char (point-min)))
154 (when (or img dbg) (geiser-debug--pop-to-buffer))))
156 (defsubst geiser-debug--wrap-region (str)
157 (format "(begin %s)" str))
159 (defun geiser-debug--unwrap (str)
160 (if (string-match "(begin[ \t\n\v\r]+\\(.+\\)*)" str)
161 (match-string 1 str)
162 str))
164 (defun geiser-debug--send-region (compile start end and-go wrap)
165 (let* ((str (buffer-substring-no-properties start end))
166 (wrapped (if wrap (geiser-debug--wrap-region str) str))
167 (code `(,(if compile :comp :eval) (:scm ,wrapped)))
168 (ret (geiser-eval--send/wait code))
169 (res (geiser-eval--retort-result-str ret))
170 (err (geiser-eval--retort-error ret)))
171 (when and-go (funcall and-go))
172 (when (not err)
173 (save-excursion
174 (goto-char (/ (+ end start) 2))
175 (geiser-autodoc--clean-cache))
176 (message "%s" res))
177 (geiser-debug--display-retort (geiser-syntax--scheme-str str) ret res)))
179 (defun geiser-debug--expand-region (start end all wrap)
180 (let* ((str (buffer-substring-no-properties start end))
181 (wrapped (if wrap (geiser-debug--wrap-region str) str))
182 (code `(:eval (:ge macroexpand (quote (:scm ,wrapped))
183 ,(if all :t :f))))
184 (ret (geiser-eval--send/wait code))
185 (err (geiser-eval--retort-error ret))
186 (result (geiser-eval--retort-result ret)))
187 (if err
188 (geiser-debug--display-retort str ret)
189 (geiser-debug--with-buffer
190 (erase-buffer)
191 (insert (format "%s" (if wrap (geiser-debug--unwrap result) result)))
192 (goto-char (point-min)))
193 (geiser-debug--pop-to-buffer))))
196 (provide 'geiser-debug)