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-eval.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'elisp/geiser-eval.el') 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)) -- 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-eval.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 From 81766b3043a4f14a777affe5bc0b76109ae8ea0f Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 6 Jul 2009 23:47:00 +0200 Subject: Stray paren killed. --- elisp/geiser-eval.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'elisp/geiser-eval.el') diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 428d057..3e0d0d9 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -152,7 +152,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (let ((values (cdr (assoc 'result ret)))) (if values (concat "=> " (mapconcat 'identity values "\n=> ")) - "(No value)")))) + "(No value)"))) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) -- cgit v1.2.3 From 11e52e18251f6c2c5a9c7c37bbd4a1787e84b282 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 23 Aug 2009 02:59:09 +0200 Subject: Fixes for all byte-compilation warnings. --- elisp/geiser-autodoc.el | 4 ++-- elisp/geiser-base.el | 20 ++-------------- elisp/geiser-completion.el | 6 ++--- elisp/geiser-doc.el | 2 +- elisp/geiser-edit.el | 5 +++- elisp/geiser-eval.el | 38 +++++++++++++++--------------- elisp/geiser-guile.el | 3 +++ elisp/geiser-impl.el | 58 ++++++++++++++++++++++++---------------------- elisp/geiser-log.el | 2 ++ 9 files changed, 66 insertions(+), 72 deletions(-) (limited to 'elisp/geiser-eval.el') diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 1d876dd..a8a7a50 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -114,8 +114,8 @@ when `geiser-autodoc-display-module-p' is on." (module (cdr (assoc 'module signature)))) (if (not args) (geiser-autodoc--proc-name proc module) (let ((cpos 1) - (pos (or (second desc) 0)) - (prev (third desc)) + (pos (or (cadr desc) 0)) + (prev (caddr desc)) (reqs (cdr (assoc 'required args))) (opts (cdr (assoc 'optional args))) (keys (cdr (assoc 'key args)))) diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el index 362930d..ba0067a 100644 --- a/elisp/geiser-base.el +++ b/elisp/geiser-base.el @@ -25,26 +25,10 @@ ;;; Code: - -;;; Versioning: - -(defconst geiser-version-major 0 - "Geiser's major version number.") -(defconst geiser-version-minor 1 - "Geiser's minor version number.") - -(defun geiser-version-string () - "Geiser's version as a string." - (format "%s.%s" geiser-version-major geiser-version-minor)) - -(defun geiser-version () - "Echoes Geiser's version." - (interactive) - (message "Geiser %s" (geiser-version-string))) - - ;;; Emacs compatibility: +(eval-when-compile (require 'cl)) + (eval-after-load "ring" '(when (not (fboundp 'ring-member)) (defun ring-member (ring item) diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index 28aef12..cd03cae 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -29,7 +29,7 @@ (require 'geiser-syntax) (require 'geiser-base) -(eval-when-compile (require 'cl)) +(require 'cl) ;;; Completions window handling, heavily inspired in slime's: @@ -84,7 +84,7 @@ terminates a current completion." (remove-hook 'pre-command-hook 'geiser-completion--maybe-restore-window-cfg) (condition-case err - (cond ((find last-command-char "()\"'`,# \r\n:") + (cond ((find last-command-event "()\"'`,# \r\n:") (geiser-completion--restore-window-cfg)) ((not (geiser-completion--window-active-p)) (geiser-completion--forget-window-cfg)) @@ -146,7 +146,7 @@ terminates a current completion." ;;; Completion functionality: -(defsubst geiser-completion--symbol-list (prefix) +(defun geiser-completion--symbol-list (prefix) (delete-duplicates (append (mapcar (lambda (s) (format "%s" s)) (geiser-syntax--locals-around-point)) (geiser-eval--send/result `(:eval ((:ge completions) ,prefix)))) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 61c50f5..8e5c816 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -180,7 +180,7 @@ (cdr (assoc 'signature ds)))) (newline) (insert (or (cdr (assoc 'docstring ds)) "")) - (goto-line (point-min)) + (goto-char (point-min)) (setq geiser-doc--buffer-link (geiser-doc--history-push (geiser-doc--make-link symbol module impl)))) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 723e898..ad2c11e 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -106,8 +106,9 @@ or following links in error buffers.") (format "\\_<%s\\_>" (regexp-quote (format "%s" thing)))) (defun geiser-edit--goto-line (symbol line) + (goto-char (point-min)) (if (numberp line) - (goto-line line) + (forward-line (max 0 (1- line))) (goto-char (point-min)) (when (or (re-search-forward (geiser-edit--def-re symbol) nil t) (re-search-forward (geiser-edit--def-re* symbol) nil t) @@ -152,6 +153,8 @@ or following links in error buffers.") ;;; Commands: +(defvar geiser-edit--symbol-history nil) + (defun geiser-edit-symbol () "Asks for a symbol to edit, with completion." (interactive) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 3e0d0d9..1c8cbfe 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -54,25 +54,6 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) ;;; Code formatting: -(defun geiser-eval--scheme-str (code) - (cond ((null code) "'()") - ((eq code :f) "#f") - ((eq code :t) "#t") - ((listp code) - (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code))) - ((eq (car code) :comp) (geiser-eval--comp (cdr code))) - ((eq (car code) :load-file) - (geiser-eval--load-file (cadr code))) - ((eq (car code) :comp-file) - (geiser-eval--comp-file (cadr code))) - ((eq (car code) :module) (geiser-eval--module (cadr code))) - ((eq (car code) :ge) (geiser-eval--ge (cadr code))) - ((eq (car code) :scm) (cadr code)) - (t (concat "(" - (mapconcat 'geiser-eval--scheme-str code " ") ")")))) - ((symbolp code) (format "%s" code)) - (t (format "%S" code)))) - (defsubst geiser-eval--eval (code) (geiser-eval--scheme-str `(,(geiser-eval--form 'eval) (quote ,(nth 0 code)) @@ -99,6 +80,25 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defsubst geiser-eval--ge (proc) (geiser-eval--scheme-str (geiser-eval--form proc))) +(defun geiser-eval--scheme-str (code) + (cond ((null code) "'()") + ((eq code :f) "#f") + ((eq code :t) "#t") + ((listp code) + (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code))) + ((eq (car code) :comp) (geiser-eval--comp (cdr code))) + ((eq (car code) :load-file) + (geiser-eval--load-file (cadr code))) + ((eq (car code) :comp-file) + (geiser-eval--comp-file (cadr code))) + ((eq (car code) :module) (geiser-eval--module (cadr code))) + ((eq (car code) :ge) (geiser-eval--ge (cadr code))) + ((eq (car code) :scm) (cadr code)) + (t (concat "(" + (mapconcat 'geiser-eval--scheme-str code " ") ")")))) + ((symbolp code) (format "%s" code)) + (t (format "%S" code)))) + ;;; Code sending: diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index ed2a555..ed14e87 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -27,6 +27,9 @@ (require 'geiser-syntax) (require 'geiser-custom) (require 'geiser-base) +(require 'geiser-eval) +(require 'geiser-edit) +(require 'geiser) ;;; Customization: diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index 32acade..840d0c1 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -58,11 +58,40 @@ determine its scheme flavour." symbol)) :group 'geiser-impl) + +;;; Auxiliary functions: +(defsubst geiser-impl--sym (imp name) + (intern (format "geiser-%s-%s" imp name))) + +(defsubst geiser-impl--boundp (imp name) + (boundp (geiser-impl--sym imp name))) + +(defsubst geiser-impl--fboundp (imp name) + (fboundp (geiser-impl--sym imp name))) + +(defsubst geiser-impl--impl-feature (impl) + (intern (format "geiser-%s" impl))) + +(defun geiser-impl--value (imp name &optional fun) + (let ((sym (geiser-impl--sym imp name))) + (unless (or (and (not fun) (boundp sym)) + (and fun (fboundp sym))) + (error "Unbound %s '%s' in Geiser Scheme implementation %s" + (if fun "function" "variable") sym imp)) + (if fun (symbol-function sym) (symbol-value sym)))) + +(defsubst geiser-impl--call-if-bound (imp name &rest args) + (when (geiser-impl--fboundp imp name) + (apply (geiser-impl--value imp name t) args))) + ;;; Registering implementations: (defvar geiser-impl--impls nil) +(make-variable-buffer-local + (defvar geiser-impl--implementation nil)) + (defun geiser-impl--register (impl) (when (and (not (memq impl geiser-impl--impls)) (require (geiser-impl--impl-feature impl) nil t)) @@ -91,9 +120,6 @@ determine its scheme flavour." ;;; Installing Scheme implementations: -(make-variable-buffer-local - (defvar geiser-impl--implementation nil)) - (defvar geiser-impl--impl-prompt-history nil) (defun geiser-impl--read-impl (&optional prompt impls non-req) @@ -114,30 +140,6 @@ determine its scheme flavour." (geiser-impl--install-vars impl) (geiser-impl--register impl))) -(defsubst geiser-impl--sym (imp name) - (intern (format "geiser-%s-%s" imp name))) - -(defsubst geiser-impl--boundp (imp name) - (boundp (geiser-impl--sym imp name))) - -(defsubst geiser-impl--fboundp (imp name) - (fboundp (geiser-impl--sym imp name))) - -(defsubst geiser-impl--impl-feature (impl) - (intern (format "geiser-%s" impl))) - -(defun geiser-impl--value (imp name &optional fun) - (let ((sym (geiser-impl--sym imp name))) - (unless (or (and (not fun) (boundp sym)) - (and fun (fboundp sym))) - (error "Unbound %s '%s' in Geiser Scheme implementation %s" - (if fun "function" "variable") sym imp)) - (if fun (symbol-function sym) (symbol-value sym)))) - -(defsubst geiser-impl--call-if-bound (imp name &rest args) - (when (geiser-impl--fboundp imp name) - (apply (geiser-impl--value imp name t) args))) - (defsubst geiser-impl--module-function (impl) (geiser-impl--sym impl "get-module")) @@ -259,7 +261,7 @@ implementation to be used by Geiser.")) (let* ((current geiser-impl-installed-implementations) (impl (geiser-impl--read-impl "Forget implementation: " current))) (geiser-impl--unregister impl) - (when (and (impl current) + (when (and impl (y-or-n-p "Forget permanently using customize? ")) (customize-save-variable 'geiser-impl-installed-implementations (remove impl current))))) diff --git a/elisp/geiser-log.el b/elisp/geiser-log.el index 68e0fae..27a485a 100644 --- a/elisp/geiser-log.el +++ b/elisp/geiser-log.el @@ -28,6 +28,8 @@ (require 'geiser-popup) (require 'geiser-base) +(require 'comint) + ;;; Customization: -- cgit v1.2.3