ucode-primitive
ucode-type)
(import (runtime port)
- generic-port-operation:write-substring
- make-port-type
- make-port
- port/input-channel
- port/output-channel)
+ (make-port make-textual-port)
+ (make-port-type make-textual-port-type)
+ (port/input-channel input-port-channel)
+ (port/output-channel output-port-channel)
+ (port/state textual-port-state)
+ generic-port-operation:write-substring)
(export (edwin class-macros)
class-instance-transforms)
(export ()
(and entry
(cdr entry)))
(let ((filename (generate-fat-init-file short-base)))
- (let ((channel (port/output-channel port)))
+ (let ((channel (output-port-channel port)))
(channel-file-set-position
channel
(channel-file-length channel)))
(lambda (port*)
(recvr
(channel-descriptor
- (port/output-channel port*)))))))
+ (output-port-channel port*)))))))
(call-with-input-file fname
(lambda (input)
(let ((string (read-string (char-set) input)))
(lambda (port*)
(recvr
(channel-descriptor
- (port/input-channel port*))))))))
+ (input-port-channel port*))))))))
(define (with-output-channel in out)
(cond ((default-object? stderr)
(run in out -1))
((not (output-port? stderr))
(error "run: stderr not an output port" stderr))
- ((port/output-channel stderr)
+ ((output-port-channel stderr)
=>
(lambda (channel)
(output-port/flush-output stderr)
(with-output-channel in -1))
((not (output-port? stdout))
(error "run: stdout not an output port" stdout))
- ((port/output-channel stdout)
+ ((output-port-channel stdout)
=>
(lambda (channel)
(output-port/flush-output stdout)
(with-input-channel -1))
((not (input-port? stdin))
(error "run: stdin not an input port" stdin))
- ((port/input-channel stdin)
+ ((input-port-channel stdin)
=> (lambda (channel)
(with-input-channel (channel-descriptor channel))))
(else
(define (emacs/gc-start port)
(output-port/flush-output port)
- (cwb (port/output-channel port) "\033b" 0 2))
+ (cwb (output-port-channel port) "\033b" 0 2))
(define (emacs/gc-finish port)
- (cwb (port/output-channel port) "\033e" 0 2))
+ (cwb (output-port-channel port) "\033e" 0 2))
(define (transmit-signal port type)
- (let ((channel (port/output-channel port))
+ (let ((channel (output-port-channel port))
(buffer (string #\altmode type)))
(output-port/flush-output port)
(with-absolutely-no-interrupts
(cwb channel buffer 0 2)))))
(define (transmit-signal-with-argument port type string)
- (let ((channel (port/output-channel port))
+ (let ((channel (output-port-channel port))
(length (string-length string)))
(let ((buffer-length (+ length 3)))
(let ((buffer (make-string buffer-length)))
(define (initialize-package!)
(set! vanilla-console-port-type (textual-port-type the-console-port))
(set! emacs-console-port-type
- (make-port-type
+ (make-textual-port-type
`((PROMPT-FOR-EXPRESSION ,emacs/prompt-for-expression)
(PROMPT-FOR-COMMAND-CHAR ,emacs/prompt-for-command-char)
(PROMPT-FOR-COMMAND-EXPRESSION ,emacs/prompt-for-command-expression)
vanilla-console-port-type)))
(define (deferred-operation name)
- (port-type/operation vanilla-console-port-type name))
\ No newline at end of file
+ (textual-port-type-operation vanilla-console-port-type name))
\ No newline at end of file
(WRITE-SELF ,operation/write-self))))
(let ((make-type
(lambda (source sink)
- (make-port-type other-operations
- (generic-i/o-port-type source sink)))))
+ (make-textual-port-type other-operations
+ (generic-i/o-port-type source sink)))))
(set! input-file-type (make-type 'CHANNEL #f))
(set! output-file-type (make-type #f 'CHANNEL))
(set! i/o-file-type (make-type 'CHANNEL 'CHANNEL))))
(define (operation/length port)
(channel-file-length
- (or (port/input-channel port)
- (port/output-channel port))))
+ (or (input-port-channel port)
+ (output-port-channel port))))
(define (operation/write-self port output-port)
(write-string " for file: " output-port)
(flush-output port))
(if (input-port? port)
(let ((input-buffer (port-input-buffer port)))
- (- (channel-file-position (port/input-channel port))
+ (- (channel-file-position (input-port-channel port))
(input-buffer-free-bytes input-buffer)))
- (channel-file-position (port/output-channel port))))
+ (channel-file-position (output-port-channel port))))
(define (operation/set-position! port position)
(guarantee-positionable-port port 'OPERATION/SET-POSITION!)
(if (input-port? port)
(clear-input-buffer (port-input-buffer port)))
(channel-file-set-position (if (input-port? port)
- (port/input-channel port)
- (port/output-channel port))
+ (input-port-channel port)
+ (output-port-channel port))
position))
(define (guarantee-positionable-port port caller)
(guarantee-port port caller)
(if (and (i/o-port? port)
- (not (eq? (port/input-channel port) (port/output-channel port))))
+ (not (eq? (input-port-channel port) (output-port-channel port))))
(error:bad-range-argument port caller))
(if (and (input-port? port)
(not (input-buffer-using-binary-normalizer?
(if (not (or source sink))
(error "Missing arguments."))
(let ((port
- (make-port (if (default-object? type)
- (generic-i/o-port-type (source-type source)
- (sink-type sink))
- type)
- (apply make-gstate source sink 'TEXT 'TEXT extra-state))))
+ (make-textual-port (if (default-object? type)
+ (generic-i/o-port-type (source-type source)
+ (sink-type sink))
+ type)
+ (apply make-gstate source sink 'TEXT 'TEXT
+ extra-state))))
(let ((ib (port-input-buffer port)))
(if ib
((source/set-port (input-buffer-source ib)) port)))
(list->vector extra)))
(define-integrable (port-input-buffer port)
- (gstate-input-buffer (port/state port)))
+ (gstate-input-buffer (textual-port-state port)))
(define-integrable (port-output-buffer port)
- (gstate-output-buffer (port/state port)))
+ (gstate-output-buffer (textual-port-state port)))
(define (generic-i/o-port-accessor index)
(guarantee-index-fixnum index 'GENERIC-I/O-PORT-ACCESSOR)
(lambda (port)
- (let ((extra (gstate-extra (port/state port))))
+ (let ((extra (gstate-extra (textual-port-state port))))
(if (not (fix:< index (vector-length extra)))
(error "Accessor index out of range:" index))
(vector-ref extra index))))
(define (generic-i/o-port-modifier index)
(guarantee-index-fixnum index 'GENERIC-I/O-PORT-MODIFIER)
(lambda (port object)
- (let ((extra (gstate-extra (port/state port))))
+ (let ((extra (gstate-extra (textual-port-state port))))
(if (not (fix:< index (vector-length extra)))
(error "Accessor index out of range:" index))
(vector-set! extra index object))))
(WRITE-SELF ,generic-io/write-self))))
(let ((make-type
(lambda ops
- (make-port-type (append (apply append ops)
- other-operations)
- #f))))
+ (make-textual-port-type (append (apply append ops)
+ other-operations)
+ #f))))
(set! generic-type00 (make-type))
(set! generic-type10 (make-type ops:in1))
(set! generic-type20 (make-type ops:in1 ops:in2))
#t)
(define (generic-io/coding port)
- (gstate-coding (port/state port)))
+ (gstate-coding (textual-port-state port)))
(define (generic-io/set-coding port name)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(let ((ib (gstate-input-buffer state)))
(if ib
(set-input-buffer-coding! ib name)))
(else '())))
(define (generic-io/line-ending port)
- (gstate-line-ending (port/state port)))
+ (gstate-line-ending (textual-port-state port)))
(define (generic-io/set-line-ending port name)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(let ((ib (gstate-input-buffer state)))
(if ib
(set-input-buffer-line-ending!
cmdl-interrupt/abort-nearest))
(define (signal-interrupt hook/interrupt hook/clean-input char interrupt)
- (let ((thread (thread-mutex-owner (port/thread-mutex console-i/o-port))))
+ (let ((thread
+ (thread-mutex-owner (textual-port-thread-mutex console-i/o-port))))
(if thread
(signal-thread-event thread
(lambda ()
(declare (usual-integrations))
(define (make-decoding-port-type update finalize)
- (make-port-type
+ (make-textual-port-type
`((WRITE-CHAR
,(lambda (port char)
(guarantee-8-bit-char char)
- (update (port/state port) (string char) 0 1)
+ (update (textual-port-state port) (string char) 0 1)
1))
(WRITE-SUBSTRING
,(lambda (port string start end)
(if (string? string)
(begin
- (update (port/state port) string start end)
+ (update (textual-port-state port) string start end)
(fix:- end start))
(generic-port-operation:write-substring port string start end))))
(CLOSE-OUTPUT
,(lambda (port)
- (finalize (port/state port)))))
+ (finalize (textual-port-state port)))))
#f))
(define condition-type:decode-mime
v)))
(define (make-decode-quoted-printable-port port text?)
- (make-port decode-quoted-printable-port-type
+ (make-textual-port decode-quoted-printable-port-type
(decode-quoted-printable:initialize port text?)))
(define decode-quoted-printable-port-type
v)))
(define (make-decode-base64-port port text?)
- (make-port decode-base64-port-type (decode-base64:initialize port text?)))
+ (make-textual-port decode-base64-port-type
+ (decode-base64:initialize port text?)))
(define decode-base64-port-type
(make-decoding-port-type decode-base64:update decode-base64:finalize))
v)))
(define (make-decode-binhex40-port port text?)
- (make-port decode-binhex40-port-type
- (decode-binhex40:initialize port text?)))
+ (make-textual-port decode-binhex40-port-type
+ (decode-binhex40:initialize port text?)))
(define decode-binhex40-port-type
(make-decoding-port-type decode-binhex40:update decode-binhex40:finalize))
;;;; BinHex 4.0 run-length decoding
(define (make-binhex40-run-length-decoding-port port)
- (make-port binhex40-run-length-decoding-port-type
- (make-binhex40-rld-state port)))
+ (make-textual-port binhex40-run-length-decoding-port-type
+ (make-binhex40-rld-state port)))
(define binhex40-run-length-decoding-port-type
- (make-port-type
+ (make-textual-port-type
`((WRITE-CHAR
,(lambda (port char)
(guarantee-8-bit-char char)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(let ((port (binhex40-rld-state/port state))
(char* (binhex40-rld-state/char state)))
(cond ((binhex40-rld-state/marker-seen? state)
1))
(CLOSE-OUTPUT
,(lambda (port)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(let ((port (binhex40-rld-state/port state))
(char* (binhex40-rld-state/char state)))
(if char*
;;;; BinHex 4.0 deconstruction
(define (make-binhex40-deconstructing-port port)
- (make-port binhex40-deconstructing-port-type
- (make-binhex40-decon port)))
+ (make-textual-port binhex40-deconstructing-port-type
+ (make-binhex40-decon port)))
(define binhex40-deconstructing-port-type
- (make-port-type
+ (make-textual-port-type
`((WRITE-CHAR
,(lambda (port char)
(guarantee-8-bit-char char)
- (case (binhex40-decon/state (port/state port))
+ (case (binhex40-decon/state (textual-port-state port))
((READING-HEADER) (binhex40-decon-reading-header port char))
((COPYING-DATA) (binhex40-decon-copying-data port char))
((SKIPPING-TAIL) (binhex40-decon-skipping-tail port))
1))
(CLOSE-OUTPUT
,(lambda (port)
- (if (not (eq? (binhex40-decon/state (port/state port)) 'FINISHED))
+ (if (not (eq? (binhex40-decon/state (textual-port-state port))
+ 'FINISHED))
(error:decode-binhex40 "Premature EOF in BinHex 4.0 stream.")))))
#f))
(define (binhex40-decon-reading-header port char)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(let ((index (binhex40-decon/index state)))
(if (fix:= index 0)
(begin
(set-binhex40-decon/state! state 'COPYING-DATA)))))))))
(define (binhex40-decon-copying-data port char)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(write-char char (binhex40-decon/port state))
(let ((index (+ (binhex40-decon/index state) 1)))
(if (< index (binhex40-decon/data-length state))
(set-binhex40-decon/state! state 'SKIPPING-TAIL))))))
(define (binhex40-decon-skipping-tail port)
- (let ((state (port/state port)))
+ (let ((state (textual-port-state port)))
(let ((index (+ (binhex40-decon/index state) 1)))
(set-binhex40-decon/index! state index)
(if (>= index (binhex40-decon/data-length state))
v)))
(define (make-decode-uue-port port text?)
- (make-port decode-uue-port-type (decode-uue:initialize port text?)))
+ (make-textual-port decode-uue-port-type (decode-uue:initialize port text?)))
(define decode-uue-port-type
(make-decoding-port-type decode-uue:update decode-uue:finalize))
(and entry
(cdr entry)))
(let ((filename (generate-fat-init-file short-base)))
- (let ((channel (port/output-channel port)))
+ (let ((channel (output-port-channel port)))
(channel-file-set-position
channel
(channel-file-length channel)))
(define (call-with-truncated-output-port limit port generator)
(call-with-current-continuation
(lambda (k)
- (let ((port (make-port truncated-output-type
- (make-tstate port limit k 0))))
+ (let ((port
+ (make-textual-port truncated-output-type
+ (make-tstate port limit k 0))))
(generator port)
#f))))
count)
(define (trunc-out/write-char port char)
- (let ((ts (port/state port)))
+ (let ((ts (textual-port-state port)))
(if (< (tstate-count ts) (tstate-limit ts))
(begin
(set-tstate-count! ts (+ (tstate-count ts) 1))
((tstate-continuation ts) #t))))
(define (trunc-out/flush-output port)
- (output-port/flush-output (tstate-port (port/state port))))
+ (output-port/flush-output (tstate-port (textual-port-state port))))
(define (trunc-out/discretionary-flush-output port)
- (output-port/discretionary-flush (tstate-port (port/state port))))
+ (output-port/discretionary-flush (tstate-port (textual-port-state port))))
(define truncated-output-type)
(define (initialize-package!)
(set! truncated-output-type
- (make-port-type `((WRITE-CHAR ,trunc-out/write-char)
- (FLUSH-OUTPUT ,trunc-out/flush-output)
- (DISCRETIONARY-FLUSH-OUTPUT
- ,trunc-out/discretionary-flush-output))
- #f))
+ (make-textual-port-type `((WRITE-CHAR ,trunc-out/write-char)
+ (FLUSH-OUTPUT ,trunc-out/flush-output)
+ (DISCRETIONARY-FLUSH-OUTPUT
+ ,trunc-out/discretionary-flush-output))
+ #f))
unspecific)
\ No newline at end of file
;; Check the port property list for the name, and then the
;; environment. This way a port can override the default.
(let* ((nope "no-overridden-value")
- (v (port/get-property port name nope)))
+ (v (textual-port-property port name nope)))
(if (eq? v nope)
default-value
v)))
(if file-attribute-alist
(begin
;; Disable further attributes parsing.
- (port/set-property! port '*PARSER-ENABLE-FILE-ATTRIBUTES-PARSING?* #f)
+ (set-textual-port-property! port
+ '*PARSER-ENABLE-FILE-ATTRIBUTES-PARSING?*
+ #f)
(process-keyword-attribute file-attribute-alist port)
(process-mode-attribute file-attribute-alist port)
(process-studly-case-attribute file-attribute-alist port))))
(cond ((and (symbol? value)
(or (string-ci=? (symbol-name value) "none")
(string-ci=? (symbol-name value) "false")))
- (port/set-property! port '*PARSER-KEYWORD-STYLE* #f))
+ (set-textual-port-property! port '*PARSER-KEYWORD-STYLE* #f))
((and (symbol? value)
(string-ci=? (symbol-name value) "prefix"))
- (port/set-property! port '*PARSER-KEYWORD-STYLE* 'PREFIX))
+ (set-textual-port-property! port '*PARSER-KEYWORD-STYLE*
+ 'PREFIX))
((and (symbol? value)
(string-ci=? (symbol-name value) "suffix"))
- (port/set-property! port '*PARSER-KEYWORD-STYLE* 'SUFFIX))
+ (set-textual-port-property! port '*PARSER-KEYWORD-STYLE*
+ 'SUFFIX))
(else
(warn "Unrecognized value for keyword-style" value)))))))
(warn "Attribute value mismatch. Expected True.")
#f)
(else
- (port/set-property!
+ (set-textual-port-property!
port '*PARSER-CANONICALIZE-SYMBOLS?* #f))))
((or (not value)
(and (symbol? value)
(string-ci=? (symbol-name value) "false")))
- (port/set-property! port '*PARSER-CANONICALIZE-SYMBOLS?* #t))
+ (set-textual-port-property! port
+ '*PARSER-CANONICALIZE-SYMBOLS?*
+ #t))
(else (warn "Unrecognized value for sTuDly-case" value)))))))
-
\f
(define-syntax define-parse-error
(sc-macro-transformer
(declare (usual-integrations))
\f
-;;;; Port type
+;;;; Textual port types
(define-record-type <textual-port-type>
- (%make-port-type parent
- standard-operations
- custom-operations
- char-ready?
- read-char
- unread-char
- peek-char
- read-substring
- write-char
- write-substring
- fresh-line
- line-start?
- flush-output
- discretionary-flush-output)
- port-type?
- (parent port-type/parent)
- (standard-operations port-type/standard-operations
- set-port-type/standard-operations!)
- (custom-operations port-type/custom-operations
- set-port-type/custom-operations!)
+ (%make-textual-port-type operations
+ char-ready?
+ read-char
+ unread-char
+ peek-char
+ read-substring
+ write-char
+ write-substring
+ fresh-line
+ line-start?
+ flush-output
+ discretionary-flush-output)
+ textual-port-type?
+ (operations %port-type-operations)
;; input operations:
- (char-ready? port-type/char-ready?)
- (read-char port-type/read-char)
- (unread-char port-type/unread-char)
- (peek-char port-type/peek-char)
- (read-substring port-type/read-substring)
+ (char-ready? port-type-operation:char-ready?)
+ (read-char port-type-operation:read-char)
+ (unread-char port-type-operation:unread-char)
+ (peek-char port-type-operation:peek-char)
+ (read-substring port-type-operation:read-substring)
;; output operations:
- (write-char port-type/write-char)
- (write-substring port-type/write-substring)
- (fresh-line port-type/fresh-line)
- (line-start? port-type/line-start?)
- (flush-output port-type/flush-output)
- (discretionary-flush-output port-type/discretionary-flush-output))
+ (write-char port-type-operation:write-char)
+ (write-substring port-type-operation:write-substring)
+ (fresh-line port-type-operation:fresh-line)
+ (line-start? port-type-operation:line-start?)
+ (flush-output port-type-operation:flush-output)
+ (discretionary-flush-output port-type-operation:discretionary-flush-output))
(set-record-type-unparser-method! <textual-port-type>
(standard-unparser-method
(lambda (type)
- (if (port-type/supports-input? type)
- (if (port-type/supports-output? type)
+ (if (port-type-supports-input? type)
+ (if (port-type-supports-output? type)
'TEXTUAL-I/O-PORT-TYPE
'TEXTUAL-INPUT-PORT-TYPE)
- (if (port-type/supports-output? type)
+ (if (port-type-supports-output? type)
'TEXTUAL-OUTPUT-PORT-TYPE
'TEXTUAL-PORT-TYPE)))
#f))
-(define (guarantee-port-type object #!optional caller)
- (if (not (port-type? object))
- (error:not-port-type object caller))
- object)
+(define (port-type-supports-input? type)
+ (port-type-operation:read-char type))
-(define (error:not-port-type object #!optional caller)
- (error:wrong-type-argument object "port type" caller))
-\f
-(define-integrable (port-type/supports-input? type)
- (port-type/read-char type))
-
-(define-integrable (port-type/supports-output? type)
- (port-type/write-char type))
-
-(define (input-port-type? object)
- (and (port-type? object)
- (port-type/supports-input? object)
- #t))
+(define (port-type-supports-output? type)
+ (port-type-operation:write-char type))
-(define (output-port-type? object)
- (and (port-type? object)
- (port-type/supports-output? object)
- #t))
+(define (port-type-operation-names type)
+ (map car (%port-type-operations type)))
-(define (i/o-port-type? object)
- (and (port-type? object)
- (port-type/supports-input? object)
- (port-type/supports-output? object)
- #t))
+(define (textual-port-type-operations type)
+ (map (lambda (entry)
+ (list (car entry) (cdr entry)))
+ (%port-type-operations type)))
-(define (port-type/operation-names type)
- (guarantee-port-type type 'PORT-TYPE/OPERATION-NAMES)
- (append (map car (port-type/standard-operations type))
- (map car (port-type/custom-operations type))))
-
-(define (port-type/operations type)
- (guarantee-port-type type 'PORT-TYPE/OPERATIONS)
- (append! (map (lambda (entry)
- (list (car entry) (cdr entry)))
- (port-type/standard-operations type))
- (map (lambda (entry)
- (list (car entry) (cdr entry)))
- (port-type/custom-operations type))))
-
-(define (port-type/operation type name)
- (let ((entry
- (or (assq name (port-type/custom-operations type))
- (assq name (port-type/standard-operations type)))))
+(define (textual-port-type-operation type name)
+ (let ((entry (assq name (%port-type-operations type))))
(and entry
(cdr entry))))
\f
;;;; Constructors
-(define (make-port-type operations parent-type)
- (if (not (list-of-type? operations
- (lambda (elt)
- (and (pair? elt)
- (symbol? (car elt))
- (pair? (cdr elt))
- (procedure? (cadr elt))
- (null? (cddr elt))))))
- (error:wrong-type-argument operations "operations list" 'MAKE-PORT-TYPE))
+(define (make-textual-port-type operations parent-type)
+ (guarantee-list-of textual-port-type-operation? operations
+ 'make-textual-port-type)
(if parent-type
- (guarantee-port-type parent-type 'MAKE-PORT-TYPE))
+ (guarantee textual-port-type? parent-type 'make-textual-port-type))
(receive (standard-operations custom-operations)
(parse-operations-list operations parent-type)
(let ((op
- (let ((input? (assq 'READ-CHAR standard-operations))
- (output? (assq 'WRITE-CHAR standard-operations))
+ (let ((input? (assq 'read-char standard-operations))
+ (output? (assq 'write-char standard-operations))
(cond-op
(lambda (flag mapper)
(if flag
(let ((p (assq name standard-operations)))
(and p
(cdr p)))))))))))
- (%make-port-type parent-type
- standard-operations
- custom-operations
- (op 'CHAR-READY?)
- (op 'READ-CHAR)
- (op 'UNREAD-CHAR)
- (op 'PEEK-CHAR)
- (op 'READ-SUBSTRING)
- (op 'WRITE-CHAR)
- (op 'WRITE-SUBSTRING)
- (op 'FRESH-LINE)
- (op 'LINE-START?)
- (op 'FLUSH-OUTPUT)
- (op 'DISCRETIONARY-FLUSH-OUTPUT)))))
+ (%make-textual-port-type (append custom-operations standard-operations)
+ (op 'char-ready?)
+ (op 'read-char)
+ (op 'unread-char)
+ (op 'peek-char)
+ (op 'read-substring)
+ (op 'write-char)
+ (op 'write-substring)
+ (op 'fresh-line)
+ (op 'line-start?)
+ (op 'flush-output)
+ (op 'discretionary-flush-output)))))
+
+(define (textual-port-type-operation? object)
+ (and (pair? object)
+ (symbol? (car object))
+ (pair? (cdr object))
+ (procedure? (cadr object))
+ (null? (cddr object))))
+
+(add-boot-init!
+ (lambda ()
+ (register-predicate! textual-port-type-operation? 'port-type-operation)))
\f
(define (parse-operations-list operations parent-type)
(parse-operations-list-1
(if parent-type
(append operations
- (delete-matching-items (port-type/operations parent-type)
+ (delete-matching-items (textual-port-type-operations parent-type)
(let ((excluded
(append
(if (assq 'READ-CHAR operations)
;;;; Textual ports
(define-record-type <textual-port>
- (%make-textual-port type state thread-mutex unread? previous properties
+ (%make-textual-port thread-mutex type state unread? previous properties
transcript)
textual-port?
+ (thread-mutex textual-port-thread-mutex)
(type textual-port-type set-textual-port-type!)
(state textual-port-state set-textual-port-state!)
- (thread-mutex textual-port-thread-mutex set-textual-port-thread-mutex!)
(unread? textual-port-unread? set-textual-port-unread?!)
(previous textual-port-previous set-textual-port-previous!)
(properties textual-port-properties set-textual-port-properties!)
(transcript textual-port-transcript set-textual-port-transcript!))
-(define (make-port type state)
- (guarantee-port-type type 'MAKE-PORT)
- (%make-textual-port type state (make-thread-mutex) #f #f '() #f))
+(define (make-textual-port type state)
+ (guarantee textual-port-type? type 'MAKE-TEXTUAL-PORT)
+ (%make-textual-port (make-thread-mutex) type state #f #f '() #f))
(define (textual-input-port? object)
(and (textual-port? object)
- (port-type/supports-input? (port/type object))
+ (port-type-supports-input? (textual-port-type object))
#t))
(define (textual-output-port? object)
(and (textual-port? object)
- (port-type/supports-output? (port/type object))
+ (port-type-supports-output? (textual-port-type object))
#t))
(define (textual-i/o-port? object)
(and (textual-port? object)
- (let ((type (port/type object)))
- (and (port-type/supports-input? type)
- (port-type/supports-output? type)
+ (let ((type (textual-port-type object)))
+ (and (port-type-supports-input? type)
+ (port-type-supports-output? type)
#t))))
(add-boot-init!
(register-predicate! textual-i/o-port? 'textual-i/o-port
'<= textual-port?)))
-(define (port=? p1 p2)
- (guarantee-port p1 'PORT=?)
- (guarantee-port p2 'PORT=?)
- (eq? p1 p2))
-
-(define (textual-port-operation-names port)
- (port-type/operation-names (port/type port)))
-
-(define (textual-port-operation port name)
- (guarantee textual-port? port 'textual-port-operation)
- (port-type/operation (port/type port) name))
-
-(define-syntax define-port-operation
- (sc-macro-transformer
- (lambda (form environment)
- (let ((name (cadr form)))
- `(DEFINE (,(symbol-append 'TEXTUAL-PORT-OPERATION/ name) PORT)
- (,(close-syntax (symbol-append 'PORT-TYPE/ name) environment)
- (PORT/TYPE PORT)))))))
-
-(define-port-operation char-ready?)
-(define-port-operation read-char)
-(define-port-operation unread-char)
-(define-port-operation peek-char)
-(define-port-operation read-substring)
-(define-port-operation write-char)
-(define-port-operation write-substring)
-(define-port-operation fresh-line)
-(define-port-operation line-start?)
-(define-port-operation flush-output)
-(define-port-operation discretionary-flush-output)
-\f
(set-record-type-unparser-method! <textual-port>
(standard-unparser-method
(lambda (port)
(cond ((textual-port-operation port 'WRITE-SELF)
=> (lambda (operation)
(operation port output-port)))))))
-
-(define (port/copy port state)
- (let ((port (copy-record port)))
- (set-textual-port-state! port state)
- (set-textual-port-thread-mutex! port (make-thread-mutex))
- port))
-
+\f
(define (close-textual-port port)
(let ((close (textual-port-operation port 'CLOSE)))
(if close
(if close-output
(close-output port))))
-(define (port/open? port)
+(define (textual-port-open? port)
(let ((open? (textual-port-operation port 'OPEN?)))
(if open?
(open? port)
(and operation
(operation port))))
\f
-(define (port/get-property port name default)
- (guarantee-symbol name 'PORT/GET-PROPERTY)
+(define (textual-port-operation-names port)
+ (port-type-operation-names (textual-port-type port)))
+
+(define (textual-port-operation port name)
+ (textual-port-type-operation (textual-port-type port) name))
+
+(define-syntax define-port-operation
+ (sc-macro-transformer
+ (lambda (form environment)
+ (let ((name (cadr form)))
+ `(DEFINE (,(symbol 'TEXTUAL-PORT-OPERATION/ name) PORT)
+ (,(close-syntax (symbol 'PORT-TYPE-OPERATION: name) environment)
+ (TEXTUAL-PORT-TYPE PORT)))))))
+
+(define-port-operation char-ready?)
+(define-port-operation read-char)
+(define-port-operation unread-char)
+(define-port-operation peek-char)
+(define-port-operation read-substring)
+(define-port-operation write-char)
+(define-port-operation write-substring)
+(define-port-operation fresh-line)
+(define-port-operation line-start?)
+(define-port-operation flush-output)
+(define-port-operation discretionary-flush-output)
+
+(define (textual-port-property port name default)
+ (guarantee symbol? name 'port-property)
(let ((p (assq name (textual-port-properties port))))
(if p
(cdr p)
default)))
-(define (port/set-property! port name value)
- (guarantee-symbol name 'PORT/SET-PROPERTY!)
+(define (set-textual-port-property! port name value)
+ (guarantee symbol? name 'set-port-property!)
(let ((alist (textual-port-properties port)))
(let ((p (assq name alist)))
(if p
(set-cdr! p value)
(set-textual-port-properties! port (cons (cons name value) alist))))))
-(define (port/intern-property! port name get-value)
- (guarantee-symbol name 'PORT/INTERN-PROPERTY!)
+(define (intern-textual-port-property! port name get-value)
+ (guarantee symbol? name 'INTERN-PORT-PROPERTY!)
(let ((alist (textual-port-properties port)))
(let ((p (assq name alist)))
(if p
(set-textual-port-properties! port (cons (cons name value) alist))
value)))))
-(define (port/remove-property! port name)
- (guarantee-symbol name 'PORT/REMOVE-PROPERTY!)
+(define (remove-textual-port-property! port name)
+ (guarantee symbol? name 'REMOVE-PORT-PROPERTY!)
(set-textual-port-properties! port
(del-assq! name
(textual-port-properties port))))
(let ((tport (textual-port-transcript port)))
(if tport
(output-port/discretionary-flush tport))))
-
+\f
(define (port/supports-coding? port)
(let ((operation (textual-port-operation port 'SUPPORTS-CODING?)))
(if operation
(if (and read-mode write-mode (read-mode port))
(let ((outside-mode))
(dynamic-wind (lambda ()
- (if (port/open? port)
+ (if (textual-port-open? port)
(begin
(set! outside-mode (read-mode port))
(write-mode port mode))))
thunk
(lambda ()
- (if (port/open? port)
+ (if (textual-port-open? port)
(begin
(set! mode (read-mode port))
(write-mode port outside-mode))))))
(define interaction-i/o-port)
(add-boot-init!
(lambda ()
- (set! current-input-port (make-port-parameter guarantee-input-port))
- (set! current-output-port (make-port-parameter guarantee-output-port))
- (set! notification-output-port (make-port-parameter guarantee-output-port))
- (set! trace-output-port (make-port-parameter guarantee-output-port))
- (set! interaction-i/o-port (make-port-parameter guarantee-i/o-port))
+ (set! current-input-port (make-port-parameter input-port?))
+ (set! current-output-port (make-port-parameter output-port?))
+ (set! notification-output-port (make-port-parameter output-port?))
+ (set! trace-output-port (make-port-parameter output-port?))
+ (set! interaction-i/o-port (make-port-parameter i/o-port?))
unspecific))
-(define (make-port-parameter guarantee)
+(define (make-port-parameter predicate)
(make-general-parameter #f
(lambda (port)
- (if port (guarantee port))
+ (if port (guarantee predicate port))
port)
default-parameter-merger
(lambda (port)
(with-create-thread-continuation continuation
(lambda ()
((cmdl/driver cmdl) cmdl))))))))))))))))
- (mutex (port/thread-mutex port)))
+ (mutex (textual-port-thread-mutex port)))
(let ((thread (current-thread))
(owner (thread-mutex-owner mutex)))
(cond ((and owner (not (eq? thread owner)))
(export ()
;; BEGIN legacy bindings
(port/input-blocking-mode input-port-blocking-mode)
- (port/input-channel input-port-channel)
(port/input-terminal-mode input-port-terminal-mode)
+ (port/open? textual-port-open?)
(port/operation textual-port-operation)
(port/operation-names textual-port-operation-names)
(port/output-blocking-mode output-port-blocking-mode)
- (port/output-channel output-port-channel)
(port/output-terminal-mode output-port-terminal-mode)
(port/set-input-blocking-mode set-input-port-blocking-mode!)
(port/set-input-terminal-mode set-input-port-terminal-mode!)
(port/set-output-blocking-mode set-output-port-blocking-mode!)
(port/set-output-terminal-mode set-output-port-terminal-mode!)
- (port/state textual-port-state)
- (port/thread-mutex textual-port-thread-mutex)
(port/type textual-port-type)
(port/with-input-blocking-mode with-input-port-blocking-mode)
(port/with-input-terminal-mode with-input-port-terminal-mode)
(port/with-output-blocking-mode with-output-port-blocking-mode)
(port/with-output-terminal-mode with-output-port-terminal-mode)
- (set-port/state! set-textual-port-state!)
;; END legacy bindings
close-input-port
close-output-port
guarantee-port
i/o-port?
input-port-blocking-mode
- input-port-channel
input-port-open?
input-port-terminal-mode
input-port?
interaction-i/o-port
+ intern-textual-port-property!
notification-output-port
output-port-blocking-mode
- output-port-channel
output-port-open?
output-port-terminal-mode
output-port?
port/coding
- port/copy
- port/get-property
- port/intern-property!
port/known-coding?
port/known-codings
port/known-line-ending?
port/known-line-endings
port/line-ending
- port/open?
- textual-port-operation
- textual-port-operation-names
- port/remove-property!
port/set-coding
port/set-line-ending
- port/set-property!
port/supports-coding?
- port=?
port?
+ remove-textual-port-property!
set-current-input-port!
set-current-output-port!
set-input-port-blocking-mode!
set-notification-output-port!
set-output-port-blocking-mode!
set-output-port-terminal-mode!
+ set-textual-port-property!
set-trace-output-port!
+ textual-port-open?
+ textual-port-operation
+ textual-port-operation-names
+ textual-port-property
+ textual-port-thread-mutex
textual-port?
trace-output-port
with-input-from-port
with-output-to-port
with-trace-output-port)
(export (runtime)
- (port/input-channel textual-input-port-channel)
- (port/output-channel textual-output-port-channel)
- generic-port-operation:write-substring
- make-port
- make-port-type
+ input-port-channel
+ make-textual-port
+ make-textual-port-type
+ output-port-channel
set-textual-port-state!
textual-port-state)
(export (runtime input-port)
(export (runtime transcript)
set-textual-port-transcript!
textual-port-transcript)
+ (export (runtime mime-codec)
+ generic-port-operation:write-substring)
(export (runtime emacs-interface)
- port-type/operation
- set-textual-port-thread-mutex!
set-textual-port-type!
- textual-port-type)
+ textual-port-type
+ textual-port-type-operation)
(initialization (initialize-package!)))
(define-package (runtime input-port)
(define socket-port-type)
(define (initialize-package!)
(set! socket-port-type
- (make-port-type `((CLOSE-INPUT ,socket/close-input)
- (CLOSE-OUTPUT ,socket/close-output))
- (generic-i/o-port-type 'CHANNEL 'CHANNEL)))
+ (make-textual-port-type `((CLOSE-INPUT ,socket/close-input)
+ (CLOSE-OUTPUT ,socket/close-output))
+ (generic-i/o-port-type 'CHANNEL 'CHANNEL)))
unspecific)
(define (socket/close-input port)
(if (port/open? port)
((ucode-primitive shutdown-socket 2)
- (channel-descriptor (port/input-channel port))
+ (channel-descriptor (input-port-channel port))
1))
(generic-io/close-input port))
(define (socket/close-output port)
(if (port/open? port)
((ucode-primitive shutdown-socket 2)
- (channel-descriptor (port/input-channel port))
+ (channel-descriptor (input-port-channel port))
2))
(generic-io/close-output port))
\f
(receive (start end)
(check-index-limits start end (string-length string)
'OPEN-INPUT-STRING)
- (make-port narrow-input-type
- (make-internal-input-state string start end))))
+ (make-textual-port narrow-input-type
+ (make-internal-input-state string start end))))
((wide-string? string)
(receive (start end)
(check-index-limits start end (wide-string-length string)
'OPEN-INPUT-STRING)
- (make-port wide-input-type
- (make-internal-input-state string start end))))
+ (make-textual-port wide-input-type
+ (make-internal-input-state string start end))))
(else
(error:not-string string 'OPEN-INPUT-STRING))))
end)))
\f
(define (make-string-in-type peek-char read-char unread-char)
- (make-port-type `((CHAR-READY? ,string-in/char-ready?)
- (EOF? ,internal-in/eof?)
- (PEEK-CHAR ,peek-char)
- (READ-CHAR ,read-char)
- (READ-SUBSTRING ,internal-in/read-substring)
- (UNREAD-CHAR ,unread-char)
- (WRITE-SELF ,string-in/write-self))
- #f))
+ (make-textual-port-type `((CHAR-READY? ,string-in/char-ready?)
+ (EOF? ,internal-in/eof?)
+ (PEEK-CHAR ,peek-char)
+ (READ-CHAR ,read-char)
+ (READ-SUBSTRING ,internal-in/read-substring)
+ (UNREAD-CHAR ,unread-char)
+ (WRITE-SELF ,string-in/write-self))
+ #f))
(define (make-internal-input-state string start end)
(make-iistate string start end start))
(write-string " from string" output-port))
(define (internal-in/eof? port)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(not (fix:< (iistate-next ss) (iistate-end ss)))))
(define (internal-in/read-substring port string start end)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(let ((n
(move-chars! (iistate-string ss) (iistate-next ss) (iistate-end ss)
string start end)))
narrow-in/unread-char))
(define (narrow-in/peek-char port)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(if (fix:< (iistate-next ss) (iistate-end ss))
(string-ref (iistate-string ss) (iistate-next ss))
(make-eof-object port))))
(define (narrow-in/read-char port)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(if (fix:< (iistate-next ss) (iistate-end ss))
(let ((char (string-ref (iistate-string ss) (iistate-next ss))))
(set-iistate-next! ss (fix:+ (iistate-next ss) 1))
(make-eof-object port))))
(define (narrow-in/unread-char port char)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(if (not (fix:< (iistate-start ss) (iistate-next ss)))
(error "No char to unread:" port))
(let ((prev (fix:- (iistate-next ss) 1)))
wide-in/unread-char))
(define (wide-in/peek-char port)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(if (fix:< (iistate-next ss) (iistate-end ss))
(wide-string-ref (iistate-string ss) (iistate-next ss))
(make-eof-object port))))
(define (wide-in/read-char port)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(if (fix:< (iistate-next ss) (iistate-end ss))
(let ((char (wide-string-ref (iistate-string ss) (iistate-next ss))))
(set-iistate-next! ss (fix:+ (iistate-next ss) 1))
(make-eof-object port))))
(define (wide-in/unread-char port char)
- (let ((ss (port/state port)))
+ (let ((ss (textual-port-state port)))
(if (not (fix:< (iistate-start ss) (iistate-next ss)))
(error "No char to unread:" port))
(let ((prev (fix:- (iistate-next ss) 1)))
n)))))
(define (make-octets-input-type)
- (make-port-type `((WRITE-SELF
- ,(lambda (port output-port)
- port
- (write-string " from byte vector" output-port))))
- (generic-i/o-port-type #t #f)))
+ (make-textual-port-type
+ `((WRITE-SELF
+ ,(lambda (port output-port)
+ port
+ (write-string " from byte vector" output-port))))
+ (generic-i/o-port-type #t #f)))
\f
;;;; Output as characters
(define (open-narrow-output-string)
- (make-port narrow-output-type (make-ostate (make-string 16) 0 0)))
+ (make-textual-port narrow-output-type (make-ostate (make-string 16) 0 0)))
(define (open-wide-output-string)
- (make-port wide-output-type (make-ostate (make-wide-string 16) 0 0)))
+ (make-textual-port wide-output-type (make-ostate (make-wide-string 16) 0 0)))
(define (get-output-string port)
((port/operation port 'EXTRACT-OUTPUT) port))
(define (narrow-out/write-char port char)
(if (not (fix:< (char->integer char) #x100))
(error:not-8-bit-char char))
- (let ((os (port/state port)))
+ (let ((os (textual-port-state port)))
(maybe-grow-buffer os 1)
(string-set! (ostate-buffer os) (ostate-index os) char)
(set-ostate-index! os (fix:+ (ostate-index os) 1))
1))
(define (narrow-out/extract-output port)
- (let ((os (port/state port)))
+ (let ((os (textual-port-state port)))
(string-head (ostate-buffer os) (ostate-index os))))
(define (narrow-out/extract-output! port)
- (let* ((os (port/state port))
+ (let* ((os (textual-port-state port))
(output (string-head! (ostate-buffer os) (ostate-index os))))
(reset-buffer! os)
output))
wide-out/extract-output!))
(define (wide-out/write-char port char)
- (let ((os (port/state port)))
+ (let ((os (textual-port-state port)))
(maybe-grow-buffer os 1)
(wide-string-set! (ostate-buffer os) (ostate-index os) char)
(set-ostate-index! os (fix:+ (ostate-index os) 1))
1))
(define (wide-out/extract-output port)
- (let ((os (port/state port)))
+ (let ((os (textual-port-state port)))
(wide-substring (ostate-buffer os) 0 (ostate-index os))))
(define (wide-out/extract-output! port)
- (let ((os (port/state port)))
+ (let ((os (textual-port-state port)))
(let ((output (wide-substring (ostate-buffer os) 0 (ostate-index os))))
(reset-buffer! os)
output)))
\f
(define (make-string-out-type write-char extract-output extract-output!)
- (make-port-type `((WRITE-CHAR ,write-char)
- (WRITE-SUBSTRING ,string-out/write-substring)
- (EXTRACT-OUTPUT ,extract-output)
- (EXTRACT-OUTPUT! ,extract-output!)
- (OUTPUT-COLUMN ,string-out/output-column)
- (POSITION ,string-out/position)
- (WRITE-SELF ,string-out/write-self))
- #f))
+ (make-textual-port-type `((WRITE-CHAR ,write-char)
+ (WRITE-SUBSTRING ,string-out/write-substring)
+ (EXTRACT-OUTPUT ,extract-output)
+ (EXTRACT-OUTPUT! ,extract-output!)
+ (OUTPUT-COLUMN ,string-out/output-column)
+ (POSITION ,string-out/position)
+ (WRITE-SELF ,string-out/write-self))
+ #f))
(define-structure ostate
buffer
column)
(define (string-out/output-column port)
- (ostate-column (port/state port)))
+ (ostate-column (textual-port-state port)))
(define (string-out/position port)
- (ostate-index (port/state port)))
+ (ostate-index (textual-port-state port)))
(define (string-out/write-self port output-port)
port
(write-string " to string" output-port))
(define (string-out/write-substring port string start end)
- (let ((os (port/state port))
+ (let ((os (textual-port-state port))
(n (- end start)))
(maybe-grow-buffer os n)
(let* ((start* (ostate-index os))
(fix:- end start))))))
(define (make-octets-output-type)
- (make-port-type `((EXTRACT-OUTPUT ,octets-out/extract-output)
- (EXTRACT-OUTPUT! ,octets-out/extract-output!)
- (POSITION ,octets-out/position)
- (WRITE-SELF ,octets-out/write-self))
- (generic-i/o-port-type #f #t)))
+ (make-textual-port-type `((EXTRACT-OUTPUT ,octets-out/extract-output)
+ (EXTRACT-OUTPUT! ,octets-out/extract-output!)
+ (POSITION ,octets-out/position)
+ (WRITE-SELF ,octets-out/write-self))
+ (generic-i/o-port-type #f #t)))
(define (octets-out/extract-output port)
(output-port/flush-output port)
(eval sexp (buffer-env)))))))
(define (with-output-to-repl socket thunk)
- (let ((p (make-port repl-port-type socket)))
+ (let ((p (make-textual-port repl-port-type socket)))
(dynamic-wind
(lambda () unspecific)
(lambda () (with-output-to-port p thunk))
(set! *index* (make-unsettable-parameter unspecific))
(set! *buffer-pstring* (make-unsettable-parameter unspecific))
(set! repl-port-type
- (make-port-type
+ (make-textual-port-type
`((WRITE-CHAR
,(lambda (port char)
(write-message `(:write-string ,(string char))
- (port/state port))
+ (textual-port-state port))
1))
(WRITE-SUBSTRING
,(lambda (port string start end)
(if (< start end)
(write-message `(:write-string ,(substring string start end))
- (port/state port)))
+ (textual-port-state port)))
(- end start))))
#f))
unspecific)
((not return?) (run-first-thread)))))
(define (console-thread)
- (thread-mutex-owner (port/thread-mutex console-i/o-port)))
+ (thread-mutex-owner (textual-port-thread-mutex console-i/o-port)))
(define (other-running-threads?)
(thread/next (current-thread)))
(output-channel (tty-output-channel))
(gtype (generic-i/o-port-type 'CHANNEL 'CHANNEL)))
(let ((type
- (make-port-type
+ (make-textual-port-type
`((BEEP ,operation/beep)
(CHAR-READY? ,generic-io/char-ready?)
(CLEAR ,operation/clear)
(X-SIZE ,operation/x-size)
(Y-SIZE ,operation/y-size))
gtype)))
- (let ((port (make-port type (make-cstate input-channel output-channel))))
+ (let ((port
+ (make-textual-port type
+ (make-cstate input-channel output-channel))))
(set-channel-port! input-channel port)
(set-channel-port! output-channel port)
(set! the-console-port port)
(define (reset-console)
(let ((input-channel (tty-input-channel))
(output-channel (tty-output-channel)))
- (set-port/state! the-console-port
- (make-cstate input-channel output-channel))
+ (set-textual-port-state! the-console-port
+ (make-cstate input-channel output-channel))
(let ((s ((ucode-primitive reload-retrieve-string 0))))
(if s
(set-input-buffer-contents! (port-input-buffer the-console-port)
unspecific)
(define (console-i/o-port? port)
- (port=? port console-i/o-port))
+ (eqv? port console-i/o-port))
(define the-console-port)
(define console-i/o-port)
(newline port)))))))
\f
(define (wrap-notification-port port)
- (make-port wrapped-notification-port-type port))
+ (make-textual-port wrapped-notification-port-type port))
(define (make-wrapped-notification-port-type)
- (make-port-type `((WRITE-CHAR ,operation/write-char)
- (X-SIZE ,operation/x-size)
- (COLUMN ,operation/column)
- (FLUSH-OUTPUT ,operation/flush-output)
- (DISCRETIONARY-FLUSH-OUTPUT
- ,operation/discretionary-flush-output))
- #f))
+ (make-textual-port-type `((WRITE-CHAR ,operation/write-char)
+ (X-SIZE ,operation/x-size)
+ (COLUMN ,operation/column)
+ (FLUSH-OUTPUT ,operation/flush-output)
+ (DISCRETIONARY-FLUSH-OUTPUT
+ ,operation/discretionary-flush-output))
+ #f))
(define (operation/write-char port char)
- (let ((port* (port/state port)))
+ (let ((port* (textual-port-state port)))
(let ((n (output-port/write-char port* char)))
(if (char=? char #\newline)
(write-notification-prefix port*))
n)))
(define (operation/x-size port)
- (let ((port* (port/state port)))
+ (let ((port* (textual-port-state port)))
(let ((op (port/operation port* 'X-SIZE)))
(and op
(let ((n (op port*)))
0)))))))
(define (operation/column port)
- (let ((port* (port/state port)))
+ (let ((port* (textual-port-state port)))
(let ((op (port/operation port* 'COLUMN)))
(and op
(let ((n (op port*)))
0)))))))
(define (operation/flush-output port)
- (output-port/flush-output (port/state port)))
+ (output-port/flush-output (textual-port-state port)))
(define (operation/discretionary-flush-output port)
- (output-port/discretionary-flush (port/state port)))
+ (output-port/discretionary-flush (textual-port-state port)))
(define (write-notification-prefix port)
(write-string ";" port)
(define (with-rdf-input-port port thunk)
(fluid-let ((*rdf-bnode-registry*
- (or (port/get-property port 'RDF-BNODE-REGISTRY #f)
- (let ((table (make-string-hash-table)))
- (port/set-property! port 'RDF-BNODE-REGISTRY table)
- table))))
+ (intern-textual-port-property! port 'RDF-BNODE-REGISTRY
+ make-string-hash-table)))
(thunk)))
(define *rdf-bnode-registry*)
(if registry
(begin
(guarantee-rdf-prefix-registry registry 'PORT/SET-RDF-PREFIX-REGISTRY!)
- (port/set-property! port 'RDF-PREFIX-REGISTRY registry))
- (port/remove-property! port 'RDF-PREFIX-REGISTRY)))
+ (set-textual-port-property! port 'RDF-PREFIX-REGISTRY registry))
+ (remove-textual-port-property! port 'RDF-PREFIX-REGISTRY)))
(define (port/rdf-prefix-registry port)
- (or (port/get-property port 'RDF-PREFIX-REGISTRY #f)
+ (or (textual-port-property port 'RDF-PREFIX-REGISTRY #f)
*default-rdf-prefix-registry*))
\ No newline at end of file
projects / mit-scheme.git / commitdiff