1;;; Guile object channel 2 3;; Copyright (C) 2001, 2006 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 2.1 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 Software 17;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 19;;; Commentary: 20 21;; Now you can use Guile's modules in Emacs Lisp like this: 22;; 23;; (guile-import current-module) 24;; (guile-import module-ref) 25;; 26;; (setq assq (module-ref (current-module) 'assq)) 27;; => ("<guile>" %%1%% . "#<primitive-procedure assq>") 28;; 29;; (guile-use-modules (ice-9 documentation)) 30;; 31;; (object-documentation assq) 32;; => 33;; " - primitive: assq key alist 34;; - primitive: assv key alist 35;; - primitive: assoc key alist 36;; Fetches the entry in ALIST that is associated with KEY. To decide 37;; whether the argument KEY matches a particular entry in ALIST, 38;; `assq' compares keys with `eq?', `assv' uses `eqv?' and `assoc' 39;; uses `equal?'. If KEY cannot be found in ALIST (according to 40;; whichever equality predicate is in use), then `#f' is returned. 41;; These functions return the entire alist entry found (i.e. both the 42;; key and the value)." 43;; 44;; Probably we can use GTK in Emacs Lisp. Can anybody try it? 45;; 46;; I have also implemented Guile Scheme mode and Scheme Interaction mode. 47;; Just put the following lines in your ~/.emacs: 48;; 49;; (require 'guile-scheme) 50;; (setq initial-major-mode 'scheme-interaction-mode) 51;; 52;; Currently, the following commands are available: 53;; 54;; M-TAB guile-scheme-complete-symbol 55;; M-C-x guile-scheme-eval-define 56;; C-x C-e guile-scheme-eval-last-sexp 57;; C-c C-b guile-scheme-eval-buffer 58;; C-c C-r guile-scheme-eval-region 59;; C-c : guile-scheme-eval-expression 60;; 61;; I'll write more commands soon, or if you want to hack, please take 62;; a look at the following files: 63;; 64;; guile-core/ice-9/channel.scm ;; object channel 65;; guile-core/emacs/guile.el ;; object adapter 66;; guile-core/emacs/guile-emacs.scm ;; Guile <-> Emacs channels 67;; guile-core/emacs/guile-scheme.el ;; Guile Scheme mode 68;; 69;; As always, there are more than one bugs ;) 70 71;;; Code: 72 73(define-module (ice-9 channel) 74 :export (make-object-channel 75 channel-open 76 channel-print-value 77 channel-print-token)) 78 79;;; 80;;; Channel type 81;;; 82 83(define channel-type 84 (make-record-type 'channel '(stdin stdout printer token-module))) 85 86(define make-channel (record-constructor channel-type)) 87 88(define (make-object-channel printer) 89 (make-channel (current-input-port) 90 (current-output-port) 91 printer 92 (make-module))) 93 94(define channel-stdin (record-accessor channel-type 'stdin)) 95(define channel-stdout (record-accessor channel-type 'stdout)) 96(define channel-printer (record-accessor channel-type 'printer)) 97(define channel-token-module (record-accessor channel-type 'token-module)) 98 99;;; 100;;; Channel 101;;; 102 103(define (channel-open ch) 104 (let ((stdin (channel-stdin ch)) 105 (stdout (channel-stdout ch)) 106 (printer (channel-printer ch)) 107 (token-module (channel-token-module ch))) 108 (let loop () 109 (catch #t 110 (lambda () 111 (channel:prompt stdout) 112 (let ((cmd (read stdin))) 113 (if (eof-object? cmd) 114 (throw 'quit) 115 (case cmd 116 ((eval) 117 (module-use! (current-module) token-module) 118 (printer ch (eval (read stdin) (current-module)))) 119 ((destroy) 120 (let ((token (read stdin))) 121 (if (module-defined? token-module token) 122 (module-remove! token-module token) 123 (channel:error stdout "Invalid token: ~S" token)))) 124 ((quit) 125 (throw 'quit)) 126 (else 127 (channel:error stdout "Unknown command: ~S" cmd))))) 128 (loop)) 129 (lambda (key . args) 130 (case key 131 ((quit) (throw 'quit)) 132 (else 133 (format stdout "exception = ~S\n" 134 (list key (apply format #f (cadr args) (caddr args)))) 135 (loop)))))))) 136 137(define (channel-print-value ch val) 138 (format (channel-stdout ch) "value = ~S\n" val)) 139 140(define (channel-print-token ch val) 141 (let* ((token (symbol-append (gensym "%%") '%%)) 142 (pair (cons token (object->string val)))) 143 (format (channel-stdout ch) "token = ~S\n" pair) 144 (module-define! (channel-token-module ch) token val))) 145 146(define (channel:prompt port) 147 (display "channel> " port) 148 (force-output port)) 149 150(define (channel:error port msg . args) 151 (display "ERROR: " port) 152 (apply format port msg args) 153 (newline port)) 154 155;;; 156;;; Guile 1.4 compatibility 157;;; 158 159(define guile:eval eval) 160(define eval 161 (if (= (car (procedure-property guile:eval 'arity)) 1) 162 (lambda (x e) (guile:eval x)) 163 guile:eval)) 164 165(define object->string 166 (if (defined? 'object->string) 167 object->string 168 (lambda (x) (format #f "~S" x)))) 169 170;;; channel.scm ends here 171