diff options
| -rw-r--r-- | elisp/geiser-eval.el | 24 | ||||
| -rw-r--r-- | elisp/geiser-plt.el | 162 | ||||
| -rw-r--r-- | elisp/geiser.el | 2 |
3 files changed, 178 insertions, 10 deletions
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index b8f971b..cc7bc35 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -61,22 +61,27 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) ((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) :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 " ") ")")))) + (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)) (:module ,(nth 1 code))))) + `(,(geiser-eval--form 'eval) (quote ,(nth 0 code)) + (:module ,(nth 1 code))))) (defsubst geiser-eval--comp (code) (geiser-eval--scheme-str - `(,(geiser-eval--form 'compile) (quote ,(nth 0 code)) (:module ,(nth 1 code))))) + `(,(geiser-eval--form 'compile) + (quote ,(nth 0 code)) (:module ,(nth 1 code))))) (defsubst geiser-eval--load-file (file) (geiser-eval--scheme-str `(,(geiser-eval--form 'load-file) ,file))) @@ -153,13 +158,14 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defun geiser-eval--error-str (err) (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 ": %s" msg) "")) + (msg-str (if msg (format "\n %s" msg) "")) (rest (geiser-eval--error-rest err)) - (rest-str (if rest (format " %s" rest) ""))) - (format "Error%s: %s%s%s" subr-str key msg-str rest-str))) + (rest-str (if rest (format "\n %s" rest) ""))) + (format "Error%s%s%s%s" subr-str key-str msg-str rest-str))) diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el new file mode 100644 index 0000000..aa9a901 --- /dev/null +++ b/elisp/geiser-plt.el @@ -0,0 +1,162 @@ +;; geiser-plt.el -- geiser support for PLT scheme + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sat Apr 25, 2009 21:13 + +;; 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: + +;; Implementation of Geiser's protocols for MzScheme. + +;;; Code: + +(require 'geiser-impl) +(require 'geiser-syntax) +(require 'geiser-custom) +(require 'geiser-base) + + +;;; Customization: + +(defgroup geiser-plt nil + "Customization for Geiser's PLT flavour." + :group 'geiser) + +(defcustom geiser-plt-binary + (cond ((eq system-type 'windows-nt) "MzScheme.exe") + ((eq system-type 'darwin) "mzscheme") + (t "mzscheme")) + "Name to use to call the mzscheme executable when starting a REPL." + :type '(choice string (repeat string)) + :group 'geiser-plt) + +(defcustom geiser-plt-init-file "~/.plt-geiser" + "Initialization file with user code for the mzscheme REPL." + :type 'string + :group 'geiser-plt) + + + +;;; REPL support: + +(defun geiser-plt-binary () + (if (listp geiser-plt-binary) (car geiser-plt-binary) geiser-plt-binary)) + +(defun geiser-plt-parameters () + "Return a list with all parameters needed to start mzscheme. +This function uses `geiser-plt-init-file' if it exists." + (let ((init-file (and (stringp geiser-plt-init-file) + (expand-file-name geiser-plt-init-file)))) + `("-i" "-q" + "-S" ,(expand-file-name "plt/" geiser-scheme-dir) + "-f" ,(expand-file-name "plt/geiser.ss" geiser-scheme-dir) + ,@(and (listp geiser-plt-binary) (cdr geiser-plt-binary)) + ,@(and init-file (file-readable-p init-file) (list "-f" init-file))))) + +(defconst geiser-plt-prompt-regexp "^mzscheme@([^)]*?)> ") + +(defun switch-to-plt (&optional ask) + (interactive "P") + (switch-to-geiser ask 'plt)) + +(defun run-plt () + "Run Geiser using mzscheme." + (interactive) + (run-geiser 'plt)) + + +;;; Evaluation support: + +(defun geiser-plt-geiser-procedure (proc) + (let ((proc (intern (format "geiser/%s" proc)))) + `(dynamic-require ''geiser ',proc))) + +(defconst geiser-plt--module-re + "^(module +\\(([^)]+)\\)") + +(defun geiser-plt--explicit-module () + (save-excursion + (goto-char (point-min)) + (and (re-search-forward geiser-plt--module-re nil t) + (ignore-errors + (car (read-from-string (match-string-no-properties 1))))))) + +(defun geiser-plt-get-module (&optional module) + (cond ((and (null module) (geiser-plt--explicit-module))) + ((null module) (buffer-file-name)) + (t module))) + + +;;; Trying to ascertain whether a buffer is mzscheme scheme: + +(defun geiser-plt-guess () + (or (save-excursion + (goto-char (point-min)) + (re-search-forward "#lang " nil t)) + (geiser-plt--explicit-module) + (string-equal (file-name-extension (buffer-file-name)) "ss"))) + + +;;; Emacs tweaks for PLT scheme code: + +(put 'begin0 'scheme-indent-function 1) +(put 'c-declare 'scheme-indent-function 0) +(put 'c-lambda 'scheme-indent-function 2) +(put 'case-lambda 'scheme-indent-function 0) +(put 'catch 'scheme-indent-function 1) +(put 'chicken-setup 'scheme-indent-function 1) +(put 'class 'scheme-indent-function 'defun) +(put 'class* 'scheme-indent-function 'defun) +(put 'compound-unit/sig 'scheme-indent-function 0) +(put 'dynamic-wind 'scheme-indent-function 0) +(put 'for/fold 'scheme-indent-function 2) +(put 'instantiate 'scheme-indent-function 2) +(put 'interface 'scheme-indent-function 1) +(put 'lambda/kw 'scheme-indent-function 1) +(put 'let*-values 'scheme-indent-function 1) +(put 'let+ 'scheme-indent-function 1) +(put 'let-values 'scheme-indent-function 1) +(put 'let/ec 'scheme-indent-function 1) +(put 'mixin 'scheme-indent-function 2) +(put 'module 'scheme-indent-function 'defun) +(put 'opt-lambda 'scheme-indent-function 1) +(put 'parameterize 'scheme-indent-function 1) +(put 'parameterize-break 'scheme-indent-function 1) +(put 'parameterize* 'scheme-indent-function 1) +(put 'quasisyntax/loc 'scheme-indent-function 1) +(put 'receive 'scheme-indent-function 2) +(put 'send* 'scheme-indent-function 1) +(put 'sigaction 'scheme-indent-function 1) +(put 'syntax-case 'scheme-indent-function 2) +(put 'syntax/loc 'scheme-indent-function 1) +(put 'unit 'scheme-indent-function 'defun) +(put 'unit/sig 'scheme-indent-function 2) +(put 'unless 'scheme-indent-function 1) +(put 'when 'scheme-indent-function 1) +(put 'while 'scheme-indent-function 1) +(put 'with-handlers 'scheme-indent-function 1) +(put 'with-method 'scheme-indent-function 1) +(put 'with-syntax 'scheme-indent-function 1) + + +;;; Register this implementation: + +(geiser-impl--register 'plt) + + +(provide 'geiser-plt) +;;; geiser-plt.el ends here diff --git a/elisp/geiser.el b/elisp/geiser.el index 6559b95..4ccc1e1 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -79,7 +79,7 @@ geiser-faces geiser-mode geiser-guile - geiser-larceny)) + geiser-plt)) ;;; Scheme mode setup: |