;;; -*-Scheme-*-
;;;
-;;; $Id: artdebug.scm,v 1.27 1999/02/16 20:12:15 cph Exp $
+;;; $Id: artdebug.scm,v 1.28 1999/02/24 21:35:54 cph Exp $
;;;
;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology
;;;
(prompt-for-confirmation? prompt))
(define interface-port-type
- (make-output-port-type
+ (make-port-type
`((WRITE-CHAR ,operation/write-char)
(WRITE-SUBSTRING ,operation/write-substring)
(FRESH-LINE ,operation/fresh-line)
;;; -*-Scheme-*-
;;;
-;;;$Id: bufinp.scm,v 1.7 1999/02/18 04:14:41 cph Exp $
+;;;$Id: bufinp.scm,v 1.8 1999/02/24 21:35:46 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(buffer-input-port-state/current-index state)))))
(define buffer-input-port-type
- (make-input-port-type `((CHAR-READY? ,operation/char-ready?)
- (DISCARD-CHAR ,operation/discard-char)
- (DISCARD-CHARS ,operation/discard-chars)
- (PEEK-CHAR ,operation/peek-char)
- (PRINT-SELF ,operation/print-self)
- (READ-CHAR ,operation/read-char)
- (READ-STRING ,operation/read-string))
- #f))
\ No newline at end of file
+ (make-port-type `((CHAR-READY? ,operation/char-ready?)
+ (DISCARD-CHAR ,operation/discard-char)
+ (DISCARD-CHARS ,operation/discard-chars)
+ (PEEK-CHAR ,operation/peek-char)
+ (PRINT-SELF ,operation/print-self)
+ (READ-CHAR ,operation/read-char)
+ (READ-STRING ,operation/read-string))
+ #f))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: bufout.scm,v 1.12 1999/02/16 20:12:28 cph Exp $
+;;; $Id: bufout.scm,v 1.13 1999/02/24 21:35:39 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(mark-x-size (port/mark port)))
(define mark-output-port-type
- (make-output-port-type `((CLOSE ,operation/close)
- (FLUSH-OUTPUT ,operation/flush-output)
- (FRESH-LINE ,operation/fresh-line)
- (PRINT-SELF ,operation/print-self)
- (WRITE-CHAR ,operation/write-char)
- (WRITE-SUBSTRING ,operation/write-substring)
- (X-SIZE ,operation/x-size))
- #f))
\ No newline at end of file
+ (make-port-type `((CLOSE ,operation/close)
+ (FLUSH-OUTPUT ,operation/flush-output)
+ (FRESH-LINE ,operation/fresh-line)
+ (PRINT-SELF ,operation/print-self)
+ (WRITE-CHAR ,operation/write-char)
+ (WRITE-SUBSTRING ,operation/write-substring)
+ (X-SIZE ,operation/x-size))
+ #f))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: debug.scm,v 1.47 1999/02/16 20:12:04 cph Exp $
+;;; $Id: debug.scm,v 1.48 1999/02/24 21:36:02 cph Exp $
;;;
;;; Copyright (c) 1992-1999 Massachusetts Institute of Technology
;;;
(prompt-for-expression prompt))
(define interface-port-type
- (make-output-port-type
+ (make-port-type
`((WRITE-CHAR ,operation/write-char)
(PROMPT-FOR-CONFIRMATION ,operation/prompt-for-confirmation)
(PROMPT-FOR-EXPRESSION ,operation/prompt-for-expression))
;;; -*-Scheme-*-
;;;
-;;; $Id: intmod.scm,v 1.97 1999/02/18 04:05:22 cph Exp $
+;;; $Id: intmod.scm,v 1.98 1999/02/24 21:35:50 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
#t)))
(define interface-port-type
- (make-i/o-port-type
+ (make-port-type
`((WRITE-CHAR ,operation/write-char)
(WRITE-SUBSTRING ,operation/write-substring)
(FRESH-LINE ,operation/fresh-line)
;;; -*-Scheme-*-
;;;
-;;;$Id: winout.scm,v 1.12 1999/02/16 20:12:09 cph Exp $
+;;;$Id: winout.scm,v 1.13 1999/02/24 21:35:58 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
;;;
(unparse-object state (port/state port)))
(define window-output-port-type
- (make-output-port-type `((FLUSH-OUTPUT ,operation/flush-output)
- (FRESH-LINE ,operation/fresh-line)
- (PRINT-SELF ,operation/print-self)
- (WRITE-CHAR ,operation/write-char)
- (WRITE-SUBSTRING ,operation/write-substring)
- (X-SIZE ,operation/x-size))
- #f))
\ No newline at end of file
+ (make-port-type `((FLUSH-OUTPUT ,operation/flush-output)
+ (FRESH-LINE ,operation/fresh-line)
+ (PRINT-SELF ,operation/print-self)
+ (WRITE-CHAR ,operation/write-char)
+ (WRITE-SUBSTRING ,operation/write-substring)
+ (X-SIZE ,operation/x-size))
+ #f))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: emacs.scm,v 14.25 1999/02/16 20:30:54 cph Exp $
+$Id: emacs.scm,v 14.26 1999/02/24 21:36:13 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
(define (initialize-package!)
(set! emacs-console-port
- (make-port (make-i/o-port-type
+ (make-port (make-port-type
`((PROMPT-FOR-EXPRESSION ,emacs/prompt-for-expression)
(PROMPT-FOR-COMMAND-CHAR ,emacs/prompt-for-command-char)
(PROMPT-FOR-COMMAND-EXPRESSION
#| -*-Scheme-*-
-$Id: fileio.scm,v 1.16 1999/02/16 20:11:34 cph Exp $
+$Id: fileio.scm,v 1.17 1999/02/24 21:36:17 cph Exp $
Copyright (c) 1991-1999 Massachusetts Institute of Technology
(PATHNAME ,operation/pathname)
(TRUENAME ,operation/truename))))
(set! input-file-type
- (make-input-port-type (append input-operations
- other-operations)
- generic-input-type))
+ (make-port-type (append input-operations other-operations)
+ generic-input-type))
(set! output-file-type
- (make-output-port-type other-operations
- generic-output-type))
+ (make-port-type other-operations
+ generic-output-type))
(set! i/o-file-type
- (make-i/o-port-type (append input-operations
- other-operations)
- generic-i/o-type)))
+ (make-port-type (append input-operations other-operations)
+ generic-i/o-type)))
unspecific)
(define input-file-type)
#| -*-Scheme-*-
-$Id: genio.scm,v 1.14 1999/02/16 20:11:38 cph Exp $
+$Id: genio.scm,v 1.15 1999/02/24 21:36:33 cph Exp $
Copyright (c) 1991-1999 Massachusetts Institute of Technology
`((CLOSE ,operation/close)
(WRITE-SELF ,operation/write-self))))
(set! generic-input-type
- (make-input-port-type (append input-operations
- other-operations)
- #f))
+ (make-port-type (append input-operations
+ other-operations)
+ #f))
(set! generic-output-type
- (make-output-port-type (append output-operations
- other-operations)
- #f))
+ (make-port-type (append output-operations
+ other-operations)
+ #f))
(set! generic-i/o-type
- (make-i/o-port-type (append input-operations
- output-operations
- other-operations)
- #f)))
+ (make-port-type (append input-operations
+ output-operations
+ other-operations)
+ #f)))
unspecific)
(define generic-input-type)
#| -*-Scheme-*-
-$Id: port.scm,v 1.16 1999/02/18 03:54:03 cph Exp $
+$Id: port.scm,v 1.17 1999/02/24 21:36:37 cph Exp $
Copyright (c) 1991-1999 Massachusetts Institute of Technology
(define (make-encapsulated-port port state rewrite-operation)
(guarantee-port port)
(%make-port (let ((type (port/type port)))
- ((if (port-type/supports-input? type)
- (if (port-type/supports-output? type)
- make-i/o-port-type
- make-input-port-type)
- make-output-port-type)
+ (make-port-type
(append-map
(lambda (entry)
(let ((operation
\f
;;;; Constructors
-(define (make-input-port type state)
- (make-port (if (port-type? type) type (make-input-port-type type #f)) state))
-
-(define (make-output-port type state)
- (make-port (if (port-type? type) type (make-output-port-type type #f))
- state))
-
-(define (make-i/o-port type state)
- (make-port (if (port-type? type) type (make-i/o-port-type type #f)) state))
-
(define (make-port type state)
(guarantee-port-type type 'MAKE-PORT)
(%make-port type state (make-thread-mutex)))
-(define (make-input-port-type operations type)
- (operations->port-type operations type 'MAKE-INPUT-PORT-TYPE #t #f))
-
-(define (make-output-port-type operations type)
- (operations->port-type operations type 'MAKE-OUTPUT-PORT-TYPE #f #t))
-
-(define (make-i/o-port-type operations type)
- (operations->port-type operations type 'MAKE-I/O-PORT-TYPE #t #t))
-
-(define (operations->port-type operations type procedure-name input? output?)
+(define (make-port-type operations type)
(let ((type
(parse-operations-list
(append operations
(if type
(list-transform-negative (port-type/operations type)
(let ((ignored
- (append (if (assq 'READ-CHAR operations)
- '(DISCARD-CHAR
- DISCARD-CHARS
- PEEK-CHAR
- READ-CHAR
- READ-STRING
- READ-SUBSTRING)
- '())
- (if (assq 'WRITE-CHAR operations)
- '(WRITE-CHAR
- WRITE-SUBSTRING)
- '()))))
+ (append
+ (if (assq 'READ-CHAR operations)
+ '(DISCARD-CHAR
+ DISCARD-CHARS
+ PEEK-CHAR
+ READ-CHAR
+ READ-STRING
+ READ-SUBSTRING)
+ '())
+ (if (or (assq 'WRITE-CHAR operations)
+ (assq 'WRITE-SUBSTRING operations))
+ '(WRITE-CHAR
+ WRITE-SUBSTRING)
+ '()))))
(lambda (entry)
(or (assq (car entry) operations)
(memq (car entry) ignored)))))
'()))
- procedure-name)))
- (install-operations! type input?
- input-operation-names
- input-operation-modifiers
- input-operation-defaults)
- (install-operations! type output?
- output-operation-names
- output-operation-modifiers
- output-operation-defaults)
+ 'MAKE-PORT-TYPE)))
+ (let ((operations (port-type/operations type)))
+ (install-operations! type
+ (assq 'READ-CHAR operations)
+ input-operation-names
+ input-operation-modifiers
+ input-operation-defaults)
+ (install-operations! type
+ (or (assq 'WRITE-CHAR operations)
+ (assq 'WRITE-SUBSTRING operations))
+ output-operation-names
+ output-operation-modifiers
+ output-operation-defaults))
type))
(define (parse-operations-list operations procedure)
(define output-port/operation-names port/operation-names)
(define output-port/state port/state)
(define set-input-port/state! set-port/state!)
-(define set-output-port/state! set-port/state!)
\ No newline at end of file
+(define set-output-port/state! set-port/state!)
+
+(define (make-input-port type state)
+ (make-port (if (port-type? type) type (make-port-type type #f)) state))
+
+(define make-output-port make-input-port)
+(define make-i/o-port make-input-port)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.319 1999/02/24 21:23:58 cph Exp $
+$Id: runtime.pkg,v 14.320 1999/02/24 21:37:18 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
interaction-i/o-port
make-encapsulated-port
make-i/o-port
- make-i/o-port-type
make-input-port
- make-input-port-type
make-output-port
- make-output-port-type
make-port
+ make-port-type
notification-output-port
output-port-type?
output-port/channel
#| -*-Scheme-*-
-$Id: strnin.scm,v 14.7 1999/02/18 04:14:22 cph Exp $
+$Id: strnin.scm,v 14.8 1999/02/24 21:36:21 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
\f
(define (initialize-package!)
(set! input-string-port-type
- (make-input-port-type `((CHAR-READY? ,operation/char-ready?)
- (DISCARD-CHAR ,operation/discard-char)
- (DISCARD-CHARS ,operation/discard-chars)
- (PEEK-CHAR ,operation/peek-char)
- (WRITE-SELF ,operation/write-self)
- (READ-CHAR ,operation/read-char)
- (READ-STRING ,operation/read-string))
- #f))
+ (make-port-type `((CHAR-READY? ,operation/char-ready?)
+ (DISCARD-CHAR ,operation/discard-char)
+ (DISCARD-CHARS ,operation/discard-chars)
+ (PEEK-CHAR ,operation/peek-char)
+ (WRITE-SELF ,operation/write-self)
+ (READ-CHAR ,operation/read-char)
+ (READ-STRING ,operation/read-string))
+ #f))
unspecific)
(define (with-input-from-string string thunk)
#| -*-Scheme-*-
-$Id: strott.scm,v 14.8 1999/02/18 04:14:19 cph Exp $
+$Id: strott.scm,v 14.9 1999/02/24 21:36:25 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
\f
(define (initialize-package!)
(set! output-string-port-type
- (make-output-port-type `((WRITE-SELF ,operation/write-self)
- (WRITE-CHAR ,operation/write-char)
- (WRITE-SUBSTRING ,operation/write-substring))
- #f)))
+ (make-port-type `((WRITE-SELF ,operation/write-self)
+ (WRITE-CHAR ,operation/write-char)
+ (WRITE-SUBSTRING ,operation/write-substring))
+ #f)))
(define (with-output-to-truncated-string max thunk)
(call-with-current-continuation
#| -*-Scheme-*-
-$Id: strout.scm,v 14.11 1999/02/18 04:14:15 cph Exp $
+$Id: strout.scm,v 14.12 1999/02/24 21:36:29 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
\f
(define (initialize-package!)
(set! output-string-port-type
- (make-output-port-type `((WRITE-SELF ,operation/write-self)
- (WRITE-CHAR ,operation/write-char)
- (WRITE-SUBSTRING ,operation/write-substring))
- #f))
+ (make-port-type `((WRITE-SELF ,operation/write-self)
+ (WRITE-CHAR ,operation/write-char)
+ (WRITE-SUBSTRING ,operation/write-substring))
+ #f))
unspecific)
(define (with-output-to-string thunk)
#| -*-Scheme-*-
-$Id: ttyio.scm,v 1.11 1999/02/18 03:54:37 cph Exp $
+$Id: ttyio.scm,v 1.12 1999/02/24 21:36:08 cph Exp $
Copyright (c) 1991-1999 Massachusetts Institute of Technology
(set! hook/read-char operation/read-char)
(set! hook/peek-char operation/peek-char)
(set! the-console-port-type
- (make-i/o-port-type
+ (make-port-type
`((BEEP ,operation/beep)
(CLEAR ,operation/clear)
(DISCRETIONARY-FLUSH-OUTPUT ,operation/flush-output)
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.324 1999/02/24 21:23:53 cph Exp $
+$Id: runtime.pkg,v 14.325 1999/02/24 21:37:22 cph Exp $
Copyright (c) 1988-1999 Massachusetts Institute of Technology
interaction-i/o-port
make-encapsulated-port
make-i/o-port
- make-i/o-port-type
make-input-port
- make-input-port-type
make-output-port
- make-output-port-type
make-port
+ make-port-type
notification-output-port
output-port-type?
output-port/channel