elisp/geiser-inf.el

   1 ;;; geiser-inf.el -- inferior scheme processes
   2
   3 ;; Copyright (c) 2010 Jose Antonio Ortega Ruiz
   4
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the Modified BSD License. You should
   7 ;; have received a copy of the license along with this program. If
   8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
   9
  10 ;; Start date: Thu Nov 11, 2010 01:04
  11 \f
  12
  13 (require 'geiser-impl)
  14 (require 'geiser-base)
  15
  16 (require 'cmuscheme)
  17
  18 \f
  19 ;; Implementation-dependent parameters
  20
  21 (geiser-impl--define-caller geiser-inf--binary binary ()
  22   "A variable or function returning the path to the scheme binary
  23 for this implementation.")
  24
  25 (geiser-impl--define-caller geiser-inf--arglist arglist ()
  26   "A function taking no arguments and returning a list of
  27 arguments to be used when invoking the scheme binary.")
  28
  29 (geiser-impl--define-caller geiser-inf--prompt-re inferior-prompt-regexp ()
  30   "A variable (or thunk returning a value) giving the regular
  31 expression for this implementation's inferior scheme prompt. By default,
  32 cmuscheme's prompt regexp will be used.")
  33
  34 (geiser-impl--define-caller geiser-inf--init-server-cmd init-server-command ()
  35   "A variable (or thunk returning a value) giving the REPL server
  36 initialization command for local processes. The command must return a
  37 list of the form (server PORT).")
  38
  39 \f
  40 ;; Auxiliary functions
  41
  42 (defun geiser-inf--wait-for-prompt (timeout)
  43   (let ((p (point)) (seen) (buffer (current-buffer)))
  44     (while (and (not seen)
  45                 (> timeout 0)
  46                 (get-buffer-process buffer))
  47       (sleep-for 0.1)
  48       (setq timeout (- timeout 100))
  49       (goto-char p)
  50       (setq seen (re-search-forward comint-prompt-regexp nil t)))
  51     (goto-char (point-max))
  52     (unless seen (error "%s" "No prompt found!"))))
  53
  54 (defun geiser-inf--make-buffer (impl)
  55   (with-current-buffer (generate-new-buffer (format " * inferior %s *" impl))
  56     (inferior-scheme-mode)
  57     (current-buffer)))
  58
  59 (defun geiser-inf--sentinel (proc evnt)
  60   (let ((buff (process-buffer proc)))
  61     (when (buffer-live-p buff) (kill-buffer buff))))
  62
  63 \f
  64 ;; Starting an inferior REPL
  65
  66 (defun geiser-inf--run-scheme (impl)
  67   (let ((bin (geiser-inf--binary impl))
  68         (args (geiser-inf--arglist impl))
  69         (prompt-rx (geiser-inf--prompt-re impl)))
  70     (unless (and bin args)
  71       (error "Sorry, I don't know how to start %s" impl))
  72     (with-current-buffer (geiser-inf--make-buffer impl)
  73       (when prompt-rx comint-prompt-regexp prompt-rx)
  74       (condition-case err
  75           (apply 'make-comint-in-buffer
  76              `(,(buffer-name) ,(current-buffer) ,bin nil ,@args))
  77         (error (error "Error starting inferior %s REPL: %s"
  78                       impl (error-message-string err))))
  79       (geiser-inf--wait-for-prompt 10000)
  80       (set-process-sentinel (get-buffer-process (current-buffer))
  81                             'geiser-inf--sentinel)
  82       (cons (current-buffer)
  83             (comint-redirect-results-list (geiser-inf--init-server-cmd impl)
  84                                           "(port \\([0-9]+\\))"
  85                                           1)))))
  86
  87 \f
  88 (provide 'geiser-inf)
  89