eval-when

[bpt/guile.git] / emacs / guile.el

diff --git a/emacs/guile.el b/emacs/guile.el
index 3bf1463..25a9b9b 100644 (file)
--- a/emacs/guile.el
+++ b/emacs/guile.el
@@ -2,20 +2,20 @@
 
 ;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
 
 ;;; Code:
 
@@ -25,7 +25,7 @@
 ;;; Low level interface
 ;;;
 
-(defvar gulie-emacs-file
+(defvar guile-emacs-file
   (catch 'return
     (mapc (lambda (dir)
            (let ((file (expand-file-name "guile-emacs.scm" dir)))
@@ -33,21 +33,22 @@
          load-path)
     (error "Cannot find guile-emacs.scm")))
 
-(defvar gulie-channel-file
+(defvar guile-channel-file
   (catch 'return
     (mapc (lambda (dir)
            (let ((file (expand-file-name "channel.scm" dir)))
              (if (file-exists-p file) (throw 'return file))))
-         load-path)))
+         load-path)
+    (error "Cannot find channel.scm")))
 
 (defvar guile-libs
-  (nconc (if gulie-channel-file (list "-l" gulie-channel-file) '())
-        (list "-l" gulie-emacs-file)))
+  (nconc (if guile-channel-file (list "-l" guile-channel-file) '())
+        (list "-l" guile-emacs-file)))
 
 ;;;###autoload
 (defun guile:make-adapter (command channel)
   (let* ((buff (generate-new-buffer " *guile object channel*"))
-        (libs (if gulie-channel-file (list "-l" gulie-channel-file) nil))
+        (libs (if guile-channel-file (list "-l" guile-channel-file) nil))
         (proc (apply 'start-process "guile-oa" buff command "-q" guile-libs)))
     (process-kill-without-query proc)
     (accept-process-output proc)
@@ -63,26 +64,30 @@
 
 ;;;###autoload
 (defun guile:eval (string adapter)
-  (let ((output (guile-process-require adapter (concat "eval " string "\n")
-                                      "channel> ")))
-    (cond
-     ((string= output "") nil)
-     ((string-match "^\\(\\(value\\)\\|\\(token\\)\\|\\(exception\\)\\) = "
-                   output)
-      (cond
-       ;; value
-       ((match-beginning 2)
-       (car (read-from-string (substring output (match-end 0)))))
-       ;; token
-       ((match-beginning 3)
-       (cons guile-token-tag
-             (car (read-from-string (substring output (match-end 0))))))
-       ;; exception
-       ((match-beginning 4)
-       (signal 'guile-error
-               (car (read-from-string (substring output (match-end 0))))))))
-     (t
-      (error "Unsupported result" output)))))
+  (condition-case error
+      (let ((output (guile-process-require adapter (concat "eval " string "\n")
+                                          "channel> ")))
+       (cond
+        ((string= output "") nil)
+        ((string-match "^\\(\\(value\\)\\|\\(token\\)\\|\\(exception\\)\\) = "
+                       output)
+         (cond
+          ;; value
+          ((match-beginning 2)
+           (car (read-from-string (substring output (match-end 0)))))
+          ;; token
+          ((match-beginning 3)
+           (cons guile-token-tag
+                 (car (read-from-string (substring output (match-end 0))))))
+          ;; exception
+          ((match-beginning 4)
+           (signal 'guile-error
+                   (car (read-from-string (substring output (match-end 0))))))))
+        (t
+         (error "Unsupported result" output))))
+    (quit
+     (signal-process (process-id adapter) 'SIGINT)
+     (signal 'quit nil))))
 
 \f
 ;;;
@@ -95,6 +100,9 @@
 (defvar true "#t")
 (defvar false "#f")
 
+(unless (boundp 'keywordp)
+  (defun keywordp (x) (and (symbolp x) (eq (aref (symbol-name x) 0) ?:))))
+
 (defun guile-lisp-adapter ()
   (if (and (processp guile-lisp-adapter)
           (eq (process-status guile-lisp-adapter) 'run))
@@ -134,11 +142,15 @@
        (docs (if (memq :with-docs opts) true false)))
     (eval (guile-lisp-eval `(guile-emacs-export ',name ',real ,docs)))))
 
+;;;###autoload
+(defmacro guile-use-module (name)
+  `(guile-lisp-eval '(use-modules ,name)))
+
 ;;;###autoload
 (defmacro guile-import-module (name &rest opts)
-  `(guile-process-use-module ',name ',opts))
+  `(guile-process-import-module ',name ',opts))
 
-(defun guile-process-use-module (name opts)
+(defun guile-process-import-module (name opts)
   (unless (boundp 'guile-emacs-export-procedures)
     (guile-import guile-emacs-export-procedures))
   (let ((docs (if (memq :with-docs opts) true false)))