elisp/geiser-chez.el

   1 ;; geiser-chez.el -- Chez Scheme's implementation of the geiser protocols
   2
   3 ;; This program is free software; you can redistribute it and/or
   4 ;; modify it under the terms of the Modified BSD License. You should
   5 ;; have received a copy of the license along with this program. If
   6 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
   7
   8 (require 'geiser-connection)
   9 (require 'geiser-syntax)
  10 (require 'geiser-custom)
  11 (require 'geiser-base)
  12 (require 'geiser-eval)
  13 (require 'geiser-edit)
  14 (require 'geiser-log)
  15 (require 'geiser)
  16
  17 (require 'compile)
  18 (require 'info-look)
  19
  20 (eval-when-compile (require 'cl))
  21
  22 \f
  23 ;;; Customization:
  24
  25 (defgroup geiser-chez nil
  26   "Customization for Geiser's Chez Scheme flavour."
  27   :group 'geiser)
  28
  29 (geiser-custom--defcustom geiser-chez-binary
  30     "scheme"
  31   "Name to use to call the Chez Scheme executable when starting a REPL."
  32   :type '(choice string (repeat string))
  33   :group 'geiser-chez)
  34
  35 \f
  36 ;;; REPL support:
  37
  38 (defun geiser-chez--binary ()
  39   (if (listp geiser-chez-binary)
  40       (car geiser-chez-binary)
  41     geiser-chez-binary))
  42
  43 (defun geiser-chez--parameters ()
  44   "Return a list with all parameters needed to start Chez Scheme.
  45 This function uses `geiser-chez-init-file' if it exists."
  46   `(,(expand-file-name "chez/geiser/geiser.ss" geiser-scheme-dir))
  47   )
  48
  49 (defconst geiser-chez--prompt-regexp "> ")
  50
  51 \f
  52 ;;; Evaluation support:
  53
  54 (defun geiser-chez--geiser-procedure (proc &rest args)
  55   (case proc
  56     ((eval compile)
  57      (let ((form (mapconcat 'identity (cdr args) " "))
  58            (module (cond ((string-equal "'()" (car args))
  59                           "'()")
  60                          ((and (car args))
  61                              (concat "'" (car args)))
  62                          (t
  63                           "#f"))))
  64        (format "(geiser:eval %s '%s)" module form)))
  65     ((load-file compile-file)
  66      (format "(geiser:load-file %s)" (car args)))
  67     ((no-values)
  68      "(geiser:no-values)")
  69     (t
  70      (let ((form (mapconcat 'identity args " ")))
  71        (format "(geiser:%s %s)" proc form)))))
  72
  73 (defun geiser-chez--get-module (&optional module)
  74   (cond ((null module)
  75          :f)
  76         ((listp module) module)
  77         ((stringp module)
  78          (condition-case nil
  79              (car (geiser-syntax--read-from-string module))
  80            (error :f)))
  81         (t :f)))
  82
  83 (defun geiser-chez--symbol-begin (module)
  84   (if module
  85       (max (save-excursion (beginning-of-line) (point))
  86            (save-excursion (skip-syntax-backward "^(>") (1- (point))))
  87     (save-excursion (skip-syntax-backward "^'-()>") (point))))
  88
  89 (defun geiser-chez--import-command (module)
  90   (format "(import %s)" module))
  91
  92 (defun geiser-chez--exit-command () "(exit 0)")
  93 ;; \f
  94 ;; ;;; REPL startup
  95
  96 (defconst geiser-chez-minimum-version "9.4")
  97
  98 (defun geiser-chez--version (binary)
  99   (car (process-lines binary "--version")))
 100
 101 (defun geiser-chez--startup (remote)
 102   (let ((geiser-log-verbose-p t))
 103     (compilation-setup t)
 104     (geiser-eval--send/wait "(begin (import (geiser)) (write `((result ) (output . \"\"))) (newline))")))
 105
 106 (defun geiser-chez--display-error (module key msg)
 107   (and key (message msg) nil))
 108 \f
 109 ;;; Implementation definition:
 110
 111 (define-geiser-implementation chez
 112   (binary geiser-chez--binary)
 113   (arglist geiser-chez--parameters)
 114   (version-command geiser-chez--version)
 115   (minimum-version geiser-chez-minimum-version)
 116   (repl-startup geiser-chez--startup)
 117   (prompt-regexp geiser-chez--prompt-regexp)
 118   (debugger-prompt-regexp nil) ;; geiser-chez--debugger-prompt-regexp
 119   ;; (enter-debugger geiser-chez--enter-debugger)
 120   (marshall-procedure geiser-chez--geiser-procedure)
 121   (find-module geiser-chez--get-module)
 122   ;; (enter-command geiser-chez--enter-command)
 123   (exit-command geiser-chez--exit-command)
 124   (import-command geiser-chez--import-command)
 125   (find-symbol-begin geiser-chez--symbol-begin)
 126   (display-error geiser-chez--display-error)
 127   ;; (external-help geiser-chez--manual-look-up)
 128   ;; (check-buffer geiser-chez--guess)
 129   ;; (keywords geiser-chez--keywords)
 130   ;; (case-sensitive geiser-chez-case-sensitive-p)
 131   )
 132
 133 (geiser-impl--add-to-alist 'regexp "\\.ss$" 'chez t)
 134 (geiser-impl--add-to-alist 'regexp "\\.def$" 'chez t)
 135 \f
 136 (provide 'geiser-chez)