diff options
author | Andy Wingo <wingo@pobox.com> | 2019-10-21 17:23:45 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2019-10-21 17:34:50 +0200 |
commit | 40395c0dff238b62ba312e623a70c7f4b015507d (patch) | |
tree | 2611624d0300f54bebf793271df60ed4bcfeb021 | |
parent | f152d7cd961aa1637e6e71e99141ec0617e6f1ed (diff) | |
download | guile-40395c0dff238b62ba312e623a70c7f4b015507d.tar.gz |
Remove (ice-9 channel)
* module/ice-9/channel.scm: Remove. This file has had a bug since
2.0 or so that prevented loading the module; I can only conclude that
it hasn't worked for years.
* module/Makefile.am (SOURCES): Remove ice-9/channel.scm.
-rw-r--r-- | module/Makefile.am | 1 | ||||
-rw-r--r-- | module/ice-9/channel.scm | 170 |
2 files changed, 0 insertions, 171 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index fe316758a..79f42d353 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -49,7 +49,6 @@ SOURCES = \ ice-9/boot-9.scm \ ice-9/buffered-input.scm \ ice-9/calling.scm \ - ice-9/channel.scm \ ice-9/command-line.scm \ ice-9/common-list.scm \ ice-9/control.scm \ diff --git a/module/ice-9/channel.scm b/module/ice-9/channel.scm deleted file mode 100644 index 9c237f5b0..000000000 --- a/module/ice-9/channel.scm +++ /dev/null @@ -1,170 +0,0 @@ -;;; Guile object channel - -;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc. - -;;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -;;; Commentary: - -;; Now you can use Guile's modules in Emacs Lisp like this: -;; -;; (guile-import current-module) -;; (guile-import module-ref) -;; -;; (setq assq (module-ref (current-module) 'assq)) -;; => ("<guile>" %%1%% . "#<primitive-procedure assq>") -;; -;; (guile-use-modules (ice-9 documentation)) -;; -;; (object-documentation assq) -;; => -;; " - primitive: assq key alist -;; - primitive: assv key alist -;; - primitive: assoc key alist -;; Fetches the entry in ALIST that is associated with KEY. To decide -;; whether the argument KEY matches a particular entry in ALIST, -;; `assq' compares keys with `eq?', `assv' uses `eqv?' and `assoc' -;; uses `equal?'. If KEY cannot be found in ALIST (according to -;; whichever equality predicate is in use), then `#f' is returned. -;; These functions return the entire alist entry found (i.e. both the -;; key and the value)." -;; -;; Probably we can use GTK in Emacs Lisp. Can anybody try it? -;; -;; I have also implemented Guile Scheme mode and Scheme Interaction mode. -;; Just put the following lines in your ~/.emacs: -;; -;; (require 'guile-scheme) -;; (setq initial-major-mode 'scheme-interaction-mode) -;; -;; Currently, the following commands are available: -;; -;; M-TAB guile-scheme-complete-symbol -;; M-C-x guile-scheme-eval-define -;; C-x C-e guile-scheme-eval-last-sexp -;; C-c C-b guile-scheme-eval-buffer -;; C-c C-r guile-scheme-eval-region -;; C-c : guile-scheme-eval-expression -;; -;; I'll write more commands soon, or if you want to hack, please take -;; a look at the following files: -;; -;; guile-core/ice-9/channel.scm ;; object channel -;; guile-core/emacs/guile.el ;; object adapter -;; guile-core/emacs/guile-emacs.scm ;; Guile <-> Emacs channels -;; guile-core/emacs/guile-scheme.el ;; Guile Scheme mode -;; -;; As always, there are more than one bugs ;) - -;;; Code: - -(define-module (ice-9 channel) - :export (make-object-channel - channel-open - channel-print-value - channel-print-token)) - -;;; -;;; Channel type -;;; - -(define channel-type - (make-record-type 'channel '(stdin stdout printer token-module))) - -(define make-channel (record-constructor channel-type)) - -(define (make-object-channel printer) - (make-channel (current-input-port) - (current-output-port) - printer - (make-module))) - -(define channel-stdin (record-accessor channel-type 'stdin)) -(define channel-stdout (record-accessor channel-type 'stdout)) -(define channel-printer (record-accessor channel-type 'printer)) -(define channel-token-module (record-accessor channel-type 'token-module)) - -;;; -;;; Channel -;;; - -(define (channel-open ch) - (let ((stdin (channel-stdin ch)) - (stdout (channel-stdout ch)) - (printer (channel-printer ch)) - (token-module (channel-token-module ch))) - (let loop () - (catch #t - (lambda () - (channel:prompt stdout) - (let ((cmd (read stdin))) - (if (eof-object? cmd) - (throw 'quit) - (case cmd - ((eval) - (module-use! (current-module) token-module) - (printer ch (eval (read stdin) (current-module)))) - ((destroy) - (let ((token (read stdin))) - (if (module-defined? token-module token) - (module-remove! token-module token) - (channel:error stdout "Invalid token: ~S" token)))) - ((quit) - (throw 'quit)) - (else - (channel:error stdout "Unknown command: ~S" cmd))))) - (loop)) - (lambda (key . args) - (case key - ((quit) (throw 'quit)) - (else - (format stdout "exception = ~S\n" - (list key (apply format #f (cadr args) (caddr args)))) - (loop)))))))) - -(define (channel-print-value ch val) - (format (channel-stdout ch) "value = ~S\n" val)) - -(define (channel-print-token ch val) - (let* ((token (symbol-append (gensym "%%") '%%)) - (pair (cons token (object->string val)))) - (format (channel-stdout ch) "token = ~S\n" pair) - (module-define! (channel-token-module ch) token val))) - -(define (channel:prompt port) - (display "channel> " port) - (force-output port)) - -(define (channel:error port msg . args) - (display "ERROR: " port) - (apply format port msg args) - (newline port)) - -;;; -;;; Guile 1.4 compatibility -;;; - -(define guile:eval eval) -(define eval - (if (= (car (procedure-minimum-arity guile:eval)) 1) - (lambda (x e) (guile:eval x e)) - guile:eval)) - -(define object->string - (if (defined? 'object->string) - object->string - (lambda (x) (format #f "~S" x)))) - -;;; channel.scm ends here |