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