Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/scheme/boxer/boxer.lha/stream.lisp

Text File | 1993-07-17 | 20.0 KB | 623 lines

;;; -*- MODE: LISP; PACKAGE: (BOXER GLOBAL 1000); BASE: 10.; FONTS: CPTFONT, CPTFONTB -*-

#||
            1Copyright 1985 Massachusetts Institute of Technology

 Permission to use, copy, modify, distribute, and sell this software
 and its documentation for any purpose is hereby granted without fee,
 provided that the above copyright notice appear in all copies and that
 both that copyright notice and this permission notice appear in
 supporting documentation, and that the name of M.I.T. not be used in
 advertising or publicity pertaining to distribution of the software
 without specific, written prior permission.  M.I.T. makes no
 representations about the suitability of this software for any
 purpose.  It is provided "as is" without express or implied warranty.


0                    1This file is part of the BOXER system
0
 The stream represenations of 1BOXER-STREAMS0 look like:

 1BOX-STREAM    0==  [<init-plist> <row-stream-0> <row-stream-1> ... ]
 1ROW-STREAM    0==  {<cha-stream-0> <cha-stream-1> ...}
 1CHA-STREAM    0==  <box-stream> | <lispm-char-code>
 1EDITOR-STREAM0 ==  {<cha-stream-0> <cha-stream-1>...} ROW-STREAM-1 ROW-STREAM-2...

||#

(SETQ *PORT-HASH-TABLE* (MAKE-HASH-TABLE))

(DEFCONST *STRT-BOX-CODE* #\[)
(DEFCONST *STOP-BOX-CODE* #\])
(DEFCONST *STRT-ROW-CODE* #\{)
(DEFCONST *STOP-ROW-CODE* #\})
(DEFCONST *QUOTE-CODE* #/)
(DEFCONST *BOXER-STREAM-SPECIAL-CHARACTERS*
      (STRING-APPEND *STRT-ROW-CODE* *STRT-BOX-CODE*
             *STOP-ROW-CODE* *STOP-BOX-CODE*
             *QUOTE-CODE*))


(DEFSUBST STRT-BOX-CODE? (X)
  (EQ X  *STRT-BOX-CODE*))
(DEFSUBST STOP-BOX-CODE? (X)
  (EQ X  *STOP-BOX-CODE*))
(DEFSUBST STRT-ROW-CODE? (X)
  (EQ X  *STRT-ROW-CODE*))
(DEFSUBST STOP-ROW-CODE? (X)
  (EQ X  *STOP-ROW-CODE*))
(DEFSUBST QUOTE-CODE? (X)
  (EQ X *QUOTE-CODE*))


;;;flavor and macro Definitions

(DEFFLAVOR BOXER-STREAM
    ()
    ()
  :ABSTRACT-FLAVOR
  (:REQUIRED-METHODS :TYI :TYI-OR-STREAM :UNTYI :TYIPEEK)
  (:DEFAULT-HANDLER BOXER-STREAM-DEFAULT-HANDLER)
  (:DOCUMENTATION  :ESSENTIAL-MIXIN
   "This is an abstract flavor, it is not possible to make instances of the
    BOXER-STREAM flavor. This flavor exists only to mixin to other flavors
    of boxer-streams to provide some functionality common to all kinds of
    boxer-streams. Specifically having this flavor mixed in makes the type
    checking predicate BOXER-STREAM? return t, and sets things up so that
    STREAM-DEFAULT-HANDLER will get called whenever a boxer-stream receives
    a message it doesn't handle."))

(DEFUN BOXER-STREAM-DEFAULT-HANDLER (SELF IGNORE OP &OPTIONAL ARG1 &REST ARGS)
  (STREAM-DEFAULT-HANDLER SELF OP ARG1 ARGS))

(DEFTYPE-CHECKING-MACROS BOXER-STREAM "A Boxer Editor Stream")

(DEFFLAVOR STRING-STREAM
    ((STRING NIL)
     (POINTER 0))
    (BOXER-STREAM)
  (:INIT-KEYWORDS :STRING))

(DEFFLAVOR PDL-STREAM
    ((PDL NIL))
    (BOXER-STREAM)
  (:INIT-KEYWORDS :PDL))

(DEFFLAVOR ROW-STREAM
    ((ROW NIL)
     (CHA-NO 0))
    (PDL-STREAM)
  (:INIT-KEYWORDS :ROW :CHAS))

(DEFTYPE-CHECKING-MACROS ROW-STREAM "a Row-Stream")

(DEFFLAVOR BOX-STREAM
    ((BOX NIL))
    (PDL-STREAM)
  (:INIT-KEYWORDS :BOX :INIT-PLIST :ROWS))

(DEFTYPE-CHECKING-MACROS BOX-STREAM "a Box-Stream")

(DEFFLAVOR EDITOR-STREAM
    ()
    (PDL-STREAM)
  (:INIT-KEYWORDS :ROWS :START-CHAS :END-CHAS))

(DEFTYPE-CHECKING-MACROS EDITOR-STREAM "An Editor Stream")



;;; The major function defined by this file for use outside of this file is
;;; MAKE-BOXER-STREAM. Make-Boxer-Stream takes any Boxer Obj or the lisp
;;; representation for any Boxer-Stream, and makes a Boxer-Stream object out
;;; of it. This function is the fundamental type coercer used by the Boxer
;;; Editor. This function will-
;;;   Make any of the following into a Box-Stream:
;;;      <box> | (:BOX <init-plist> <row-stream-0> <row-stream-1> ...)
;;;   Make any of the following into a Row-Stream:
;;;      <row> | (:ROW <cha-stream-0> <cha-stream-1> ...)
;;;   Make any of the following into a Cha-Stream:
;;;      <cha> | <row-entry> | <string> | <symbol> | <cha-code> | <list of these>
;;;      Note that a row-entry  is tested with ROW-ENTRY?

(DEFUN MAKE-BOXER-STREAM (STUFF &OPTIONAL OTHER-BP)
  (COND ((BOXER-STREAM? STUFF)
     STUFF)
    ((BOX? STUFF)
     (MAKE-BOX-STREAM STUFF))
    ((ROW? STUFF)
     (MAKE-ROW-STREAM STUFF))
    ((CHA? STUFF)
     (MAKE-CHA-STREAM STUFF))
    ((EDITOR-REGION? STUFF)
     (MAKE-STREAM-FROM-BPS (TELL STUFF :START-BP) (TELL STUFF :STOP-BP)))
    ((AND (BP? STUFF) (BP? OTHER-BP))
     (MAKE-STREAM-FROM-BPS STUFF OTHER-BP))
    ((BP? STUFF)
     (FERROR "You have to specify two BP's. ~A was not a BP" OTHER-BP))
    ((LISTP STUFF)
     (FUNCALL (GET (CAR STUFF) ':MAKE-BOXER-STREAM) STUFF))
    (T
     (FUNCALL (GET (TYPEP STUFF) ':MAKE-BOXER-STREAM) STUFF))))



(DEFPROP :BOX MAKE-BOX-STREAM :MAKE-BOXER-STREAM)

(DEFUN MAKE-BOX-STREAM (STUFF)
  (COND ((BOXER-STREAM? STUFF) STUFF)
    ((BOX? STUFF)
     (MAKE-INSTANCE 'BOX-STREAM ':BOX STUFF
            ':INIT-PLIST (TELL STUFF :RETURN-INIT-PLIST-FOR-COPY)))
    ((AND (LISTP STUFF) (EQ (CAR STUFF) ':BOX))
     (MAKE-INSTANCE 'BOX-STREAM ':INIT-PLIST (CADR STUFF)
                    ':ROWS (CDDR STUFF)))
    (T
     (FERROR "Can't make a Box-Stream out of ~S." STUFF))))


;since this crock machine represents characters as fixnums, we must change all
;numbers to strings at this level.  there are probably other functions that
;make streams that need to do this to, but this might the only one.

(DEFPROP :ROW MAKE-ROW-STREAM :MAKE-BOXER-STREAM)

;;; This is used by MAKE-ROW-STREAM only....
(DEFMACRO GET-ROW-STREAM-ELEMENT (CHUNK)
  `(COND ((NUMBERP ,CHUNK)
      (SETQ ALREADY-SPACES? NIL)
      (COLLECT (FORMAT NIL "~A",CHUNK)))
     ((SPACES? ,CHUNK)
      (SETQ ALREADY-SPACES? T)
      (DOTIMES
        (I (GET-SPACES ,CHUNK))
        (COLLECT #\SPACE)))
     ((AND (SYMBOLP ,CHUNK) (GET ,CHUNK 'CONVERTED-CHARACTER))
      (SETQ ALREADY-SPACES? T)
      (COLLECT (GET ,CHUNK 'CONVERTED-CHARACTER)))
     ((EVBOX? ,CHUNK)
      (SETQ ALREADY-SPACES? NIL)
      (COLLECT(MAKE-BOXER-STREAM ,CHUNK)))
     (T (SETQ ALREADY-SPACES? NIL)
        (COLLECT ,CHUNK))))

(DEFUN MAKE-ROW-STREAM (STUFF)
  (COND ((BOXER-STREAM? STUFF) STUFF)
    ((ROW? STUFF)
     (MAKE-INSTANCE 'ROW-STREAM ':ROW STUFF))
    ((AND (LISTP STUFF) (EQ (CAR STUFF) ':ROW))
     (MAKE-INSTANCE 'ROW-STREAM ':CHAS (WITH-COLLECTION
                         (DO ((CHUNKS (CDR STUFF) (CDR CHUNKS))
                          (ALREADY-SPACES? NIL))
                         ((NULL CHUNKS))
                           (GET-ROW-STREAM-ELEMENT(CAR CHUNKS))
                           ;; make sure spaces get put in between items
                           (UNLESS (OR ALREADY-SPACES? ;spaces just put in
                               (NULL (CDR CHUNKS)) ;last item
                               ;; spaces about to be put in
                               (SPACES? (CADR CHUNKS)))
                         (COLLECT #\SPACE))))))
    (T
     (FERROR "Can't make a Row-Stream out of ~S." STUFF))))

(DEFPROP :CHA MAKE-CHA-STREAM :MAKE-BOXER-STREAM)
(DEFPROP :STRING MAKE-CHA-STREAM :MAKE-BOXER-STREAM)
(DEFPROP :SYMBOL MAKE-CHA-STREAM :MAKE-BOXER-STREAM)
(DEFPROP :FIXNUM MAKE-CHA-STREAM :MAKE-BOXER-STREAM)

(DEFUN MAKE-CHA-STREAM (STUFF)
  (COND ((BOXER-STREAM? STUFF) STUFF)
    ((CHA? STUFF)
     (MAKE-PDL-STREAM `(,(CHA-CODE STUFF))))
    ((OR (STRINGP STUFF) (SYMBOLP STUFF) (FIXNUMP STUFF))
     (MAKE-STRING-STREAM (STRING STUFF)))
    (T
     (FERROR "Can't make a Cha-Stream out of ~S" STUFF))))

(DEFUN MAKE-STRING-STREAM (STRING)
  (MAKE-INSTANCE 'STRING-STREAM ':STRING STRING))

;;; Making an arbitrary stream between two BP's
(DEFUN MAKE-STREAM-FROM-BPS (START-BP STOP-BP)
  (LET ((START-ROW (BP-ROW START-BP)) (STOP-ROW (BP-ROW STOP-BP)))
    (COND ((EQ (BP-ROW START-BP) (BP-ROW STOP-BP))
       (MAKE-INSTANCE 'EDITOR-STREAM
              :START-CHAS
              (TELL START-ROW :CHAS-BETWEEN-CHA-NOS
                          (BP-CHA-NO START-BP)
                      (BP-CHA-NO STOP-BP))))
      (T
       (MAKE-INSTANCE 'EDITOR-STREAM
              :START-CHAS
              (TELL START-ROW :CHAS-BETWEEN-CHA-NOS (BP-CHA-NO START-BP))
              :ROWS
              (LOOP FOR ROW = (TELL START-ROW :NEXT-ROW) THEN (TELL ROW :NEXT-ROW)
                UNTIL (EQ ROW STOP-ROW)
                COLLECTING ROW)
              :END-CHAS
              (TELL STOP-ROW :CHAS-BETWEEN-CHA-NOS 0 (BP-CHA-NO STOP-BP)))))))



(DEFMETHOD (STRING-STREAM :INIT) (INIT-PLIST)
  (TELL SELF :SET-STRING (GET INIT-PLIST ':STRING)))

(DEFMETHOD (STRING-STREAM :SET-STRING) (NEW-VALUE)
  (SETQ STRING (FORMAT NIL "~a" NEW-VALUE)
    POINTER 0))

(DEFMETHOD (STRING-STREAM :TYI) (&REST IGNORE)
  (PROG1 (TELL SELF :TYIPEEK)
     (INCF POINTER)))

(DEFMETHOD (STRING-STREAM :TYIPEEK) ()
  (COND ((NULL STRING) NIL)
    ((= POINTER (STRING-LENGTH STRING))
     (SETQ STRING NIL))
    (T
     (CHARACTER (SUBSTRING STRING POINTER (+ POINTER 1))))))

(DEFMETHOD-ALIAS (STRING-STREAM :TYI-OR-STREAM) :TYI)

(DEFMETHOD (STRING-STREAM :UNTYI) (IGNORE)
  (DECF POINTER))




(DEFUN MAKE-PDL-STREAM (PDL)
  (MAKE-INSTANCE 'PDL-STREAM ':PDL PDL))

(DEFMETHOD (PDL-STREAM :INIT) (INIT-PLIST)
  (TELL SELF :SET-PDL (GET INIT-PLIST ':PDL)))

(DEFMETHOD (PDL-STREAM :GET-PDL) ()
  PDL)

(DEFMETHOD (PDL-STREAM :SET-PDL) (NEW-VALUE)
  (SETQ PDL NEW-VALUE))

(DEFWHOPPER (PDL-STREAM :TYI) (&REST IGNORE)
  (TELL SELF :PDL-STREAM-TYI NIL))

(DEFWHOPPER (PDL-STREAM :TYI-OR-STREAM) (&REST IGNORE)
  (TELL SELF :PDL-STREAM-TYI T))

;;; In order to make it easier for flavors which include the pdl-stream flavor
;;; to define the required :PDL-STREAM-TYI message, the pdl-stream flavor has
;;; a whopper around the :pdl-stream-tyi message that handles the message in
;;; all the "easy" cases. Specifically, the main :pdl-stream-tyi method will
;;; not be called if:
;;;  The pdl is empty
;;;       Returns nil.
;;;  The top of the pdl is a fixnum.
;;;       Returns and pops the fixnum.
;;;  The top of the pdl is a boxer-stream.
;;;      If return-stream? is non-nil returns the stream.
;;;      If the stream is empty, pops the stream and strts
;;;      over again. Otherwise returns what ever the stream
;;;      returns.

(DEFWHOPPER (PDL-STREAM :PDL-STREAM-TYI) (RETURN-STREAM?)
  (COND ((NULL PDL) NIL)
    ((NULL (CAR PDL))
     (POP PDL)
     (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?))
    ((FIXNUMP (CAR PDL))
     (POP PDL))
    ((AND (BOXER-STREAM? (CAR PDL))
          (NOT-NULL RETURN-STREAM?))
     (POP PDL))
    ((BOXER-STREAM? (CAR PDL))
     (LET ((CHA-OR-STREAM (TELL (CAR PDL) :TYI-OR-STREAM)))
       (COND ((NULL CHA-OR-STREAM)
          (POP PDL)
          (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?))
         (T
          (PUSH CHA-OR-STREAM PDL)
          (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?)))))
    (T
     (CONTINUE-WHOPPER RETURN-STREAM?))))

;;; For those few people who use pdl streams themselves (not as mixins)
;;; pdl-streams try to win when what is on the pdl isn't a stream by
;;; calling make-boxer-stream on it.

(DEFMETHOD (PDL-STREAM :PDL-STREAM-TYI) (RETURN-STREAM?)
  (PUSH (MAKE-BOXER-STREAM (POP PDL)) PDL)
  (COND ((NULL RETURN-STREAM?)
     (TELL SELF :PDL-STREAM-TYI NIL))
    (T
     (POP PDL))))

;;; The PDL-STREAM flavor also handles the :UNTYI operation. This is done by
;;; pushing the cha to be untyied onto the pdl. In addition, the fact that
;;; this untyi is "unlimited" is used to implement the :TYIPEEK operation.

(DEFMETHOD (PDL-STREAM :UNTYI) (X)
  (push x pdl))
;This doesn't work.  Take it out when you know why.  (tries to stuff things
;into full string-streams.)
;  (COND ((BOXER-STREAM? (CAR PDL))
;     (FUNCALL (CAR PDL) ':UNTYI X))
;    (T
;     (PUSH X PDL))))

(DEFMETHOD (PDL-STREAM :TYIPEEK) ()
  (if (fixnump (car pdl)) (car pdl)
      (LET ((PEEK (TELL SELF :TYI)))
    (FUNCALL SELF ':UNTYI PEEK)
    PEEK)))




(DEFMETHOD (ROW-STREAM :INIT) (INIT-PLIST)
  (LET ((NEW-ROW (GET INIT-PLIST ':ROW))
    (NEW-CHAS (GET INIT-PLIST ':CHAS)))
    (COND ((ROW? NEW-ROW)
       (SETQ ROW NEW-ROW
         CHA-NO 0
         PDL `(,*STRT-ROW-CODE* ,NEW-ROW ,*STOP-ROW-CODE*)))
      (T
       (SETQ ROW NIL
         CHA-NO 0
         PDL (CONS *STRT-ROW-CODE* (APPEND NEW-CHAS `(,*STOP-ROW-CODE*))))))))

(DEFGET-METHOD (ROW-STREAM :ROW) ROW)

(DEFMETHOD (ROW-STREAM :PDL-STREAM-TYI) (RETURN-STREAM?)
  (COND ((ROW? (CAR PDL))
     (LET ((CHA (TELL ROW :CHA-AT-CHA-NO CHA-NO)))
       (COND ((AND (CHA? CHA) (NOT (BOX? CHA)))
          (INCF CHA-NO)
          (CHA-CODE CHA))
         ((BOX? CHA)
          (INCF CHA-NO)
          (PUSH (MAKE-BOXER-STREAM CHA) PDL)
          (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?))
         (T
          (POP PDL)
          (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?)))))
    (T
     (PUSH (MAKE-BOXER-STREAM (POP PDL)) PDL)
     (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?))))

(DEFMETHOD (ROW-STREAM :TYI-A-BOX) (&OPTIONAL (COPY? NIL))
  (WHEN (STRT-BOX-CODE? (CAR PDL))
    (POP PDL))
  (IF (BOX-STREAM? (CAR PDL))
      (COND  ((NULL (TELL (CAR PDL) :BOX))
          (LET ((NEW-BOX (MAKE-INITIALIZED-BOX)))
        (TELL SELF :UNTYI *STRT-BOX-CODE*)
        (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM SELF)
        NEW-BOX))
         ((NOT COPY?)
          (TELL (POP PDL) :BOX))
         (T
          (TELL (TELL (POP PDL) :BOX) :COPY)))
      (FERROR NIL "can't tyi-a-box from ~s" SELF)))

;;; New, for the chunker, get the next object (box or cha).  DOn't mess around
;;; Doesn't use the general model for streams.  Treats streams as cha-no-pointer and row
;;; The PDL isn't side-effected like it should be
(DEFMETHOD (ROW-STREAM :TYI-NEXT-THING) (&OPTIONAL (COPY? NIL))
  (COND ((ROW? ROW)
     (LET ((CHA (TELL ROW :CHA-AT-CHA-NO CHA-NO)))
       (INCF CHA-NO)
       (COND ((AND COPY? (BOX? CHA))
          (TELL CHA :COPY))
         (T CHA))))
    (T (FERROR "Don't know how to :TYI-NEXT-THING"))))

;;; Chunker uses this one too
(DEFMETHOD (ROW-STREAM :PEEK-NEXT-THING) (&OPTIONAL (COPY? NIL))
  (COND ((ROW? ROW)
     (LET ((CHA (TELL ROW :CHA-AT-CHA-NO CHA-NO)))
       (COND ((AND COPY? (BOX? CHA))
          (TELL CHA :COPY))
         (T CHA))))
    (T (FERROR "Don't know how to :TYI-NEXT-THING"))))



(DEFMETHOD (BOX-STREAM :INIT) (INIT-PLIST)
  (LET ((NEW-BOX (GET INIT-PLIST ':BOX))
    (NEW-ROWS (GET INIT-PLIST ':ROWS)))
    (COND ((BOX? NEW-BOX)
       (SETQ BOX NEW-BOX
         PDL `(,*STRT-BOX-CODE*
               ,(MAKE-STRING-STREAM (FORMAT NIL "~:S" (GET INIT-PLIST ':INIT-PLIST)))
               ,(TELL NEW-BOX :FIRST-INFERIOR-ROW)
               ,*STOP-BOX-CODE*)))
      (T
       (SETQ BOX NIL
         PDL (CONS *STRT-BOX-CODE*
               (CONS (MAKE-STRING-STREAM
                   (FORMAT NIL "~:S" (GET INIT-PLIST ':INIT-PLIST)))
                 (APPEND NEW-ROWS `(,*STOP-BOX-CODE*)))))))))

;;; the old one version
;(DEFMETHOD (BOX-STREAM :INIT) (INIT-PLIST)
;  (LET ((NEW-BOX (GET INIT-PLIST ':BOX))
;    (NEW-ROWS (GET INIT-PLIST ':ROWS)))
;    (COND ((PORT-BOX? NEW-BOX)
;       (SETQ BOX NEW-BOX
;         PDL `(,*STRT-BOX-CODE*
;               ,(MAKE-STRING-STREAM (FORMAT NIL "~:S" (GET INIT-PLIST ':INIT-PLIST)))
;               ,*STOP-BOX-CODE*)))
;      ((BOX? NEW-BOX)
;       (SETQ BOX NEW-BOX
;         PDL `(,*STRT-BOX-CODE*
;               ,(MAKE-STRING-STREAM (FORMAT NIL "~:S" (GET INIT-PLIST ':INIT-PLIST)))
;               ,(TELL NEW-BOX :FIRST-INFERIOR-ROW)
;               ,*STOP-BOX-CODE*)))
;      (T
;       (SETQ BOX NIL
;         PDL (CONS *STRT-BOX-CODE*
;               (CONS (MAKE-STRING-STREAM
;                   (FORMAT NIL "~:S" (GET INIT-PLIST ':INIT-PLIST)))
;                 (APPEND NEW-ROWS `(,*STOP-BOX-CODE*)))))))))


(DEFMETHOD (BOX-STREAM :BOX) ()
  (OR BOX
      (LET ((NEW-BOX (MAKE-INITIALIZED-BOX)))
    (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM SELF)
    NEW-BOX)))


(DEFGET-METHOD (BOX-STREAM :BOX) BOX)

(DEFMETHOD (BOX-STREAM :PDL-STREAM-TYI) (RETURN-STREAM?)
  (COND ((ROW? (CAR PDL))
     (LET* ((ROW (POP PDL))
        (NEXT-ROW (TELL ROW :NEXT-ROW)))
       (IF NEXT-ROW (PUSH NEXT-ROW PDL))
       (PUSH (MAKE-ROW-STREAM ROW) PDL))
     (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?))
    (T
     (PUSH (MAKE-ROW-STREAM (POP PDL)) PDL)
     (TELL SELF :PDL-STREAM-TYI RETURN-STREAM?))))

(DEFMETHOD (BOX-STREAM :TYI-A-ROW) (&OPTIONAL (COPY? NIL))
  (COND ((AND (ROW-STREAM? (CAR PDL)) (NOT COPY?))
     (TELL (POP PDL) :ROW))
    (T
     (LET ((NEW-ROW (MAKE-INITIALIZED-ROW)))
       (TELL NEW-ROW :SET-CONTENTS-FROM-STREAM SELF)
       NEW-ROW))))

(DEFMETHOD (EDITOR-STREAM :INIT) (INIT-PLIST)
  (LET ((START-CHAS (GET INIT-PLIST :START-CHAS))
    (END-CHAS   (GET INIT-PLIST :END-CHAS))
    (ROWS       (GET INIT-PLIST :ROWS)))
  (COND-EVERY ((NOT-NULL START-CHAS)
           (SETQ PDL (CONS *STRT-ROW-CODE* (APPEND START-CHAS `(,*STOP-ROW-CODE*)))))
          ((NOT-NULL ROWS)
           (NCONC PDL ROWS))
          ((NOT-NULL END-CHAS)
           (NCONC PDL (CONS *STRT-ROW-CODE* (APPEND END-CHAS `(,*STOP-ROW-CODE*))))))))



(DEFMETHOD (EDITOR-STREAM :TYI-A-ROW) (&OPTIONAL (COPY? NIL))
  (COND ((AND (ROW-STREAM? (CAR PDL)) (NOT COPY?))
     (TELL (POP PDL) :ROW))
    (T
     (LET ((NEW-ROW (MAKE-INITIALIZED-ROW)))
       (TELL NEW-ROW :SET-CONTENTS-FROM-STREAM SELF)
       NEW-ROW))))

(DEFMETHOD (EDITOR-STREAM :TYI-A-BOX) (&OPTIONAL (COPY? NIL))
  (WHEN (STRT-BOX-CODE? (CAR PDL))
    (POP PDL))
  (IF (BOX-STREAM? (CAR PDL))
      (COND  ((NULL (TELL (CAR PDL) :BOX))
          (LET ((NEW-BOX (MAKE-INITIALIZED-BOX)))
        (TELL SELF :UNTYI *STRT-BOX-CODE*)
        (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM SELF)
        NEW-BOX))
         ((NOT COPY?)
          (TELL (POP PDL) :BOX))
         (T
          (TELL (TELL (POP PDL) :BOX) :COPY)))
      (FERROR NIL "can't tyi-a-box from ~s" SELF)))

(DEFMETHOD (EDITOR-STREAM :INSERT-STREAM-CONTENTS-AT-BP) (BP &OPTIONAL (COPY? T))
  (LOOP FOR PEEK = (TELL SELF :TYIPEEK) THEN (TELL SELF :TYIPEEK)
    INITIALLY
    (COND ((STRT-ROW-CODE? PEEK)
           (INSERT-ROW-CHAS BP (TELL SELF :TYI-A-ROW COPY?)))
          (T (FERROR "Streams out of synch.")))
    UNTIL (NULL PEEK)
    DO
    (COND ((STRT-ROW-CODE? PEEK)
           (INSERT-ROW BP (TELL SELF :TYI-A-ROW COPY?)))
          (T (FERROR "Streams out of synch.")))))

(DEFMETHOD (BOX :SET-CONTENTS-FROM-STREAM) (STREAM &OPTIONAL (COPY? T) (IGNORE-PLIST NIL))
  (COND ((STRT-BOX-CODE? (FUNCALL STREAM ':TYI))
     ;; Stream in synch, OK to go ahead.
     (LET ((INIT-PLIST (READ STREAM)))
       (TELL SELF :SEMI-INIT (IF (NOT IGNORE-PLIST)
                     (LOCF INIT-PLIST)
                     (CONS NIL
                       (TELL SELF
                         :RETURN-INIT-PLIST-FOR-COPY))))
          (DO ((PEEK (FUNCALL STREAM ':TYIPEEK)
                 (FUNCALL STREAM ':TYIPEEK)))
              ((STOP-BOX-CODE? PEEK)
               (FUNCALL STREAM ':TYI))
            (COND ((AND (STRT-ROW-CODE? PEEK)
                (FUNCALL STREAM
                     ':OPERATION-HANDLED-P
                     ':TYI-A-ROW))
               (LET ((NEW-ROW (FUNCALL STREAM ':TYI-A-ROW COPY?)))
                 (TELL SELF :APPEND-ROW NEW-ROW)
                 (DOLIST (BOX (TELL NEW-ROW :BOXES-IN-ROW))
                   (TELL BOX :INSERT-SELF-ACTION))))
              ((STRT-ROW-CODE? PEEK)
               (LET ((NEW-ROW (MAKE-INITIALIZED-ROW)))
                 (TELL NEW-ROW :SET-CONTENTS-FROM-STREAM STREAM)
                 (TELL SELF :APPEND-ROW NEW-ROW)
                 (DOLIST (BOX (TELL NEW-ROW :BOXES-IN-ROW))
                   (TELL BOX :INSERT-SELF-ACTION))))
              (T
               (FERROR "Streams out of synch."))))))
    (T
     (FERROR "Streams out of synch."))))

(DEFMETHOD (ROW :SET-CONTENTS-FROM-STREAM) (STREAM &OPTIONAL (COPY? T))
  (COND ((STRT-ROW-CODE? (FUNCALL STREAM ':TYI))
     ;; Streams in synch, OK to go ahead.
     (DO ((PEEK (FUNCALL STREAM ':TYIPEEK) (FUNCALL STREAM ':TYIPEEK)))
         ((STOP-ROW-CODE? PEEK)
          (FUNCALL STREAM ':TYI))
       (COND
             ((AND (STRT-BOX-CODE? PEEK)
               (FUNCALL STREAM ':OPERATION-HANDLED-P ':TYI-A-BOX))
          (TELL SELF :APPEND-CHA (FUNCALL STREAM ':TYI-A-BOX COPY?)))
         ((STRT-BOX-CODE? PEEK)
          (LET ((NEW-BOX (MAKE-INITIALIZED-BOX)))
            (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM STREAM)
            (TELL SELF :APPEND-CHA NEW-BOX)))
         ((QUOTE-CODE? PEEK)
          (TELL SELF :APPEND-CHA (MAKE-CHA (FUNCALL STREAM ':TYI)))
          (TELL SELF :APPEND-CHA (MAKE-CHA (FUNCALL STREAM ':TYI))))
         (T (TELL SELF :APPEND-CHA (MAKE-CHA (FUNCALL STREAM ':TYI)))))))
    (T
     (FERROR "Streams out of synch."))))

;;; presumably, this can **ONLY** be called from within the (ROW :SET-CONTENTS-FROM-STREAM)
;;; method which has been passed a BOX-STREAM.   The PDL of the stream had better look like:
;;; (*STRT-BOX-CODE* #<BOX-STREAM  > ....other stuff...)
;;; This is necessary for the copying of GRAPHICS boxes which are themselves sub boxes of
;;; some other box which has been streamified

;;; We need this one for ports too

(DEFMETHOD (BOX-STREAM :TYI-A-BOX) (COPY?)
  (WHEN (STRT-BOX-CODE? (CAR PDL))
    (POP PDL))
  (IF (BOX-STREAM? (CAR PDL))
      (COND  ((NULL (TELL (CAR PDL) :BOX))
          (LET ((NEW-BOX (MAKE-INITIALIZED-BOX)))
        (TELL SELF :UNTYI *STRT-BOX-CODE*)
        (TELL NEW-BOX :SET-CONTENTS-FROM-STREAM SELF T)
        NEW-BOX))
         ((NOT COPY?)
          (TELL (POP PDL) :BOX))
         (T
          (TELL (TELL (POP PDL) :BOX) :COPY)))
      (FERROR NIL "can't tyi-a-box from ~s" SELF)))


;  (LET ((BOX-STREAM (CADR PDL)))
;    (COND ((AND (STRT-BOX-CODE? (CAR PDL)) (BOX-STREAM? BOX-STREAM))
;       (SETQ PDL (NTHCDR 2 PDL))
;       (IF COPY-P
;           (TELL (TELL BOX-STREAM :BOX) :COPY)
;           (TELL BOX-STREAM :BOX)))
;      (T (FERROR "Can't :TYI a box from the PDL, ~S, of the stream, ~S" PDL SELF)))))