emacs/gds-server.el

   1 ;;; gds-server.el -- infrastructure for running GDS server processes
   2
   3 ;;;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free
  17 ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 ;;;; 02111-1307 USA
  19
  20
  21 ;;;; Customization group setup.
  22
  23 (defgroup gds nil
  24   "Customization options for Guile Emacs frontend."
  25   :group 'scheme)
  26
  27
  28 ;;;; Communication with the (ice-9 gds-server) subprocess.
  29
  30 ;; Subprocess output goes into the `*GDS Process*' buffer, and
  31 ;; is then read from there one form at a time.  `gds-read-cursor' is
  32 ;; the buffer position of the start of the next unread form.
  33 (defvar gds-read-cursor nil)
  34
  35 ;; The guile executable used by the GDS server process.
  36 (defcustom gds-guile-program "guile"
  37   "*The guile executable used by the GDS server process."
  38   :type 'string
  39   :group 'gds)
  40
  41 (defcustom gds-scheme-directory nil
  42   "Where GDS's Scheme code is, if not in one of the standard places."
  43   :group 'gds
  44   :type '(choice (const :tag "nil" nil) directory))
  45
  46 (defun gds-start-server (procname unix-socket-name tcp-port protocol-handler)
  47   "Start a GDS server process called PROCNAME, listening on Unix
  48 domain socket UNIX-SOCKET-NAME and TCP port number TCP-PORT.
  49 PROTOCOL-HANDLER should be a function that accepts and processes
  50 one protocol form."
  51   (with-current-buffer (get-buffer-create procname)
  52     (erase-buffer)
  53     (let* ((code (format "(begin
  54                             %s
  55                             (use-modules (ice-9 gds-server))
  56                             (run-server %S %S))"
  57                          (if gds-scheme-directory
  58                              (concat "(set! %load-path (cons "
  59                                      (format "%S" gds-scheme-directory)
  60                                      " %load-path))")
  61                            "")
  62                          unix-socket-name
  63                          tcp-port))
  64            (process-connection-type nil) ; use a pipe
  65            (proc (start-process procname
  66                                 (current-buffer)
  67                                 gds-guile-program
  68                                 "-q"
  69                                 "--debug"
  70                                 "-c"
  71                                 code)))
  72       (set (make-local-variable 'gds-read-cursor) (point-min))
  73       (set (make-local-variable 'gds-protocol-handler) protocol-handler)
  74       (set-process-filter proc (function gds-filter))
  75       (set-process-sentinel proc (function gds-sentinel))
  76       (set-process-coding-system proc 'latin-1-unix)
  77       (process-kill-without-query proc)
  78       proc)))
  79
  80 ;; Subprocess output filter: inserts normally into the process buffer,
  81 ;; then tries to reread the output one form at a time and delegates
  82 ;; processing of each form to `gds-protocol-handler'.
  83 (defun gds-filter (proc string)
  84   (with-current-buffer (process-buffer proc)
  85     (save-excursion
  86       (goto-char (process-mark proc))
  87       (insert-before-markers string))
  88     (goto-char gds-read-cursor)
  89     (while (let ((form (condition-case nil
  90                            (read (current-buffer))
  91                          (error nil))))
  92              (if form
  93                  (save-excursion
  94                    (funcall gds-protocol-handler (car form) (cdr form))))
  95              form)
  96       (setq gds-read-cursor (point)))))
  97
  98 ;; Subprocess sentinel: do nothing.  (Currently just here to avoid
  99 ;; inserting un-`read'able process status messages into the process
 100 ;; buffer.)
 101 (defun gds-sentinel (proc event)
 102   )
 103
 104
 105 ;;;; The end!
 106
 107 (provide 'gds-server)
 108
 109 ;;; gds-server.el ends here.