(FILECREATED "18-Sep-86 12:21:25" {ERIS}<LISPCORE>LIBRARY>CLSTREAMS.;41 91497
changes to: (VARS CLSTREAMSCOMS)
(FUNCTIONS OPEN CLOSE STREAM-ELEMENT-TYPE INPUT-STREAM-P OUTPUT-STREAM-P
FILE-STREAM-POSITION MAKE-SYNONYM-STREAM MAKE-BROADCAST-STREAM
MAKE-CONCATENATED-STREAM MAKE-TWO-WAY-STREAM MAKE-ECHO-STREAM
MAKE-STRING-INPUT-STREAM %%MAKE-INITIAL-STRING-STREAM-CONTENTS
WITH-OPEN-STREAM WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING
WITH-OPEN-FILE MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM)
(FNS %%SYNONYM-STREAM-DEVICE-OPENFILE %%SYNONYM-STREAM-DEVICE-OUTCHARFN
%%TWO-WAY-STREAM-DEVICE-BOUT %%TWO-WAY-STREAM-DEVICE-OUTCHARFN
%%TWO-WAY-STREAM-DEVICE-OPENFILE %%BROADCAST-STREAM-DEVICE-OUTCHARFN
%%BROADCAST-STREAM-DEVICE-OPENFILE)
previous date: "16-Sep-86 12:41:44" {ERIS}<LISPCORE>LIBRARY>CLSTREAMS.;40)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CLSTREAMSCOMS)
(RPAQQ CLSTREAMSCOMS ((* *
"Implements a number of stream functions from CommonLisp. See CLtL chapter 21"
)
(COMS (* "documented functions and macros")
(FUNCTIONS OPEN CLOSE)
(FUNCTIONS STREAM-ELEMENT-TYPE INPUT-STREAM-P OUTPUT-STREAM-P)
(FUNCTIONS FILE-STREAM-POSITION)
(FUNCTIONS MAKE-SYNONYM-STREAM MAKE-BROADCAST-STREAM
MAKE-CONCATENATED-STREAM MAKE-TWO-WAY-STREAM MAKE-ECHO-STREAM
MAKE-STRING-INPUT-STREAM)
(FUNCTIONS %%MAKE-INITIAL-STRING-STREAM-CONTENTS)
(DECLARE: DOCOPY (FUNCTIONS WITH-OPEN-STREAM WITH-INPUT-FROM-STRING
WITH-OUTPUT-TO-STRING WITH-OPEN-FILE))
(FUNCTIONS MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM
GET-OUTPUT-STREAM-STRING \STRING-STREAM-OUTCHARFN
\ADJUSTABLE-STRING-STREAM-OUTCHARFN))
(COMS (* "helpers")
(FUNCTIONS %%NEW-FILE PREDICT-NAME))
(COMS (* "methods for the special devices")
(FNS %%BROADCAST-STREAM-DEVICE-BOUT %%BROADCAST-STREAM-DEVICE-OUTCHARFN
%%BROADCAST-STREAM-DEVICE-CLOSEFILE
%%BROADCAST-STREAM-DEVICE-FORCEOUTPUT
%%BROADCAST-STREAM-DEVICE-OPENFILE)
(FNS %%CONCATENATED-STREAM-DEVICE-BIN
%%CONCATENATED-STREAM-DEVICE-CLOSEFILE
%%CONCATENATED-STREAM-DEVICE-EOFP
%%CONCATENATED-STREAM-DEVICE-OPENFILE
%%CONCATENATED-STREAM-DEVICE-PEEKBIN)
(FNS %%ECHO-STREAM-DEVICE-BIN)
(FNS %%SYNONYM-STREAM-DEVICE-BIN %%SYNONYM-STREAM-DEVICE-BOUT
%%SYNONYM-STREAM-DEVICE-OUTCHARFN %%SYNONYM-STREAM-DEVICE-CLOSEFILE
%%SYNONYM-STREAM-DEVICE-EOFP %%SYNONYM-STREAM-DEVICE-FORCEOUTPUT
%%SYNONYM-STREAM-DEVICE-GETFILEINFO %%SYNONYM-STREAM-DEVICE-OPENFILE
%%SYNONYM-STREAM-DEVICE-PEEKBIN %%SYNONYM-STREAM-DEVICE-READP
%%SYNONYM-STREAM-DEVICE-BACKFILEPTR
%%SYNONYM-STREAM-DEVICE-SETFILEINFO)
(FNS %%TWO-WAY-STREAM-DEVICE-BIN %%TWO-WAY-STREAM-DEVICE-BOUT
%%TWO-WAY-STREAM-DEVICE-OUTCHARFN %%TWO-WAY-STREAM-DEVICE-CLOSEFILE
%%TWO-WAY-STREAM-DEVICE-EOFP %%TWO-WAY-STREAM-DEVICE-BACKFILEPTR
%%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT %%TWO-WAY-STREAM-DEVICE-OPENFILE
%%TWO-WAY-STREAM-DEVICE-PEEKBIN)
(FUNCTIONS %%FILL-POINTER-STREAM-DEVICE-CLOSEFILE
%%FILL-POINTER-STREAM-DEVICE-GETFILEPTR))
(COMS (* "helper stuff")
(FNS %%SYNONYM-STREAM-DEVICE-GET-STREAM))
(COMS (* "package initialization")
(VARIABLES *TRACE-OUTPUT* *DEBUG-IO* *QUERY-IO* *TERMINAL-IO*
*ERROR-OUTPUT* *STANDARD-OUTPUT* *STANDARD-INPUT*)
(FUNCTIONS %%INITIALIZE-SYNONYM-IMAGEOPS %%INITIALIZE-STANDARD-STREAMS)
(FNS %%INITIALIZE-CLSTREAM-TYPES)
(DECLARE: DONTEVAL@LOAD DOCOPY (*)
(P (%%INITIALIZE-CLSTREAM-TYPES)
(%%INITIALIZE-STANDARD-STREAMS)
(* (%%INITIALIZE-SYNONYM-IMAGEOPS)))))
(PROP FILETYPE CLSTREAMS)
(SETFS FILE-STREAM-POSITION)))
(* * "Implements a number of stream functions from CommonLisp. See CLtL chapter 21")
(* "documented functions and macros")
(DEFUN OPEN (FILENAME &KEY (DIRECTION :INPUT)
(ELEMENT-TYPE (QUOTE STRING-CHAR))
(IF-EXISTS NIL EXISTS-P)
(IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P))
(* * "Return a stream which reads from or writes to Filename. Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). See the manual for details.")
(CL:UNLESS (MEMQ DIRECTION (QUOTE (:INPUT :OUTPUT :IO :PROBE)))
(CL:ERROR "~S isn't a valid direction for open." DIRECTION))
(CL:UNLESS (MEMQ ELEMENT-TYPE (QUOTE (STRING-CHAR UNSIGNED-BYTE CHARACTER :DEFAULT)))
(CL:ERROR "~S isn't an implemented element-type for open." ELEMENT-TYPE))
(LET ((PATHNAME (PATHNAME FILENAME))
(FOR-INPUT (MEMQ DIRECTION (QUOTE (:IO :INPUT))))
(FOR-OUTPUT (MEMQ DIRECTION (QUOTE (:IO :OUTPUT))))
(STREAM NIL))
(* * "Do hairy defaulting of :if-exists and :if-does-not-exist keywords.")
(CL:UNLESS EXISTS-P (SETQ IF-EXISTS (CL:IF (EQ (PATHNAME-VERSION PATHNAME)
:NEWEST)
:NEW-VERSION :ERROR)))
(CL:UNLESS DOES-NOT-EXIST-P (SETQ IF-DOES-NOT-EXIST (COND
((OR (MEMQ IF-EXISTS (QUOTE (:OVERWRITE
:APPEND)))
(EQ DIRECTION :INPUT))
:ERROR)
((EQ DIRECTION :PROBE)
NIL)
(T :CREATE))))
(LOOP (*
"See if the file exists and handle the existential keywords.")
(LET* ((NAME (PREDICT-NAME PATHNAME))
(NAMESTRING (MKSTRING NAME)))
(if NAME
then (* "file exists")
(if FOR-OUTPUT
then (CASE IF-EXISTS (:ERROR (CERROR "write it anyway."
"File ~A already exists."
NAMESTRING)
(SETQ STREAM (OPENSTREAM NAMESTRING
(QUOTE OUTPUT)))
(RETURN NIL))
((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE)
(SETQ STREAM (OPENSTREAM NAMESTRING (QUOTE OUTPUT)
(QUOTE NEW)))
(RETURN NIL))
(:OVERWRITE (SETQ STREAM (OPENSTREAM NAMESTRING
(QUOTE OUTPUT)
(QUOTE OLD)))
(RETURN NIL))
(:APPEND (SETQ STREAM (OPENSTREAM NAMESTRING (QUOTE APPEND)
(QUOTE OLD)))
(RETURN NIL))
((NIL)
(RETURN-FROM OPEN NIL))
(T (CL:ERROR "~S is not a valid value for :if-exists."
IF-EXISTS)))
elseif FOR-INPUT
then (SETQ STREAM (OPENSTREAM NAMESTRING (QUOTE INPUT)
(QUOTE OLD)))
(RETURN NIL)
else (SETQ STREAM (create STREAM
FULLFILENAME ← (FULLNAME NAMESTRING)))
(RETURN NIL))
else (* "file does not exist")
(if FOR-OUTPUT
then (CASE IF-DOES-NOT-EXIST (:ERROR (CERROR "prompt for a new name."
"File ~A does not exist."
PATHNAME)
(FORMAT *QUERY-IO*
"~&New file name: ")
(SETQ PATHNAME (PATHNAME
(READ-LINE
*QUERY-IO*)))
)
(:CREATE (SETQ STREAM (OPENSTREAM PATHNAME (QUOTE OUTPUT)
(QUOTE NEW)))
(RETURN NIL))
((NIL)
(RETURN-FROM OPEN NIL))
(T (CL:ERROR
"~S is not a valid value for :if-does-not-exist."
IF-DOES-NOT-EXIST)))
elseif FOR-INPUT
then (CASE IF-DOES-NOT-EXIST (:ERROR (CERROR "prompt for a new name."
"File ~A does not exist."
PATHNAME)
(FORMAT *QUERY-IO*
"~&New file name: ")
(SETQ PATHNAME (PATHNAME
(READ-LINE
*QUERY-IO*)))
)
(:CREATE (%%NEW-FILE PATHNAME))
((NIL)
(RETURN-FROM OPEN NIL))
(T (CL:ERROR
"~S is not a valid value for :if-does-not-exist."
IF-DOES-NOT-EXIST)))
else (* "Open for probe.")
(RETURN NIL)))))
STREAM))
(DEFUN CLOSE (STREAM &KEY ABORT)
(* * "Close a stream. If ABORT, then don't keep the file")
(if (STREAMP STREAM)
then (if (OPENP STREAM)
then
(* * "determine 'deletability' of stream's file before closing, as that trashes the info")
(LET ((ABORTABLE (AND (DIRTYABLE STREAM)
(NOT (APPENDONLY STREAM)))))
(CLOSEF STREAM)
(if (AND ABORT ABORTABLE)
then (*
"eventually we will change device CLOSEF methods to take an ABORT arg. For now, simulate it.")
(DELFILE (NAMESTRING STREAM)))))
else (ERROR "Closing a non-stream" STREAM))
T)
(DEFUN STREAM-ELEMENT-TYPE (STREAM) (QUOTE UNSIGNED-BYTE))
(DEFUN INPUT-STREAM-P (STREAM) (CL:WHEN (NOT (STREAMP STREAM))
(\ILLEGAL.ARG STREAM))
(* * "we return T instead of the stream because Symbolics does")
(AND (\IOMODEP STREAM (QUOTE INPUT)
T)
T))
(DEFUN OUTPUT-STREAM-P (STREAM) (CL:WHEN (NOT (STREAMP STREAM))
(\ILLEGAL.ARG STREAM))
(* * "we return T instead of the stream because Symbolics does")
(AND (\IOMODEP STREAM (QUOTE OUTPUT)
T)
T))
(DEFUN FILE-STREAM-POSITION (STREAM) (GETFILEPTR STREAM))
(DEFUN MAKE-SYNONYM-STREAM (SYMBOL)
(* * "A CommonLisp function for shadowing a stream. See CLtL p. 329")
(OPENSTREAM (QUOTE {SYNONYM-STREAM-DEVICE})
(QUOTE BOTH)
NIL NIL (BQUOTE ((SYMBOL (\, SYMBOL))))))
(DEFUN MAKE-BROADCAST-STREAM (&REST STREAMS)
(* * "CommonLisp function to make a `splitter' stream. See CLtL p329")
(OPENSTREAM (QUOTE {BROADCAST-STREAM-DEVICE})
(QUOTE OUTPUT)
NIL NIL (BQUOTE ((STREAMS (\, STREAMS))))
NIL))
(DEFUN MAKE-CONCATENATED-STREAM (&REST STREAMS)
(* * A CommonLisp function for concatenating several input streams together.
See CLtL p. 329)
(OPENSTREAM (QUOTE {CONCATENATED-STREAM-DEVICE})
(QUOTE INPUT)
NIL NIL (BQUOTE ((STREAMS (\, STREAMS))))
NIL))
(DEFUN MAKE-TWO-WAY-STREAM (INPUT-STREAM OUTPUT-STREAM)
(* * "A CommonLisp function for splicing together two streams. See CLtL p. 329")
(OPENSTREAM (QUOTE {TWO-WAY-STREAM-DEVICE})
(QUOTE BOTH)
NIL NIL (BQUOTE ((INPUT-STREAM (\, INPUT-STREAM))
(OUTPUT-STREAM (\, OUTPUT-STREAM))))))
(DEFUN MAKE-ECHO-STREAM (INPUT-STREAM OUTPUT-STREAM)
(* * "A CommonLisp function for splicing together two streams. See CLtL p. 329")
(OPENSTREAM (QUOTE {ECHO-STREAM-DEVICE})
(QUOTE BOTH)
NIL NIL (BQUOTE ((INPUT-STREAM (\, INPUT-STREAM))
(OUTPUT-STREAM (\, OUTPUT-STREAM))))))
(DEFUN MAKE-STRING-INPUT-STREAM (STRING &OPTIONAL (START 0 STARTP)
(END NIL ENDP))
(* * "A CommonLisp function for producing a stream from a string. See CLtL p. 330")
(OPENSTRINGSTREAM (if (OR STARTP ENDP)
then (SUBSEQ STRING START (if ENDP
then END
else (CL:LENGTH STRING)))
else STRING)
(QUOTE INPUT)))
(DEFUN %%MAKE-INITIAL-STRING-STREAM-CONTENTS NIL (MAKE-ARRAY 128 :ELEMENT-TYPE (QUOTE STRING-CHAR)
:ADJUSTABLE T :FILL-POINTER 0))
(DECLARE: DOCOPY
(DEFMACRO WITH-OPEN-STREAM ((VAR STREAM)
&BODY
(BODY DECLS)) (LET ((ABORTP (GENSYM)))
(BQUOTE (LET (((\, VAR)
(\, STREAM))
((\, ABORTP)
T))
(\,@ DECLS)
(UNWIND-PROTECT
(MULTIPLE-VALUE-PROG1
(PROGN (\,@ BODY))
(SETQ (\, ABORTP)
NIL))
(CLOSE (\, VAR)
:ABORT
(\, ABORTP)))))))
(DEFMACRO WITH-INPUT-FROM-STRING ((VAR STRING &KEY (INDEX NIL INDEXP)
(START 0 STARTP)
(END NIL ENDP))
&BODY
(BODY DECLS))
(BQUOTE (LET (((\, VAR)
(MAKE-STRING-INPUT-STREAM (\, STRING)
(\,@ (if STARTP
then (if ENDP
then (LIST START END)
else (LIST START))
else (if ENDP
then (LIST NIL END)))))))
(\,@ DECLS)
(UNWIND-PROTECT (PROG1 (PROGN (\,@ BODY))
(\,@ (if INDEXP
then (BQUOTE ((SETF (\, INDEX)
(+ (\, START)
(GETFILEPTR (\, VAR))))))
else NIL)))
(CLOSE (\, VAR))))))
(DEFMACRO WITH-OUTPUT-TO-STRING ((VAR &OPTIONAL (STRING NIL STRINGP))
&BODY
(FORMS DECLS))
(if STRINGP
then (BQUOTE (LET (((\, VAR)
(MAKE-FILL-POINTER-OUTPUT-STREAM (\, STRING))))
(\,@ DECLS)
(UNWIND-PROTECT (PROGN (\,@ FORMS))
(CLOSE (\, VAR)))))
else (BQUOTE (LET (((\, VAR)
(MAKE-STRING-OUTPUT-STREAM)))
(\,@ DECLS)
(UNWIND-PROTECT (PROGN (\,@ FORMS)
(GET-OUTPUT-STREAM-STRING (\, VAR)))
(CLOSE (\, VAR)))))))
(DEFMACRO WITH-OPEN-FILE ((VAR &REST OPEN-ARGS)
&BODY
(FORMS DECLS))
(* * "Bindspec is of the form (Stream File-Name . Options). The file whose name is File-Name is opened using the Options and bound to the variable Stream. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.")
(LET ((ABORTP (GENSYM)))
(BQUOTE (LET (((\, VAR)
(OPEN (\,@ OPEN-ARGS)))
((\, ABORTP)
T))
(\,@ DECLS)
(UNWIND-PROTECT (MULTIPLE-VALUE-PROG1 (PROGN (\,@ FORMS))
(SETQ (\, ABORTP)
NIL))
(CL:WHEN (\, VAR)
(CLOSE (\, VAR)
:ABORT
(\, ABORTP))))))))
)
(DEFUN MAKE-STRING-OUTPUT-STREAM NIL
(* * "A function for producing a string stream. See also the function get-output-stream-string. Also, see CLtL p. 330")
(MAKE-FILL-POINTER-OUTPUT-STREAM))
(DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM (&OPTIONAL (STRING (%%MAKE-INITIAL-STRING-STREAM-CONTENTS)))
(DECLARE (GLOBALVARS \FILL-POINTER-STREAM-DEVICE))
(if (NOT (ARRAY-HAS-FILL-POINTER-P STRING))
then (\ILLEGAL.ARG STRING)
else (LET ((STREAM (create STREAM
DEVICE ← \FILL-POINTER-STREAM-DEVICE
F1 ← STRING
ACCESS ← (QUOTE OUTPUT))))
(STREAMPROP STREAM (QUOTE STRING-OUTPUT-STREAM)
T)
(replace (STREAM OUTCHARFN) of STREAM with (if (ADJUSTABLE-ARRAY-P STRING)
then (FUNCTION
\ADJUSTABLE-STRING-STREAM-OUTCHARFN
)
else (FUNCTION \STRING-STREAM-OUTCHARFN))
)
(replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \OUTCHAR))
STREAM)))
(DEFUN GET-OUTPUT-STREAM-STRING (STRING-OUTPUT-STREAM)
(* * "A CommonLisp function for getting the contents of the buffer created by a call to make-string-output-stream. See CLtL p. 330")
(if (NOT (STREAMPROP STRING-OUTPUT-STREAM (QUOTE STRING-OUTPUT-STREAM)))
then (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM)
else (PROG1 (fetch (STREAM F1) of STRING-OUTPUT-STREAM)
(replace (STREAM F1) of STRING-OUTPUT-STREAM with (
%%MAKE-INITIAL-STRING-STREAM-CONTENTS
)))))
(DEFUN \STRING-STREAM-OUTCHARFN (STREAM CHAR) (IF (EQ CHAR (CHARCODE EOL))
THEN (REPLACE (STREAM CHARPOSITION) OF STREAM
WITH 0)
ELSE (ADD (FETCH (STREAM CHARPOSITION) OF STREAM)
1))
(VECTOR-PUSH (CL:CHARACTER CHAR)
(FETCH (STREAM F1) OF STREAM)))
(DEFUN \ADJUSTABLE-STRING-STREAM-OUTCHARFN (STREAM CHAR) (IF (EQ CHAR (CHARCODE EOL))
THEN (REPLACE (STREAM CHARPOSITION)
OF STREAM WITH 0)
ELSE (ADD (FETCH (STREAM CHARPOSITION)
OF STREAM)
1))
(VECTOR-PUSH-EXTEND (CL:CHARACTER CHAR)
(FETCH (STREAM F1) OF STREAM)))
(* "helpers")
(DEFUN %%NEW-FILE (FILENAME) (CLOSEF (OPENSTREAM FILENAME (QUOTE OUTPUT)
(QUOTE NEW))))
(DEFUN PREDICT-NAME (PATHNAME) (LET ((PATH (PROBE-FILE PATHNAME)))
(IF PATH
THEN (NAMESTRING PATH))))
(* "methods for the special devices")
(DEFINEQ
(%%BROADCAST-STREAM-DEVICE-BOUT
[LAMBDA (STREAM BYTE) (* hdj "17-Apr-86 18:08")
(* * The BOUT method for the broadcast-stream device)
(for S in (fetch F1 of STREAM) do (\BOUT S BYTE))
BYTE])
(%%BROADCAST-STREAM-DEVICE-OUTCHARFN
(LAMBDA (STREAM CHARCODE) (* hdj "18-Sep-86 11:29")
(* ;; "outcharfn for broadcast streams")
(for S in (fetch (STREAM F1) of STREAM) do (\OUTCHAR S CHARCODE))
CHARCODE))
(%%BROADCAST-STREAM-DEVICE-CLOSEFILE
[LAMBDA (STREAM) (* hdj
"26-Mar-86 16:28")
(* * The CLOSEFILE method for the broadcast-stream device)
(replace ACCESS of STREAM with NIL)
(replace F1 of STREAM with NIL)
STREAM])
(%%BROADCAST-STREAM-DEVICE-FORCEOUTPUT
[LAMBDA (stream waitForFinish?) (* smL "14-Aug-85 15:55")
(* * The FORCEOUTPUT method for the broadcast-stream device)
(for s in (fetch F1 of stream) do (FORCEOUTPUT s waitForFinish?])
(%%BROADCAST-STREAM-DEVICE-OPENFILE
(LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* hdj "18-Sep-86 11:28")
(* * The OPENFILE method for the broadcast-stream device)
(SELECTQ ACCESS
((INPUT BOTH APPEND)
NIL)
(create STREAM
DEVICE ← DEVICE
F1 ← (CADR (ASSOC (QUOTE STREAMS)
PARAMETERS))
OUTCHARFN ← (FUNCTION %%BROADCAST-STREAM-DEVICE-OUTCHARFN)))))
)
(DEFINEQ
(%%CONCATENATED-STREAM-DEVICE-BIN
[LAMBDA (stream) (* smL "14-Aug-85 16:52")
(* * The BIN method for the concatenated-stream device)
(while (fetch F1 of stream) do [if (EOFP (CAR (fetch F1 of stream)))
then (CLOSEF (pop (fetch F1 of stream)))
else (RETURN (\BIN (CAR (fetch F1 of stream]
finally (* the EOF case)
(\EOF.ACTION stream])
(%%CONCATENATED-STREAM-DEVICE-CLOSEFILE
[LAMBDA (stream) (* smL "14-Aug-85 16:53")
(* * The CLOSEFILE method for the concatenated-stream device)
(replace ACCESS of stream with NIL)
(for s in (fetch F1 of stream) do (CLOSEF s))
(replace F1 of stream with NIL)
stream])
(%%CONCATENATED-STREAM-DEVICE-EOFP
[LAMBDA (stream) (* smL "14-Aug-85 16:53")
(* * The EOFP method for the concatenated-stream device)
(while (fetch F1 of stream) do (if (EOFP (CAR (fetch F1 of stream)))
then (CLOSEF (pop (fetch F1 of stream)))
else (RETURN NIL))
finally (* the EOF case)
(RETURN T])
(%%CONCATENATED-STREAM-DEVICE-OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* hdj "21-Apr-86 14:33")
(* * The OPENFILE method for the concatenated-stream device)
(SELECTQ ACCESS
((OUTPUT BOTH APPEND)
NIL)
(create STREAM
DEVICE ← DEVICE
F1 ←(CADR (ASSOC (QUOTE STREAMS)
PARAMETERS])
(%%CONCATENATED-STREAM-DEVICE-PEEKBIN
[LAMBDA (stream noErrorFlg?) (* smL "14-Aug-85 16:53")
(* * The PEEKBIN method for the concatenated-stream device)
(while (fetch F1 of stream) do [if (EOFP (CAR (fetch F1 of stream)))
then (CLOSEF (pop (fetch F1 of stream)))
else (RETURN (\PEEKBIN (CAR (fetch F1 of stream]
finally (* the EOF case)
(if noErrorFlg?
then (RETURN NIL)
else (\EOF.ACTION stream])
)
(DEFINEQ
(%%ECHO-STREAM-DEVICE-BIN
[LAMBDA (STREAM) (* hdj "21-Apr-86 18:33")
(* * The BIN method for the echo-stream device)
(LET ((BYTE (%%TWO-WAY-STREAM-DEVICE-BIN STREAM)))
(\BOUT STREAM BYTE)
BYTE])
)
(DEFINEQ
(%%SYNONYM-STREAM-DEVICE-BIN
[LAMBDA (STREAM) (* hdj
"19-Mar-86 17:19")
(* * The BIN method for the synonym-stream device.)
(\BIN (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM])
(%%SYNONYM-STREAM-DEVICE-BOUT
[LAMBDA (STREAM BYTE) (* hdj
"19-Mar-86 17:20")
(* * The BOUT method for the synonym-stream device.)
(\BOUT (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
BYTE])
(%%SYNONYM-STREAM-DEVICE-OUTCHARFN
(LAMBDA (STREAM CHARCODE) (* hdj "17-Sep-86 14:04")
(* ;; " OUTCHARFN for synonym streams")
(\OUTCHAR (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
CHARCODE)))
(%%SYNONYM-STREAM-DEVICE-CLOSEFILE
[LAMBDA (STREAM) (* hdj
"19-Mar-86 17:14")
(* * the CLOSEFILE method for the synonym-stream device)
(replace F1 of STREAM with NIL)
STREAM])
(%%SYNONYM-STREAM-DEVICE-EOFP
[LAMBDA (STREAM) (* hdj
"19-Mar-86 17:20")
(* * The EOFP method for the synonym-stream device.)
(\EOFP (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM])
(%%SYNONYM-STREAM-DEVICE-FORCEOUTPUT
[LAMBDA (STREAM WAITFORFINISH) (* hdj
"19-Mar-86 17:09")
(* * The FORCEOUTPUT method for the synonym-stream device.)
(FORCEOUTPUT (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
WAITFORFINISH])
(%%SYNONYM-STREAM-DEVICE-GETFILEINFO
[LAMBDA (STREAM ATTRIBUTE DEVICE) (* hdj
"19-Mar-86 17:10")
(* * The GETFILEINFO method for the synonym-stream device.)
(GETFILEINFO (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
ATTRIBUTE])
(%%SYNONYM-STREAM-DEVICE-OPENFILE
(LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* hdj "17-Sep-86 14:05")
(* * the OPENFILE method for the synonym-stream device)
(create STREAM
DEVICE ← DEVICE
F1 ← (CADR (ASSOC (QUOTE SYMBOL)
PARAMETERS))
OUTCHARFN ← (FUNCTION %%SYNONYM-STREAM-DEVICE-OUTCHARFN))))
(%%SYNONYM-STREAM-DEVICE-PEEKBIN
[LAMBDA (STREAM NOERRORFLG?) (* hdj
"19-Mar-86 17:12")
(* * The PEEKBIN method for the synonym-stream device)
(\PEEKBIN (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
NOERRORFLG?])
(%%SYNONYM-STREAM-DEVICE-READP
(LAMBDA (STREAM FLG)
(READP (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
FLG)))
(%%SYNONYM-STREAM-DEVICE-BACKFILEPTR
(LAMBDA (STREAM) (* hdj "26-Aug-86 17:35")
(\BACKFILEPTR (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))))
(%%SYNONYM-STREAM-DEVICE-SETFILEINFO
[LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* hdj
"19-Mar-86 17:17")
(* * The SETFILEINFO method for the synonym-stream device.)
(SETFILEINFO (%%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)
ATTRIBUTE VALUE])
)
(DEFINEQ
(%%TWO-WAY-STREAM-DEVICE-BIN
[LAMBDA (stream) (* smL "14-Aug-85 16:44")
(* * The BIN method for the two-way-stream device)
(\BIN (fetch F1 of stream])
(%%TWO-WAY-STREAM-DEVICE-BOUT
(LAMBDA (STREAM BYTE) (* hdj "17-Sep-86 15:28")
(* ;; " the BOUT method for two-way streams")
(\BOUT (fetch F2 of STREAM)
BYTE)))
(%%TWO-WAY-STREAM-DEVICE-OUTCHARFN
(LAMBDA (STREAM CHARCODE) (* hdj "17-Sep-86 15:26")
(* ;; "outcharfn for two-way streams")
(\OUTCHAR (fetch (STREAM F2) of STREAM)
CHARCODE)))
(%%TWO-WAY-STREAM-DEVICE-CLOSEFILE
[LAMBDA (stream) (* smL "14-Aug-85 17:02")
(* * The CLOSEFILE method for the two-way-stream device)
(replace ACCESS of stream with NIL)
(CLOSEF? (fetch F1 of stream))
(replace F1 of stream with NIL)
(CLOSEF? (fetch F2 of stream))
(replace F2 of stream with NIL)
stream])
(%%TWO-WAY-STREAM-DEVICE-EOFP
[LAMBDA (stream) (* smL "14-Aug-85 16:47")
(* * The EOFP method for the two-way-stream device)
(\EOFP (fetch F1 of stream])
(%%TWO-WAY-STREAM-DEVICE-BACKFILEPTR
(LAMBDA (STREAM) (* hdj "15-Sep-86 15:02")
(\BACKFILEPTR (fetch (STREAM F1) of STREAM))))
(%%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT
[LAMBDA (stream waitForFinish?) (* smL "14-Aug-85 16:49")
(* * the FORCEOUTPUT method for the two-way-stream device)
(FORCEOUTPUT (fetch F2 of stream)
waitForFinish?])
(%%TWO-WAY-STREAM-DEVICE-OPENFILE
(LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* hdj "18-Sep-86 10:07")
(* * The OPENFILE method for the two-way-stream device)
(SELECTQ ACCESS
((INPUT OUTPUT APPEND)
NIL)
(create STREAM
DEVICE ← DEVICE
F1 ← (CADR (ASSOC (QUOTE INPUT-STREAM)
PARAMETERS))
F2 ← (CADR (ASSOC (QUOTE OUTPUT-STREAM)
PARAMETERS))
OUTCHARFN ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-OUTCHARFN)))))
(%%TWO-WAY-STREAM-DEVICE-PEEKBIN
[LAMBDA (stream noErrorFlg?) (* smL "14-Aug-85 16:46")
(* * The PEEKBIN method for the two-way-stream device)
(\PEEKBIN (fetch F1 of stream)
noErrorFlg?])
)
(DEFUN %%FILL-POINTER-STREAM-DEVICE-CLOSEFILE (STREAM)
(* * "the CLOSEFILE method for the fill-pointer-string-stream device")
(replace F1 of STREAM with NIL)
STREAM)
(DEFUN %%FILL-POINTER-STREAM-DEVICE-GETFILEPTR (STREAM) (CL:LENGTH (fetch (STREAM F1) of STREAM)))
(* "helper stuff")
(DEFINEQ
(%%SYNONYM-STREAM-DEVICE-GET-STREAM
[LAMBDA (stream) (* hdj
"19-Mar-86 14:59")
(* * given a synonym-stream, find out what it is currently tracking)
(* * this should be a macro)
(SYMBOL-VALUE (fetch (STREAM F1) of stream])
)
(* "package initialization")
(DEFVAR *TRACE-OUTPUT* )
(DEFVAR *DEBUG-IO* )
(DEFVAR *QUERY-IO* )
(DEFVAR *TERMINAL-IO* )
(DEFVAR *ERROR-OUTPUT* )
(DEFVAR *STANDARD-OUTPUT* )
(DEFVAR *STANDARD-INPUT* )
(DEFUN %%INITIALIZE-SYNONYM-IMAGEOPS NIL (SETQ \SYNONYM-STREAM-IMAGEOPS
(create IMAGEOPS
IMAGETYPE ← (QUOTE SYNONYM)
IMCLOSEFN ← (FUNCTION (LAMBDA (STREAM)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMCLOSEFN
)
SYN-STREAM
SYN-STREAM))))
IMXPOSITION ← (FUNCTION (LAMBDA (STREAM XPOSITION)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMXPOSITION
)
SYN-STREAM
SYN-STREAM
XPOSITION))))
IMYPOSITION ← (FUNCTION (LAMBDA (STREAM YPOSITION)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMYPOSITION
)
SYN-STREAM
SYN-STREAM
YPOSITION))))
IMFONT ← (FUNCTION (LAMBDA (STREAM FONT)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMFONT)
SYN-STREAM
SYN-STREAM FONT))))
IMLEFTMARGIN ← (FUNCTION (LAMBDA (STREAM XPOSITION)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMLEFTMARGIN
)
SYN-STREAM
SYN-STREAM
XPOSITION))))
IMRIGHTMARGIN ← (FUNCTION (LAMBDA (STREAM YPOSITION)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMRIGHTMARGIN
)
SYN-STREAM
SYN-STREAM
YPOSITION))))
IMLINEFEED ← (FUNCTION (LAMBDA (STREAM DELTAY)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMLINEFEED
)
SYN-STREAM
SYN-STREAM
DELTAY))))
IMDRAWLINE ←
(FUNCTION (LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH
OPERATION COLOR DASHING)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMDRAWLINE)
SYN-STREAM SYN-STREAM X1 Y1
X2 Y2 WIDTH OPERATION COLOR
DASHING))))
IMDRAWCURVE ←
(FUNCTION (LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING
)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMDRAWCURVE)
SYN-STREAM SYN-STREAM KNOTS
CLOSED BRUSH DASHING))))
IMDRAWCIRCLE ←
(FUNCTION (LAMBDA (STREAM CENTERX CENTRY RADIUS
BRUSH DASHING)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMDRAWCIRCLE)
SYN-STREAM SYN-STREAM
CENTERX CENTRY RADIUS BRUSH
DASHING))))
IMDRAWELLIPSE ←
(FUNCTION (LAMBDA (STREAM CENTERX CENTERY
SEMIMINORRADIUS
SEMIMAJORRADIUS ORIENTATION
BRUSH DASHING)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMDRAWELLIPSE)
SYN-STREAM SYN-STREAM
CENTERX CENTERY
SEMIMINORRADIUS
SEMIMAJORRADIUS ORIENTATION
BRUSH DASHING))))
IMFILLCIRCLE ←
(FUNCTION (LAMBDA (STREAM CENTERX CENTERY RADIUS
TEXTURE)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMFILLCIRCLE)
SYN-STREAM SYN-STREAM
CENTERX CENTERY RADIUS
TEXTURE))))
IMBLTSHADE ←
(FUNCTION (LAMBDA (TEXTURE STREAM DESTINATIONLEFT
DESTINATIONBOTTOM WIDTH
HEIGHT OPERATION
CLIPPINGREGION)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMBLTSHADE)
SYN-STREAM TEXTURE
SYN-STREAM DESTINATIONLEFT
DESTINATIONBOTTOM WIDTH
HEIGHT OPERATION
CLIPPINGREGION))))
IMBITBLT ←
(FUNCTION (LAMBDA (SOURCEBM SOURCELEFT SOURCEBOTTOM
STREAM DESTINATIONLEFT
DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION
TEXTURE CLIPPINGREGION
CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMBITBLT)
SYN-STREAM SOURCEBM
SOURCELEFT SOURCEBOTTOM
STREAM DESTINATIONLEFT
DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION
TEXTURE CLIPPINGREGION
CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM))))
IMNEWPAGE ← (FUNCTION (LAMBDA (STREAM)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMNEWPAGE
)
SYN-STREAM))))
IMMOVETO ← (FUNCTION (LAMBDA (STREAM X Y)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMMOVETO
)
SYN-STREAM
SYN-STREAM X Y)))
)
IMSCALE ← (FUNCTION (LAMBDA (STREAM SCALE)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMSCALE)
SYN-STREAM
SYN-STREAM SCALE))
))
IMTERPRI ← (FUNCTION (LAMBDA (STREAM)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMTERPRI
)
SYN-STREAM
SYN-STREAM))))
IMTOPMARGIN ← (FUNCTION (LAMBDA (STREAM YPOSITION)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMTOPMARGIN
)
SYN-STREAM
SYN-STREAM
YPOSITION))))
IMBOTTOMMARGIN ← (FUNCTION (LAMBDA (STREAM YPOSITION
)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMBOTTOMMARGIN
)
SYN-STREAM
SYN-STREAM
YPOSITION))))
IMSPACEFACTOR ← (FUNCTION (LAMBDA (STREAM FACTOR)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMSPACEFACTOR
)
SYN-STREAM
SYN-STREAM
FACTOR))))
IMFONTCREATE ← (QUOTE SYNONYM)
IMOPERATION ← (FUNCTION (LAMBDA (STREAM OPERATION)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMOPERATION
)
SYN-STREAM
SYN-STREAM
OPERATION))))
IMCOLOR ← (FUNCTION (LAMBDA (STREAM COLOR)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMCOLOR)
SYN-STREAM
SYN-STREAM COLOR))
))
IMSTRINGWIDTH ←
(FUNCTION (LAMBDA (STREAM STRING RDTBL)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMSTRINGWIDTH)
SYN-STREAM SYN-STREAM STRING
RDTBL))))
IMCHARWIDTH ← (FUNCTION (LAMBDA (STREAM CHARCODE)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMCHARWIDTH
)
SYN-STREAM
SYN-STREAM
CHARCODE))))
IMCHARWIDTHY ←
(FUNCTION (LAMBDA (STREAM A B CHARCODE)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMCHARWIDTHY)
SYN-STREAM SYN-STREAM A B
CHARCODE))))
IMBACKCOLOR ← (FUNCTION (LAMBDA (STREAM COLOR)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMBACKCOLOR
)
SYN-STREAM
SYN-STREAM
COLOR))))
IMBITMAPSIZE ← (FUNCTION (LAMBDA (STREAM BITMAP
DIMENSION)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMBITMAPSIZE
)
SYN-STREAM
SYN-STREAM BITMAP
DIMENSION))))
IMCLIPPINGREGION ← (FUNCTION (LAMBDA (STREAM REGION)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP
(QUOTE
IMCLIPPINGREGION
)
SYN-STREAM
SYN-STREAM REGION))
))
IMRESET ← (FUNCTION (LAMBDA (STREAM)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMRESET)
SYN-STREAM
SYN-STREAM))))
IMDRAWPOLYGON ←
(FUNCTION (LAMBDA (STREAM POINTS CLOSED BRUSH
DASHING)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMDRAWPOLYGON)
SYN-STREAM SYN-STREAM POINTS
CLOSED BRUSH DASHING))))
IMFILLPOLYGON ←
(FUNCTION (LAMBDA (STREAM POINTS TEXTURE OPERATION
WINDINGNUMBER)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMFILLPOLYGON)
SYN-STREAM SYN-STREAM POINTS
TEXTURE OPERATION
WINDINGNUMBER))))
IMSCALEDBITBLT ←
(FUNCTION (LAMBDA (STREAM SOURCE SOURCELEFT
SOURCEBOTTOM DESTINATION
DESTINATIONLEFT
DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION
TEXTURE CLIPPINGREGION
CLIPPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM SCALE)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMSCALEDBITBLT)
STREAM SYN-STREAM SOURCE
SOURCELEFT SOURCEBOTTOM
DESTINATION DESTINATIONLEFT
DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION
TEXTURE CLIPPINGREGION
CLIPPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM SCALE)))
)
IMWRITEPIXEL ←
(FUNCTION (LAMBDA (STREAM STREAM X Y VALUE)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMWRITEPIXEL)
SYN-STREAM SYN-STREAM X Y
VALUE))))
IMCHARSET ← (FUNCTION (LAMBDA (STREAM CHARSET)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM))))
(IMAGEOP (QUOTE IMCHARSET)
SYN-STREAM SYN-STREAM
CHARSET)))
IMROTATE ← (FUNCTION (LAMBDA (STREAM ROTATION)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMROTATE
)
SYN-STREAM
SYN-STREAM
ROTATION))))
IMDRAWARC ←
(FUNCTION (LAMBDA (STREAM CENTERX CENTERY RADIUS
STARTANGLE DEGREES BRUSH
DASHING)
(LET ((SYN-STREAM (
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMDRAWARC)
SYN-STREAM SYN-STREAM
CENTERX CENTERY RADIUS
STARTANGLE DEGREES BRUSH
DASHING))))
IMTRANSLATE ← (FUNCTION (LAMBDA (STREAM TX TY)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMTRANSLATE
)
SYN-STREAM
SYN-STREAM TX
TY))))
IMSCALE2 ← (FUNCTION (LAMBDA (STREAM SX SY)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE IMSCALE2
)
SYN-STREAM
SYN-STREAM SX SY)
)))
IMPUSHSTATE ← (FUNCTION (LAMBDA (STREAM)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM))))
(IMAGEOP (QUOTE
IMPUSHSTATE
)
SYN-STREAM
SYN-STREAM)))
IMPOPSTATE ← (FUNCTION (LAMBDA (STREAM)
(LET ((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMPOPSTATE
)
SYN-STREAM
SYN-STREAM))))
IMDEFAULTSTATE ← (FUNCTION (LAMBDA (STREAM)
(LET
((SYN-STREAM
(
%%SYNONYM-STREAM-DEVICE-GET-STREAM
STREAM)))
(IMAGEOP (QUOTE
IMDEFAULTSTATE
)
SYN-STREAM
SYN-STREAM)))))
))
(DEFUN %%INITIALIZE-STANDARD-STREAMS NIL (*)
(SETQ *QUERY-IO* (MAKE-TWO-WAY-STREAM (MAKE-SYNONYM-STREAM
(QUOTE \LINEBUF.OFD))
(MAKE-SYNONYM-STREAM (QUOTE
\TERM.OFD
))))
(SETQ *DEBUG-IO* *QUERY-IO*)
(SETQ *TERMINAL-IO* *QUERY-IO*)
(SETQ *ERROR-OUTPUT* (MAKE-SYNONYM-STREAM (QUOTE \TERM.OFD))
)
(SETQ *STANDARD-OUTPUT* (MAKE-SYNONYM-STREAM (QUOTE
\PRIMOUT.OFD
)))
(SETQ *STANDARD-INPUT* (MAKE-SYNONYM-STREAM (QUOTE
\PRIMIN.OFD
)))
(SETQ *TRACE-OUTPUT* (MAKE-SYNONYM-STREAM (QUOTE \TERM.OFD))
))
(DEFINEQ
(%%INITIALIZE-CLSTREAM-TYPES
(LAMBDA NIL (* hdj "15-Sep-86 15:11")
(* * "Initialize the CLSTREAMS package. This sets up some file devices for the functions make-two-way-stream-device, etc. See CLtL chapter 21")
(DECLARE (GLOBALVARS \FILL-POINTER-STREAM-DEVICE))
(\DEFINEDEVICE (QUOTE BROADCAST-STREAM-DEVICE)
(create FDEV
DEVICENAME ← (QUOTE BROADCAST-STREAM-DEVICE)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
BUFFERED ← NIL
PAGEMAPPED ← NIL
FDBINABLE ← NIL
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
DEVICEINFO ← NIL
HOSTNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION %%BROADCAST-STREAM-DEVICE-OPENFILE)
REOPENFILE ← (FUNCTION NILL)
CLOSEFILE ← (FUNCTION %%BROADCAST-STREAM-DEVICE-CLOSEFILE)
GETFILENAME ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
RENAMEFILE ← (FUNCTION NILL)
BIN ← (FUNCTION NILL)
BOUT ← (FUNCTION %%BROADCAST-STREAM-DEVICE-BOUT)
PEEKBIN ← (FUNCTION NILL)
READP ← (FUNCTION NILL)
EOFP ← (FUNCTION TRUE)
BLOCKIN ← (FUNCTION \GENERIC.BINS)
BLOCKOUT ← (FUNCTION NILL)
FORCEOUTPUT ← (FUNCTION %%BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
GETFILEINFO ← (FUNCTION NILL)
SETFILEINFO ← (FUNCTION NILL)))
(\DEFINEDEVICE (QUOTE CONCATENATED-STREAM-DEVICE)
(create FDEV
DEVICENAME ← (QUOTE CONCATENATED-STREAM-DEVICE)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
BUFFERED ← NIL
PAGEMAPPED ← NIL
FDBINABLE ← NIL
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
DEVICEINFO ← NIL
HOSTNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION %%CONCATENATED-STREAM-DEVICE-OPENFILE)
REOPENFILE ← (FUNCTION NILL)
CLOSEFILE ← (FUNCTION %%CONCATENATED-STREAM-DEVICE-CLOSEFILE)
GETFILENAME ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
RENAMEFILE ← (FUNCTION NILL)
BIN ← (FUNCTION %%CONCATENATED-STREAM-DEVICE-BIN)
BOUT ← (FUNCTION NILL)
PEEKBIN ← (FUNCTION %%CONCATENATED-STREAM-DEVICE-PEEKBIN)
READP ← (FUNCTION \GENERIC.READP)
EOFP ← (FUNCTION %%CONCATENATED-STREAM-DEVICE-EOFP)
BLOCKIN ← (FUNCTION \GENERIC.BINS)
BLOCKOUT ← (FUNCTION NILL)
FORCEOUTPUT ← (FUNCTION NILL)
GETFILEINFO ← (FUNCTION NILL)
SETFILEINFO ← (FUNCTION NILL)))
(\DEFINEDEVICE (QUOTE TWO-WAY-STREAM-DEVICE)
(create FDEV
DEVICENAME ← (QUOTE TWO-WAY-STREAM-DEVICE)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
BUFFERED ← NIL
PAGEMAPPED ← NIL
FDBINABLE ← NIL
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
DEVICEINFO ← NIL
HOSTNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-OPENFILE)
REOPENFILE ← (FUNCTION NILL)
CLOSEFILE ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-CLOSEFILE)
GETFILENAME ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
RENAMEFILE ← (FUNCTION NILL)
BIN ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-BIN)
BOUT ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-BOUT)
PEEKBIN ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-PEEKBIN)
READP ← (FUNCTION \GENERIC.READP)
BACKFILEPTR ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-BACKFILEPTR)
EOFP ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-EOFP)
BLOCKIN ← (FUNCTION \GENERIC.BINS)
BLOCKOUT ← (FUNCTION \GENERIC.BOUTS)
FORCEOUTPUT ← (FUNCTION %%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT)
GETFILEINFO ← (FUNCTION NILL)
SETFILEINFO ← (FUNCTION NILL)))
(\DEFINEDEVICE (QUOTE ECHO-STREAM-DEVICE)
(create FDEV using (\GETDEVICEFROMNAME (QUOTE TWO-WAY-STREAM-DEVICE))
DEVICENAME ← (QUOTE ECHO-STREAM-DEVICE)
BIN ← (FUNCTION %%ECHO-STREAM-DEVICE-BIN)))
(\DEFINEDEVICE (QUOTE SYNONYM-STREAM-DEVICE)
(create FDEV
DEVICENAME ← (QUOTE SYNONYM-STREAM-DEVICE)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
BUFFERED ← NIL
PAGEMAPPED ← NIL
FDBINABLE ← NIL
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
DEVICEINFO ← NIL
HOSTNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION %%SYNONYM-STREAM-DEVICE-OPENFILE)
REOPENFILE ← (FUNCTION NILL)
CLOSEFILE ← (FUNCTION %%SYNONYM-STREAM-DEVICE-CLOSEFILE)
GETFILENAME ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
RENAMEFILE ← (FUNCTION NILL)
BIN ← (FUNCTION %%SYNONYM-STREAM-DEVICE-BIN)
BOUT ← (FUNCTION %%SYNONYM-STREAM-DEVICE-BOUT)
PEEKBIN ← (FUNCTION %%SYNONYM-STREAM-DEVICE-PEEKBIN)
READP ← (FUNCTION %%SYNONYM-STREAM-DEVICE-READP)
BACKFILEPTR ← (FUNCTION %%SYNONYM-STREAM-DEVICE-BACKFILEPTR)
EOFP ← (FUNCTION %%SYNONYM-STREAM-DEVICE-EOFP)
BLOCKIN ← (FUNCTION \GENERIC.BINS)
BLOCKOUT ← (FUNCTION \GENERIC.BOUTS)
FORCEOUTPUT ← (FUNCTION %%SYNONYM-STREAM-DEVICE-FORCEOUTPUT)
GETFILEINFO ← (FUNCTION %%SYNONYM-STREAM-DEVICE-GETFILEINFO)
SETFILEINFO ← (FUNCTION %%SYNONYM-STREAM-DEVICE-SETFILEINFO)))
(SETQ \FILL-POINTER-STREAM-DEVICE
(create FDEV
DEVICENAME ← (QUOTE FILL-POINTER-STREAM-DEVICE)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
BUFFERED ← NIL
PAGEMAPPED ← NIL
FDBINABLE ← NIL
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
DEVICEINFO ← NIL
HOSTNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION NILL)
REOPENFILE ← (FUNCTION NILL)
CLOSEFILE ← (FUNCTION %%FILL-POINTER-STREAM-DEVICE-CLOSEFILE)
GETFILENAME ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
RENAMEFILE ← (FUNCTION NILL)
BIN ← (FUNCTION \ILLEGAL.DEVICEOP)
BOUT ← (FUNCTION NILL)
PEEKBIN ← (FUNCTION \ILLEGAL.DEVICEOP)
READP ← (FUNCTION \ILLEGAL.DEVICEOP)
EOFP ← (FUNCTION NILL)
BLOCKIN ← (FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT ← (FUNCTION \GENERIC.BOUTS)
FORCEOUTPUT ← (FUNCTION NILL)
GETFILEPTR ← (FUNCTION %%FILL-POINTER-STREAM-DEVICE-GETFILEPTR)
SETFILEINFO ← (FUNCTION \ILLEGAL.DEVICEOP)))))
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(%%INITIALIZE-CLSTREAM-TYPES)
(%%INITIALIZE-STANDARD-STREAMS)
(* (%%INITIALIZE-SYNONYM-IMAGEOPS))
)
(PUTPROPS CLSTREAMS FILETYPE COMPILE-FILE)
(DEFSETF FILE-STREAM-POSITION SETFILEPTR)
(PUTPROPS CLSTREAMS COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (25261 27174 (%%BROADCAST-STREAM-DEVICE-BOUT 25271 . 25566) (
%%BROADCAST-STREAM-DEVICE-OUTCHARFN 25568 . 25917) (%%BROADCAST-STREAM-DEVICE-CLOSEFILE 25919 . 26346)
(%%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 26348 . 26653) (%%BROADCAST-STREAM-DEVICE-OPENFILE 26655 .
27172)) (27175 29804 (%%CONCATENATED-STREAM-DEVICE-BIN 27185 . 27765) (
%%CONCATENATED-STREAM-DEVICE-CLOSEFILE 27767 . 28167) (%%CONCATENATED-STREAM-DEVICE-EOFP 28169 . 28699
) (%%CONCATENATED-STREAM-DEVICE-OPENFILE 28701 . 29145) (%%CONCATENATED-STREAM-DEVICE-PEEKBIN 29147 .
29802)) (29805 30115 (%%ECHO-STREAM-DEVICE-BIN 29815 . 30113)) (30116 34316 (
%%SYNONYM-STREAM-DEVICE-BIN 30126 . 30484) (%%SYNONYM-STREAM-DEVICE-BOUT 30486 . 30864) (
%%SYNONYM-STREAM-DEVICE-OUTCHARFN 30866 . 31193) (%%SYNONYM-STREAM-DEVICE-CLOSEFILE 31195 . 31566) (
%%SYNONYM-STREAM-DEVICE-EOFP 31568 . 31929) (%%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 31931 . 32338) (
%%SYNONYM-STREAM-DEVICE-GETFILEINFO 32340 . 32743) (%%SYNONYM-STREAM-DEVICE-OPENFILE 32745 . 33166) (
%%SYNONYM-STREAM-DEVICE-PEEKBIN 33168 . 33561) (%%SYNONYM-STREAM-DEVICE-READP 33563 . 33697) (
%%SYNONYM-STREAM-DEVICE-BACKFILEPTR 33699 . 33903) (%%SYNONYM-STREAM-DEVICE-SETFILEINFO 33905 . 34314)
) (34317 37241 (%%TWO-WAY-STREAM-DEVICE-BIN 34327 . 34562) (%%TWO-WAY-STREAM-DEVICE-BOUT 34564 . 34860
) (%%TWO-WAY-STREAM-DEVICE-OUTCHARFN 34862 . 35178) (%%TWO-WAY-STREAM-DEVICE-CLOSEFILE 35180 . 35638)
(%%TWO-WAY-STREAM-DEVICE-EOFP 35640 . 35874) (%%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 35876 . 36070) (
%%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 36072 . 36349) (%%TWO-WAY-STREAM-DEVICE-OPENFILE 36351 . 36970) (
%%TWO-WAY-STREAM-DEVICE-PEEKBIN 36972 . 37239)) (37592 38042 (%%SYNONYM-STREAM-DEVICE-GET-STREAM 37602
. 38040)) (82695 91185 (%%INITIALIZE-CLSTREAM-TYPES 82705 . 91183)))))
STOP