elisp/geiser-chibi.el

   1 ;;; geiser-chibi.el -- Chibi 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 \f
   9 ;;; Code:
  10
  11 (require 'geiser-connection)
  12 (require 'geiser-syntax)
  13 (require 'geiser-custom)
  14 (require 'geiser-base)
  15 (require 'geiser-eval)
  16 (require 'geiser-edit)
  17 (require 'geiser-log)
  18 (require 'geiser)
  19
  20 (require 'compile)
  21 (require 'info-look)
  22
  23 (eval-when-compile (require 'cl-lib))
  24
  25 \f
  26 ;;; Customization:
  27
  28 (defgroup geiser-chibi nil
  29   "Customization for Geiser's Chibi Scheme flavour."
  30   :group 'geiser)
  31
  32 (geiser-custom--defcustom geiser-chibi-binary
  33     "chibi-scheme"
  34   "Name to use to call the Chibi Scheme executable when starting a REPL."
  35   :type '(choice string (repeat string))
  36   :group 'geiser-chibi)
  37
  38 (geiser-custom--defcustom geiser-chibi-extra-command-line-parameters
  39     '("-R" "-m" "chibi ast")
  40   "Additional parameters to supply to the Chibi binary."
  41   :type '(repeat string)
  42   :group 'geiser-chibi)
  43
  44
  45 \f
  46 ;;; REPL support:
  47
  48 (defun geiser-chibi--binary ()
  49   (if (listp geiser-chibi-binary)
  50       (car geiser-chibi-binary)
  51     geiser-chibi-binary))
  52
  53 (defun geiser-chibi--parameters ()
  54   "Return a list with all parameters needed to start Chibi Scheme.
  55 This function uses `geiser-chibi-init-file' if it exists."
  56   `(,@geiser-chibi-extra-command-line-parameters
  57     "-I" ,(expand-file-name "chibi/geiser/" geiser-scheme-dir)
  58     "-m" "geiser"
  59     ,@(and (listp geiser-chibi-binary) (cdr geiser-chibi-binary)))
  60   )
  61
  62 (defconst geiser-chibi--prompt-regexp "> ")
  63
  64 \f
  65 ;;; Evaluation support:
  66
  67 (defun geiser-chibi--geiser-procedure (proc &rest args)
  68   (cl-case proc
  69     ((eval compile)
  70      (let ((form (mapconcat 'identity (cdr args) " "))
  71            (module (cond ((string-equal "'()" (car args))
  72                           "'()")
  73                          ((and (car args))
  74                           (concat "'" (car args)))
  75                          (t
  76                           "#f"))))
  77        (format "(geiser:eval %s '%s)" module form)))
  78     ((load-file compile-file)
  79      (format "(geiser:load-file %s)" (car args)))
  80     ((no-values)
  81      "(geiser:no-values)")
  82     (t
  83      (let ((form (mapconcat 'identity args " ")))
  84        (format "(geiser:%s %s)" proc form)))))
  85
  86 (defun geiser-chibi--get-module (&optional module)
  87   (cond ((null module)  :f)
  88         ((listp module) module)
  89         ((stringp module)
  90          (condition-case nil
  91              (car (geiser-syntax--read-from-string module))
  92            (error :f)))
  93         (t :f)))
  94
  95 (defun geiser-chibi--symbol-begin (module)
  96   (if module
  97       (max (save-excursion (beginning-of-line) (point))
  98            (save-excursion (skip-syntax-backward "^(>") (1- (point))))
  99     (save-excursion (skip-syntax-backward "^'-()>") (point))))
 100
 101 (defun geiser-chibi--import-command (module)
 102   (format "(import %s)" module))
 103
 104 (defun geiser-chibi--exit-command () "(exit 0)")
 105
 106 ;; \f
 107
 108 ;; ;;; REPL startup
 109
 110 (defconst geiser-chibi-minimum-version "0.7.3")
 111
 112 (defun geiser-chibi--version (binary)
 113   (cadr (split-string
 114          (car (process-lines binary "-V"))
 115          " ")))
 116
 117 (defun geiser-chibi--startup (remote)
 118   (let ((geiser-log-verbose-p t))
 119     (compilation-setup t)
 120     ))
 121 \f
 122 ;;; Implementation definition:
 123
 124 (define-geiser-implementation chibi
 125   (binary geiser-chibi--binary)
 126   (arglist geiser-chibi--parameters)
 127   (version-command geiser-chibi--version)
 128   (minimum-version geiser-chibi-minimum-version)
 129   (repl-startup geiser-chibi--startup)
 130   (prompt-regexp geiser-chibi--prompt-regexp)
 131   (debugger-prompt-regexp nil) ;; geiser-chibi--debugger-prompt-regexp
 132   ;; (enter-debugger geiser-chibi--enter-debugger)
 133   (marshall-procedure geiser-chibi--geiser-procedure)
 134   (find-module geiser-chibi--get-module)
 135   ;; (enter-command geiser-chibi--enter-command)
 136   (exit-command geiser-chibi--exit-command)
 137   (import-command geiser-chibi--import-command)
 138   (find-symbol-begin geiser-chibi--symbol-begin)
 139   ;; (display-error geiser-chibi--display-error)
 140   ;; (external-help geiser-chibi--manual-look-up)
 141   ;; (check-buffer geiser-chibi--guess)
 142   ;; (keywords geiser-chibi--keywords)
 143   ;; (case-sensitive geiser-chibi-case-sensitive-p)
 144   )
 145
 146 (geiser-impl--add-to-alist 'regexp "\\.scm$" 'chibi t)
 147 (geiser-impl--add-to-alist 'regexp "\\.sld$" 'chibi t)
 148 \f
 149 (provide 'geiser-chibi)