TEXTOFD: Property OBJECTBYTE returned instead of image objects
This allows COMPARETEXT to work on TEDIT files
This commit is contained in:
rmkaplan
688
library/TEXTOFD
688
library/TEXTOFD
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Oct-2021 15:38:41"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;4 176302
|
||||
(FILECREATED "22-Dec-2021 10:29:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;12 182752
|
||||
|
||||
changes to%: (FNS \TEDITOUTCCODEFN)
|
||||
:CHANGES-TO (FNS \TEXTBIN \TEXTPEEKBIN)
|
||||
|
||||
previous date%: " 7-Oct-2021 08:41:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;3)
|
||||
:PREVIOUS-DATE "22-Dec-2021 10:01:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;11)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -31,7 +30,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE
|
||||
\INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE))
|
||||
(COMS (* ;
|
||||
"Generic-IO type operations support")
|
||||
"Generic-IO type operations support")
|
||||
(FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR
|
||||
\TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR
|
||||
\TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION
|
||||
@@ -1913,214 +1912,248 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(DEFINEQ
|
||||
|
||||
(\TEXTBIN
|
||||
[LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:33 by jds")
|
||||
[LAMBDA (STREAM)
|
||||
|
||||
(* ;; "Edited 22-Dec-2021 10:29 by rmk: Return value of OBJECTCHAR property for image objecdts")
|
||||
|
||||
(* ;; "Edited 28-Mar-94 15:33 by jds")
|
||||
|
||||
(* ;;; "Do BIN slow case for a text stream")
|
||||
(* ;
|
||||
"NB that PEEKBIN and BACKFILEPTR need to track changes in this code")
|
||||
"NB that PEEKBIN and BACKFILEPTR need to track changes in this code")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
(PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM)
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(LET (BYTE) (* ;
|
||||
"RMK: Capture all return values for any special imageobject coercion")
|
||||
[SETQ BYTE (PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM)
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(* ;
|
||||
"Simple case -- just do the usual BIN")
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) of STREAM
|
||||
)))
|
||||
"Simple case -- just do the usual BIN")
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE)
|
||||
of STREAM)))
|
||||
(* ; "Handle objects specially")
|
||||
(COND
|
||||
((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM))
|
||||
(COND
|
||||
((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM))
|
||||
(* ;
|
||||
"If this object has a substream in it, go to that substream")
|
||||
(add (fetch (STREAM COFFSET) of STREAM)
|
||||
1)
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T
|
||||
(* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.")
|
||||
"If this object has a substream in it, go to that substream")
|
||||
(add (fetch (STREAM COFFSET) of STREAM)
|
||||
1)
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T
|
||||
(* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.")
|
||||
|
||||
(replace (STREAM COFFSET) of STREAM with (fetch (STREAM
|
||||
CBUFSIZE)
|
||||
of STREAM))
|
||||
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
|
||||
(RETURN PO]
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(replace (STREAM COFFSET) of STREAM
|
||||
with (fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
|
||||
(RETURN PO]
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(* ;
|
||||
"This is a 16 bit BIN. grab 2 bytes.")
|
||||
"This is a 16 bit BIN. grab 2 bytes.")
|
||||
(* ;
|
||||
"WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??")
|
||||
(RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(COND
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
"WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??")
|
||||
(RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(COND
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(* ;
|
||||
"This pair of characters doesn't straddle a file page bound. Just grab the next char.")
|
||||
(\PAGEDBIN STREAM))
|
||||
(T (* ;
|
||||
"Need to move to the next page on the backing file. Doing so also grabs the next character.")
|
||||
(\TEDIT.TEXTBIN.NEW.PAGE STREAM T]
|
||||
(T (RETURN (\PAGEDBIN STREAM]
|
||||
(T (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
"This pair of characters doesn't straddle a file page bound. Just grab the next char.")
|
||||
(\PAGEDBIN STREAM))
|
||||
(T (* ;
|
||||
"Need to move to the next page on the backing file. Doing so also grabs the next character.")
|
||||
(\TEDIT.TEXTBIN.NEW.PAGE STREAM T]
|
||||
(T (RETURN (\PAGEDBIN STREAM]
|
||||
(T (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
(* ; "Time for a new piece.")
|
||||
[repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN) of PC)))
|
||||
do (* ;
|
||||
"Skip over any zero-length pieces at the end of the file.")
|
||||
(SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (AND OPC (fetch (PIECE NEXTPIECE)
|
||||
of OPC]
|
||||
(replace (STREAM BINABLE) of STREAM with T)
|
||||
(replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL)
|
||||
[repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN)
|
||||
of PC)))
|
||||
do (* ;
|
||||
"Skip over any zero-length pieces at the end of the file.")
|
||||
(SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (AND OPC (fetch (PIECE NEXTPIECE)
|
||||
of OPC]
|
||||
(replace (STREAM BINABLE) of STREAM with T)
|
||||
(replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL)
|
||||
(* ;
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (* ;
|
||||
"There IS a next piece to move to.")
|
||||
(AND (fetch (TEXTSTREAM LOOKSUPDATEFN) of STREAM)
|
||||
(SETQ NPC (APPLY* (fetch (TEXTSTREAM LOOKSUPDATEFN)
|
||||
of STREAM)
|
||||
STREAM PC))
|
||||
(replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (SETQ PC NPC)))
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (* ; "There IS a next piece to move to.")
|
||||
(AND (fetch (TEXTSTREAM LOOKSUPDATEFN)
|
||||
of STREAM)
|
||||
(SETQ NPC (APPLY* (fetch (TEXTSTREAM
|
||||
LOOKSUPDATEFN
|
||||
)
|
||||
of STREAM)
|
||||
STREAM PC))
|
||||
(replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (SETQ PC NPC)))
|
||||
(* ;
|
||||
"Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.")
|
||||
[COND
|
||||
(NPC (* ;
|
||||
"If we got an NPC, this was taken care of by the LOOKSUPDATEFN")
|
||||
)
|
||||
([AND (SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM]
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS) of
|
||||
SUBSTREAM
|
||||
)))
|
||||
[(NEQ (fetch (PIECE PPARALOOKS) of OPC)
|
||||
(fetch (PIECE PPARALOOKS) of PC))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.PARASTYLES (fetch (PIECE
|
||||
PPARALOOKS
|
||||
)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
((NOT (EQCLOOKS (fetch (PIECE PLOOKS) of PC)
|
||||
(fetch (PIECE PLOOKS) of OPC)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
(COND
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
"Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.")
|
||||
[COND
|
||||
(NPC (* ;
|
||||
"If we got an NPC, this was taken care of by the LOOKSUPDATEFN")
|
||||
)
|
||||
([AND (SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(SETQ SUBSTREAM (IMAGEOBJPROP
|
||||
PO
|
||||
'SUBSTREAM]
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
) of SUBSTREAM
|
||||
))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
CURRENTLOOKS)
|
||||
of SUBSTREAM)))
|
||||
[(NEQ (fetch (PIECE PPARALOOKS) of OPC)
|
||||
(fetch (PIECE PPARALOOKS) of PC))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (\TEDIT.APPLY.PARASTYLES
|
||||
(fetch (PIECE PPARALOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM with (\TEDIT.APPLY.STYLES
|
||||
(fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
((NOT (EQCLOOKS (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
(fetch (PIECE PLOOKS) of OPC)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM with (\TEDIT.APPLY.STYLES
|
||||
(fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
(COND
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
(* ; "This piece lives in a string.")
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PS)
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP
|
||||
0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PS)
|
||||
|
||||
(* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")
|
||||
(* ;
|
||||
"Then actually grab the next character to hand back to the caller.")
|
||||
(\BIN STREAM))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
"Then actually grab the next character to hand back to the caller.")
|
||||
(\BIN STREAM))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
(* ; "This piece lives on a file.")
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PF (fetch (PIECE PFATP) of PC)
|
||||
'PEEKBIN)
|
||||
(\BIN STREAM))
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (STREAM COFFSET) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
|
||||
with 0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
|
||||
CURRENTPARALOOKS
|
||||
) of
|
||||
SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(RETURN PO]
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(T (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(COND
|
||||
((fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PF (fetch (PIECE PFATP)
|
||||
of PC)
|
||||
'PEEKBIN)
|
||||
(\BIN STREAM))
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM
|
||||
with NIL)
|
||||
(COND
|
||||
(SUBSTREAM
|
||||
(* ;
|
||||
"If there's an EOF handler, call it & return the result")
|
||||
(RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM
|
||||
)
|
||||
STREAM)))
|
||||
(T (* ; "Otherwise, return NIL")
|
||||
(RETURN NIL]
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE)
|
||||
of STREAM)))
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM
|
||||
TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (STREAM COFFSET)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM
|
||||
with (fetch (PIECE PLEN)
|
||||
of PC))
|
||||
(freplace (STREAM CBUFSIZE)
|
||||
of STREAM
|
||||
with (fetch (PIECE PLEN)
|
||||
of PC))
|
||||
(freplace (STREAM CPAGE)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG)
|
||||
of STREAM with 0)
|
||||
(replace (TEXTSTREAM
|
||||
CURRENTPARALOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
) of SUBSTREAM
|
||||
))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM with 0)
|
||||
(RETURN PO]
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(T (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(COND
|
||||
((fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
(* ;
|
||||
"If there's an EOF handler, call it & return the result")
|
||||
(RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP)
|
||||
of STREAM)
|
||||
STREAM)))
|
||||
(T (* ; "Otherwise, return NIL")
|
||||
(RETURN NIL]
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE)
|
||||
of STREAM)))
|
||||
(* ; "This is an object")
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) of
|
||||
SUBSTREAM))
|
||||
(freplace (STREAM COFFSET) of STREAM with 1)
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with
|
||||
0)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with
|
||||
1)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with
|
||||
0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS) of
|
||||
SUBSTREAM
|
||||
))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
|
||||
(RETURN PO]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM])
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (STREAM COFFSET) of STREAM
|
||||
with 1)
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
|
||||
with 1)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
|
||||
with 0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
) of SUBSTREAM)
|
||||
)
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(RETURN PO]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM]
|
||||
(IF (IMAGEOBJP BYTE)
|
||||
THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM)
|
||||
'OBJECTBYTE)
|
||||
BYTE)
|
||||
ELSE BYTE])
|
||||
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP
|
||||
[LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* ; "Edited 31-May-91 14:21 by jds")
|
||||
@@ -2353,123 +2386,144 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(DEFINEQ
|
||||
|
||||
(\TEXTPEEKBIN
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 28-Mar-94 15:34 by jds")
|
||||
[LAMBDA (STREAM NOERRORFLG)
|
||||
|
||||
(* ;; "Edited 22-Dec-2021 10:29 by rmk: Return OBJECTCHAR for image objects, if present")
|
||||
|
||||
(* ;; "Edited 28-Mar-94 15:34 by jds")
|
||||
(* ; "DO PEEKBIN for a text stream")
|
||||
(PROG (CH FILE STR PF PS PC PO SUBSTREAM)
|
||||
(SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(LET (BYTE) (* ;
|
||||
"BYTE to capture all returns for imageobject coercion")
|
||||
[SETQ BYTE (PROG (CH FILE STR PF PS PC PO SUBSTREAM)
|
||||
(SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(* ;
|
||||
"Simple case -- just do the usual PEEKBIN")
|
||||
(COND
|
||||
((AND PC (fetch (PIECE POBJ) of PC))
|
||||
(RETURN (fetch (PIECE POBJ) of PC)))
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(* ;
|
||||
"This is a 16 bit PEEKBIN. Grab two chars...")
|
||||
(RETURN (COND
|
||||
[(\EOFP STREAM)
|
||||
"Simple case -- just do the usual PEEKBIN")
|
||||
(COND
|
||||
(NOERRORFLG NIL)
|
||||
(T (\PEEKBIN STREAM]
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(SUB1 (fetch (STREAM CBUFSIZE) of STREAM)))
|
||||
((AND PC (SETQ PO (fetch (PIECE POBJ) of PC)))
|
||||
(RETURN PO))
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(* ;
|
||||
"We're sure of staying on the same page. Just grab the characters")
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(\PAGEDPEEKBIN STREAM NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR STREAM)))
|
||||
(T (SETQ PS (fetch (STREAM F1) of STREAM))
|
||||
(replace (STREAM COFFSET) of PS with (fetch
|
||||
(STREAM COFFSET)
|
||||
of STREAM))
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS)
|
||||
256)
|
||||
(\PAGEDPEEKBIN PS NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR PS]
|
||||
(T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG]
|
||||
[PC (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
"This is a 16 bit PEEKBIN. Grab two chars...")
|
||||
(RETURN (COND
|
||||
[(\EOFP STREAM)
|
||||
(COND
|
||||
(NOERRORFLG NIL)
|
||||
(T (\PEEKBIN STREAM]
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(SUB1 (fetch (STREAM CBUFSIZE) of STREAM)))
|
||||
(* ;
|
||||
"We're sure of staying on the same page. Just grab the characters")
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(\PAGEDPEEKBIN STREAM NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR STREAM)))
|
||||
(T (SETQ PS (fetch (STREAM F1) of STREAM))
|
||||
(replace (STREAM COFFSET) of PS
|
||||
with (fetch (STREAM COFFSET) of STREAM))
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS)
|
||||
256)
|
||||
(\PAGEDPEEKBIN PS NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR PS]
|
||||
(T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG]
|
||||
[PC (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
(* ; "Time for a new piece.")
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (fetch (PIECE NEXTPIECE) of PC)))
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (fetch (PIECE NEXTPIECE) of PC)))
|
||||
(* ;
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ) of STREAM)
|
||||
))
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM COFFSET) of STREAM with 0)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
|
||||
with 0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS
|
||||
)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM)))
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM
|
||||
with NIL)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM COFFSET) of STREAM
|
||||
with 0)
|
||||
(COND
|
||||
(SUBSTREAM
|
||||
(* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM
|
||||
TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM
|
||||
with (fetch (PIECE PLEN)
|
||||
of PC))
|
||||
(freplace (STREAM CPAGE)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG)
|
||||
of STREAM with 0)
|
||||
(replace (TEXTSTREAM
|
||||
CURRENTPARALOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of
|
||||
STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(RETURN PO]
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM with 0)
|
||||
(RETURN PO]
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
(* ; "This piece lives in a string.")
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PS)
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP
|
||||
0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PS)
|
||||
|
||||
(* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")
|
||||
|
||||
(\PEEKBIN STREAM NOERRORFLG))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
(\PEEKBIN STREAM NOERRORFLG))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
(* ; "This piece lives on a file.")
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PF (fetch (PIECE PFATP) of PC)
|
||||
'PEEKBIN NOERRORFLG))
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM])
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PF (fetch (PIECE PFATP)
|
||||
of PC)
|
||||
'PEEKBIN NOERRORFLG))
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM]
|
||||
(IF (IMAGEOBJP BYTE)
|
||||
THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM)
|
||||
'OBJECTBYTE)
|
||||
BYTE)
|
||||
ELSE BYTE])
|
||||
|
||||
(\TEDIT.PEEKBIN.NEW.PAGE
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 11-Jun-99 15:11 by rmk:")
|
||||
@@ -2667,25 +2721,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1993 1994 1995 1999 2000 2001 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2989 53114 (COPYTEXTSTREAM 2999 . 6121) (OPENTEXTSTREAM 6123 . 21000) (REOPENTEXTSTREAM
|
||||
21002 . 21424) (TEDIT.STREAMCHANGEDP 21426 . 21724) (TEXTSTREAMP 21726 . 22040) (TXTFILE 22042 .
|
||||
22487) (\DELETECH 22489 . 33745) (\SETUPGETCH 33747 . 41026) (\TEDIT.REOPEN.STREAM 41028 . 42878) (
|
||||
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42880 . 45318) (\TEXTINIT 45320 . 51007) (\TEXTMARK 51009 . 51757) (
|
||||
\TEXTTTYBOUT 51759 . 53112)) (53115 78547 (\INSERTCH 53125 . 76851) (\INSERTCR 76853 . 78545)) (78613
|
||||
98929 (\CHTOPC 78623 . 79812) (\CHTOPCNO 79814 . 81076) (\CLEARPCTB 81078 . 81874) (
|
||||
\CREATEPIECEORSTREAM 81876 . 84850) (\DELETEPIECE 84852 . 85765) (\FINDPIECE 85767 . 86133) (
|
||||
\INSERTPIECE 86135 . 89145) (\MAKEPCTB 89147 . 91062) (\SPLITPIECE 91064 . 98023) (\INSERT.FIRST.PIECE
|
||||
98025 . 98927)) (98981 123219 (\TEXTCLOSEF 98991 . 100218) (\TEXTCLOSEF-SUBTREE 100220 . 100926) (
|
||||
\TEXTDSPFONT 100928 . 101920) (\TEXTEOFP 101922 . 103281) (\TEXTGETEOFPTR 103283 . 103493) (
|
||||
\TEXTGETFILEPTR 103495 . 105558) (\TEXTOPENF 105560 . 106390) (\TEXTOPENF-SUBTREE 106392 . 107193) (
|
||||
\TEXTOUTCHARFN 107195 . 107543) (\TEXTBACKFILEPTR 107545 . 113446) (\TEXTBOUT 113448 . 116796) (
|
||||
\TEDITOUTCCODEFN 116798 . 118064) (\TEXTSETEOF 118066 . 118575) (\TEXTSETFILEPTR 118577 . 119802) (
|
||||
\TEXTDSPXPOSITION 119804 . 120661) (\TEXTDSPYPOSITION 120663 . 121208) (\TEXTLEFTMARGIN 121210 .
|
||||
121693) (\TEXTRIGHTMARGIN 121695 . 122631) (\TEXTDSPCHARWIDTH 122633 . 122871) (\TEXTDSPSTRINGWIDTH
|
||||
122873 . 123113) (\TEXTDSPLINEFEED 123115 . 123217)) (123220 156964 (\TEXTBIN 123230 . 140016) (
|
||||
\TEDIT.TEXTBIN.STRINGSETUP 140018 . 145731) (\TEDIT.TEXTBIN.FILESETUP 145733 . 152119) (
|
||||
\TEDIT.TEXTBIN.NEW.PAGE 152121 . 156962)) (156965 170373 (\TEXTPEEKBIN 156975 . 166114) (
|
||||
\TEDIT.PEEKBIN.NEW.PAGE 166116 . 170371)) (170411 175629 (CGETTEXTPROP 170421 . 170897) (CTEXTPROP
|
||||
170899 . 173243) (GETTEXTPROP 173245 . 173840) (PUTTEXTPROP 173842 . 175167) (TEXTPROP 175169 . 175627
|
||||
(FILEMAP (NIL (2992 53117 (COPYTEXTSTREAM 3002 . 6124) (OPENTEXTSTREAM 6126 . 21003) (REOPENTEXTSTREAM
|
||||
21005 . 21427) (TEDIT.STREAMCHANGEDP 21429 . 21727) (TEXTSTREAMP 21729 . 22043) (TXTFILE 22045 .
|
||||
22490) (\DELETECH 22492 . 33748) (\SETUPGETCH 33750 . 41029) (\TEDIT.REOPEN.STREAM 41031 . 42881) (
|
||||
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42883 . 45321) (\TEXTINIT 45323 . 51010) (\TEXTMARK 51012 . 51760) (
|
||||
\TEXTTTYBOUT 51762 . 53115)) (53118 78550 (\INSERTCH 53128 . 76854) (\INSERTCR 76856 . 78548)) (78616
|
||||
98932 (\CHTOPC 78626 . 79815) (\CHTOPCNO 79817 . 81079) (\CLEARPCTB 81081 . 81877) (
|
||||
\CREATEPIECEORSTREAM 81879 . 84853) (\DELETEPIECE 84855 . 85768) (\FINDPIECE 85770 . 86136) (
|
||||
\INSERTPIECE 86138 . 89148) (\MAKEPCTB 89150 . 91065) (\SPLITPIECE 91067 . 98026) (\INSERT.FIRST.PIECE
|
||||
98028 . 98930)) (98984 123222 (\TEXTCLOSEF 98994 . 100221) (\TEXTCLOSEF-SUBTREE 100223 . 100929) (
|
||||
\TEXTDSPFONT 100931 . 101923) (\TEXTEOFP 101925 . 103284) (\TEXTGETEOFPTR 103286 . 103496) (
|
||||
\TEXTGETFILEPTR 103498 . 105561) (\TEXTOPENF 105563 . 106393) (\TEXTOPENF-SUBTREE 106395 . 107196) (
|
||||
\TEXTOUTCHARFN 107198 . 107546) (\TEXTBACKFILEPTR 107548 . 113449) (\TEXTBOUT 113451 . 116799) (
|
||||
\TEDITOUTCCODEFN 116801 . 118067) (\TEXTSETEOF 118069 . 118578) (\TEXTSETFILEPTR 118580 . 119805) (
|
||||
\TEXTDSPXPOSITION 119807 . 120664) (\TEXTDSPYPOSITION 120666 . 121211) (\TEXTLEFTMARGIN 121213 .
|
||||
121696) (\TEXTRIGHTMARGIN 121698 . 122634) (\TEXTDSPCHARWIDTH 122636 . 122874) (\TEXTDSPSTRINGWIDTH
|
||||
122876 . 123116) (\TEXTDSPLINEFEED 123118 . 123220)) (123223 161060 (\TEXTBIN 123233 . 144112) (
|
||||
\TEDIT.TEXTBIN.STRINGSETUP 144114 . 149827) (\TEDIT.TEXTBIN.FILESETUP 149829 . 156215) (
|
||||
\TEDIT.TEXTBIN.NEW.PAGE 156217 . 161058)) (161061 176823 (\TEXTPEEKBIN 161071 . 172564) (
|
||||
\TEDIT.PEEKBIN.NEW.PAGE 172566 . 176821)) (176861 182079 (CGETTEXTPROP 176871 . 177347) (CTEXTPROP
|
||||
177349 . 179693) (GETTEXTPROP 179695 . 180290) (PUTTEXTPROP 180292 . 181617) (TEXTPROP 181619 . 182077
|
||||
)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user