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