diff options
| -rw-r--r-- | elisp/geiser-chez.el | 157 | ||||
| -rw-r--r-- | scheme/chez/geiser/geiser.ss | 62 |
2 files changed, 219 insertions, 0 deletions
diff --git a/elisp/geiser-chez.el b/elisp/geiser-chez.el new file mode 100644 index 0000000..f75ba2d --- /dev/null +++ b/elisp/geiser-chez.el @@ -0,0 +1,157 @@ +;; geiser-chez.el -- Chez Scheme's implementation of the geiser protocols + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. + +(require 'geiser-connection) +(require 'geiser-syntax) +(require 'geiser-custom) +(require 'geiser-base) +(require 'geiser-eval) +(require 'geiser-edit) +(require 'geiser-log) +(require 'geiser) + +(require 'compile) +(require 'info-look) + +(eval-when-compile (require 'cl)) + + +;;; Customization: + +(defgroup geiser-chez nil + "Customization for Geiser's Chez Scheme flavour." + :group 'geiser) + +(geiser-custom--defcustom geiser-chez-binary + "chez-scheme" + "Name to use to call the Chez Scheme executable when starting a REPL." + :type '(choice string (repeat string)) + :group 'geiser-chez) + + +;;; REPL support: + +(defun geiser-chez--binary () + (if (listp geiser-chez-binary) + (car geiser-chez-binary) + geiser-chez-binary)) + +(defun geiser-chez--parameters () + "Return a list with all parameters needed to start Chez Scheme. +This function uses `geiser-chez-init-file' if it exists." +;; `("--load" ,(expand-file-name "chez/geiser/load.scm" geiser-scheme-dir)) + `(,(expand-file-name "chez/geiser/geiser.ss" geiser-scheme-dir)) + ) + +(defconst geiser-chez--prompt-regexp "> ") + + +;;; Evaluation support: + +(defun geiser-chez--geiser-procedure (proc &rest args) + (case proc + ((eval compile) + (let ((form (mapconcat 'identity (cdr args) " ")) + (module (cond ((string-equal "'()" (car args)) + "'()") + ((and (car args)) + (concat "'" (car args))) + (t + "#f")))) + (format "(geiser:eval %s '%s)" module form))) + ((load-file compile-file) + (format "(geiser:load-file %s)" (car args))) + ((no-values) + "(geiser:no-values)") + (t + (let ((form (mapconcat 'identity args " "))) + (format "(geiser:%s %s)" proc form))))) + +;; (defconst geiser-chez--module-re +;; ".*;; package: +\\(([^)]*)\\)") + +(defun geiser-chez--get-module (&optional module) + (cond ((null module) + :f) + ((listp module) module) + ((stringp module) + (condition-case nil + (car (geiser-syntax--read-from-string module)) + (error :f))) + (t :f))) + +;; (defun geiser-chez--module-cmd (module fmt &optional def) +;; (when module +;; (let* ((module (geiser-chez--get-module module)) +;; (module (cond ((or (null module) (eq module :f)) def) +;; (t (format "%s" module))))) +;; (and module (format fmt module))))) + +;; (defun geiser-chez--enter-command (module) +;; (geiser-chez--module-cmd module "(geiser:ge '%s)" "()")) + +(defun geiser-chez--symbol-begin (module) + (if module + (max (save-excursion (beginning-of-line) (point)) + (save-excursion (skip-syntax-backward "^(>") (1- (point)))) + (save-excursion (skip-syntax-backward "^'-()>") (point)))) + +(defun geiser-chez--import-command (module) + (format "(import %s)" module)) + +(defun geiser-chez--exit-command () "(exit 0)") +;; +;; ;;; REPL startup + +(defconst geiser-chez-minimum-version "9.4") + +(defun geiser-chez--version (binary) + (shell-command-to-string + (format "%s --version" + (shell-quote-argument binary)))) + +;; (defconst geiser-chez--path-rx "^In \\([^:\n ]+\\):\n") +(defun geiser-chez--startup (remote) + (let ((geiser-log-verbose-p t)) + (compilation-setup t) + ;; (when (and (stringp geiser-chez-source-directory) + ;; (not (string-empty-p geiser-chez-source-directory))) + ;; (geiser-eval--send/wait (format "(geiser:set-chez-scheme-source-directory %S)" geiser-chez-source-directory))) + (geiser-eval--send/wait "(begin (import (geiser)) (write `((result ) (output . \"\"))) (newline))"))) + +;;; Implementation definition: + +(define-geiser-implementation chez + (binary geiser-chez--binary) + (arglist geiser-chez--parameters) + (version-command geiser-chez--version) + (minimum-version geiser-chez-minimum-version) + (repl-startup geiser-chez--startup) + (prompt-regexp geiser-chez--prompt-regexp) + (debugger-prompt-regexp nil) ;; geiser-chez--debugger-prompt-regexp + ;; (enter-debugger geiser-chez--enter-debugger) + (marshall-procedure geiser-chez--geiser-procedure) + (find-module geiser-chez--get-module) + ;; (enter-command geiser-chez--enter-command) + (exit-command geiser-chez--exit-command) + (import-command geiser-chez--import-command) + (find-symbol-begin geiser-chez--symbol-begin) + ;; (display-error geiser-chez--display-error) + ;; (external-help geiser-chez--manual-look-up) + ;; (check-buffer geiser-chez--guess) + ;; (keywords geiser-chez--keywords) + ;; (case-sensitive geiser-chez-case-sensitive-p) + ) + +;; notes: (available-modules) in (chez modules) +;; (env-exports (module-env (find-module '(scheme char)))), modules: (meta) (chez modules) (chez) + +(geiser-impl--add-to-alist 'regexp "\\.ss$" 'chez t) +(geiser-impl--add-to-alist 'regexp "\\.def$" 'chez t) + +(provide 'geiser-chez) + diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss new file mode 100644 index 0000000..3dbed7f --- /dev/null +++ b/scheme/chez/geiser/geiser.ss @@ -0,0 +1,62 @@ +(library (geiser) + (export geiser:eval + geiser:completions + geiser:module-completions + geiser:autodoc + geiser:no-values + geiser:newline) + (import (chezscheme)) + + (define string-prefix? + (lambda (x y) + (let ([n (string-length x)]) + (and (fx<= n (string-length y)) + (let prefix? ([i 0]) + (or (fx= i n) + (and (char=? (string-ref x i) (string-ref y i)) + (prefix? (fx+ i 1))))))))) + + (define (geiser:completions prefix . rest) + rest + (sort string-ci<? + (filter (lambda (el) + (string-prefix? prefix el)) + (map write-to-string (environment-symbols (interaction-environment)))))) + + (define (write-to-string x) + (with-output-to-string + (lambda () + (write x)))) + + (define (geiser:eval module form . rest) + rest + (let ((result (if module + (eval form (environment module)) + (eval form)))) + (write `((result ,(write-to-string result)) + (output . ""))) + (newline))) + + (define (geiser:module-completions prefix . rest) + (define (substring? s1 s2) + (let ([n1 (string-length s1)] [n2 (string-length s2)]) + (let loop2 ([i2 0]) + (let loop1 ([i1 0] [j i2]) + (if (fx= i1 n1) + i2 + (and (not (fx= j n2)) + (if (char=? (string-ref s1 i1) (string-ref s2 j)) + (loop1 (fx+ i1 1) (fx+ j 1)) + (loop2 (fx+ i2 1))))))))) + (filter (lambda (el) + (substring? prefix el)) + (map write-to-string (library-list)))) + + (define (geiser:autodoc ids . rest) + '()) + + (define (geiser:no-values) + #f) + + (define (geiser:newline) + #f)) |