From fe2c79adce933b29e4bfcc6ca6f5c5e5546095a5 Mon Sep 17 00:00:00 2001 From: Peter Date: Tue, 26 Apr 2016 07:19:36 +0200 Subject: Add preliminary support for MIT/GNU Scheme. --- elisp/Makefile.am | 1 + elisp/geiser-mit.el | 162 ++++++++++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser.el | 7 +++ 3 files changed, 170 insertions(+) create mode 100644 elisp/geiser-mit.el (limited to 'elisp') diff --git a/elisp/Makefile.am b/elisp/Makefile.am index 085d716..011098e 100644 --- a/elisp/Makefile.am +++ b/elisp/Makefile.am @@ -18,6 +18,7 @@ dist_lisp_LISP = \ geiser-impl.el \ geiser-log.el \ geiser-menu.el \ + geiser-mit.el \ geiser-mode.el \ geiser-racket.el \ geiser-chicken.el \ diff --git a/elisp/geiser-mit.el b/elisp/geiser-mit.el new file mode 100644 index 0000000..f8f7de8 --- /dev/null +++ b/elisp/geiser-mit.el @@ -0,0 +1,162 @@ +;; geiser-mit.el -- MIT/GNU 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 . + +(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-mit nil + "Customization for Geiser's MIT/GNU Scheme flavour." + :group 'geiser) + +(geiser-custom--defcustom geiser-mit-binary + "mit-scheme" + "Name to use to call the MIT/GNU Scheme executable when starting a REPL." + :type '(choice string (repeat string)) + :group 'geiser-mit) + +(geiser-custom--defcustom geiser-mit-source-directory + "" + "The path to the MIT/GNU Scheme sources' src/ directory." + :type 'filename + :group 'geiser-mit) + + +;;; REPL support: + +(defun geiser-mit--binary () + (if (listp geiser-mit-binary) + (car geiser-mit-binary) + geiser-mit-binary)) + +(defun geiser-mit--parameters () + "Return a list with all parameters needed to start MIT/GNU Scheme. +This function uses `geiser-mit-init-file' if it exists." + `("--load" ,(expand-file-name "mit/geiser/load.scm" geiser-scheme-dir)) + ) + +(defconst geiser-mit--prompt-regexp "[0-9]+ ([^)]+) => ") ;; *not* ]=>, that confuses syntax-ppss +(defconst geiser-mit--debugger-prompt-regexp "[0-9]+ error> ") + + +;;; Evaluation support: + +(defun geiser-mit--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-mit--module-re + ".*;; package: +\\(([^)]*)\\)") + +(defun geiser-mit--get-module (&optional module) + (cond ((null module) + (save-excursion + (geiser-syntax--pop-to-top) + (if (or (re-search-backward geiser-mit--module-re nil t) + (re-search-forward geiser-mit--module-re nil t)) + (geiser-mit--get-module (match-string-no-properties 1)) + :f))) + ((listp module) module) + ((stringp module) + (condition-case nil + (car (geiser-syntax--read-from-string module)) + (error :f))) + (t :f))) + +(defun geiser-mit--module-cmd (module fmt &optional def) + (when module + (let* ((module (geiser-mit--get-module module)) + (module (cond ((or (null module) (eq module :f)) def) + (t (format "%s" module))))) + (and module (format fmt module))))) + +(defun geiser-mit--enter-command (module) + (geiser-mit--module-cmd module "(geiser:ge '%s)" "()")) + +(defun geiser-mit--exit-command () "(%exit 0)") + +(defun geiser-mit--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)))) + +;; +;; ;;; REPL startup + +(defconst geiser-mit-minimum-version "9.2.1") + +(defun geiser-mit--version (binary) + (shell-command-to-string + (format "%s --quiet --no-init-file --eval %s" + (shell-quote-argument binary) + "'(begin (display (get-subsystem-version-string \"Release\")) (%exit 0))'"))) + +(defconst geiser-mit--path-rx "^In \\([^:\n ]+\\):\n") +(defun geiser-mit--startup (remote) + (let ((geiser-log-verbose-p t)) + (compilation-setup t) + (when (and (stringp geiser-mit-source-directory) + (not (string-empty-p geiser-mit-source-directory))) + (geiser-eval--send/wait (format "(geiser:set-mit-scheme-source-directory %S)" geiser-mit-source-directory))))) + +;;; Implementation definition: + +(define-geiser-implementation mit + (binary geiser-mit--binary) + (arglist geiser-mit--parameters) + (version-command geiser-mit--version) + (minimum-version geiser-mit-minimum-version) + (repl-startup geiser-mit--startup) + (prompt-regexp geiser-mit--prompt-regexp) + (debugger-prompt-regexp geiser-mit--debugger-prompt-regexp) + ;; (enter-debugger geiser-mit--enter-debugger) + (marshall-procedure geiser-mit--geiser-procedure) + (find-module geiser-mit--get-module) + (enter-command geiser-mit--enter-command) + (exit-command geiser-mit--exit-command) + ;; (import-command geiser-mit--import-command) + (find-symbol-begin geiser-mit--symbol-begin) + ;; (display-error geiser-mit--display-error) + ;; (external-help geiser-mit--manual-look-up) + ;; (check-buffer geiser-mit--guess) + ;; (keywords geiser-mit--keywords) + ;; (case-sensitive geiser-mit-case-sensitive-p) + ) + +(geiser-impl--add-to-alist 'regexp "\\.scm$" 'mit t) +(geiser-impl--add-to-alist 'regexp "\\.pkg$" 'mit t) + +(provide 'geiser-mit) diff --git a/elisp/geiser.el b/elisp/geiser.el index 476b4ec..0ae9a43 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -96,6 +96,13 @@ (autoload 'connect-to-chicken "geiser-chicken" "Connect to a remote Geiser Chicken REPL." t) +;;;###autoload +(autoload 'run-mit "geiser-mit" "Start a Geiser MIT/GNU Scheme REPL." t) + +;;;###autoload +(autoload 'switch-to-mit "geiser-mit" + "Start a Geiser MIT/GNU Scheme REPL, or switch to a running one." t) + ;;;###autoload (autoload 'geiser-mode "geiser-mode" "Minor mode adding Geiser REPL interaction to Scheme buffers." t) -- cgit v1.2.3