(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "31-May-2025 10:30:31" {WMEDLEY}TEDIT-DEBUG.;170 138250 :EDIT-BY rmk :CHANGES-TO (FNS \TLVALIDATE) :PREVIOUS-DATE "30-May-2025 23:51:11" {WMEDLEY}TEDIT-DEBUG.;168) (PRETTYCOMPRINT TEDIT-DEBUGCOMS) (RPAQQ TEDIT-DEBUGCOMS [ (* ;; "This is an internal/ file containing a hodge-podge of functions for use in Tedit debugging. To start working on TEDIT, (LOAD 'TEDIT-DEBUG.LCOM) and then run (TEDIT--DEBUG). That will load TEDIT-EXPORTS.ALL and EXPORTS.ALL, load the fuller database if available, and analyze the functions on TEDITFILES. And leave you connected to {MEDLEYDIR}/library/tedit/.") (* ;; "This has functions for accessing,showing, inspecting and manipulating a variety of internal Tedit data structures (textobj, piece, line, selection, thisline), and other random bits of code. It has grown as different issues have been addressed, at some point it should be cleaned up and documented.") (* ;;  "This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.") (VARS (\TEDIT.THELPFLG T) (TFILES (CONS 'TEDIT-DEBUG TEDITFILES))) (COMS (* ;  "Get/set (default) object, stream, window, selection") (FNS GTO GTS GTW GSEL) (INITVARS (LASTTEXTSTREAM NIL)) (FNS TEST.TEMPLATE)) (FNS TESTACTION) (COMS (* ; "Inspect") (FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES)) (COMS (* ; "Show") (FNS SP SL SSP SPF SLF SHOWLINE SLL STBYTES SSEL) (FNS STL CLEARTHISLINE CHARSLOTP \TLVALIDATE)) (COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES)) (COMS (FNS FILEBYTES TFILEBYTES)) (FNS TRELMOVE TSCROLL TSCROLL*) (FNS TRY TEDITCLOSEW PARALASTWITHOUTEOL FIXPARALAST) (FNS SPPRINT SPPRINT.CHAR SPPRINT.OBJ SHOWPIECEBYTES CHECKPLENGTHS SBT COPYPCHAIN) (FNS POSLINE) (FNS PRESPLIT) (FNS ALLTL NTHCHARSLOT) (* ; "THISLINE") (FNS PLCHAIN PRINTLINE SL.GETLINES CHECKLINES COLLECTLINES NTHLINE HEIGHT LINEBOTS) (FNS IPC.DECODEARGS) (FNS SPF1) (* ; "Page frames") (FNS SLF.FATPLEN FILEPIECE) (* ; "Show looks file") (FNS SELTEDIT) (* ; "New editor on an old selection") (COMS (* ; "Bravo") (FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC)) (INITVARS (LASTTS NIL)) (VARS (OK.TO.MODIFY.FNS T)) (FNS OLDWI COMP DFR) (FNS DFGV GDIRECTORIES) (COMS (FNS TTEST LTEST THC) (INITVARS (LASTTTESTFILE)) (VARS * TTESTREGIONS)) (COMS (FNS SHOWSAFE) (INITVARS SAFESHOW SAFEHELP)) (FNS MYH) (VARS VTDIR VTF TF) (FNS DFVENUE VSEE) (FNS PTT) (* ; "Plain text") (COMS (MACROS DEBUGOUTPUT) (FNS DEBUGOUTPUT.STREAM)) (FNS TEDIT-DEBUG) (FNS HEXTOHILO CW) (FNS TRENAME) (FILES (NOERROR) VERSIONDEFS) (* ; "Until this is release") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV) (NLAML DFVENUE DFR) (LAMA]) (* ;; "This is an internal/ file containing a hodge-podge of functions for use in Tedit debugging. To start working on TEDIT, (LOAD 'TEDIT-DEBUG.LCOM) and then run (TEDIT--DEBUG). That will load TEDIT-EXPORTS.ALL and EXPORTS.ALL, load the fuller database if available, and analyze the functions on TEDITFILES. And leave you connected to {MEDLEYDIR}/library/tedit/." ) (* ;; "This has functions for accessing,showing, inspecting and manipulating a variety of internal Tedit data structures (textobj, piece, line, selection, thisline), and other random bits of code. It has grown as different issues have been addressed, at some point it should be cleaned up and documented." ) (* ;; "This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.") (RPAQQ \TEDIT.THELPFLG T) (RPAQ TFILES (CONS 'TEDIT-DEBUG TEDITFILES)) (* ; "Get/set (default) object, stream, window, selection") (DEFINEQ (GTO [LAMBDA (ARG NOERROR) (* ; "Edited 9-Aug-2024 13:14 by rmk") (LET ((TSTREAM (GTS ARG NOERROR))) (CL:WHEN TSTREAM (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))]) (GTS [LAMBDA (ARG NOERROR) (* ; "Edited 1-Feb-2025 08:25 by rmk") (* ; "Edited 23-Nov-2024 11:38 by rmk") (* ; "Edited 4-Oct-2024 22:13 by rmk") (* ; "Edited 21-Sep-2024 21:51 by rmk") (* ; "Edited 11-Aug-2024 21:53 by rmk") (CL:UNLESS (AND (TEXTSTREAM LASTTEXTSTREAM T) (OPENWP (\TEDIT.PRIMARYPANE LASTTEXTSTREAM))) (SETQ LASTTEXTSTREAM NIL)) (LET* ((TWINDOWS (for W in (OPENWINDOWS) when (WINDOWPROP W 'TEDITCREATED) unless (WINDOWPROP W 'TEDIT-DEBUG) collect W)) (TSTREAM (TEXTSTREAM (OR ARG (CL:IF (CDR TWINDOWS) (WHICHW) (CAR TWINDOWS))) T))) (if TSTREAM then (if (EQ TSTREAM LASTTEXTSTREAM) elseif (NULL LASTTEXTSTREAM) then (SETQ LASTTEXTSTREAM TSTREAM) elseif (AND (NOT (OR (type? TEXTOBJ ARG) (STREAMP ARG))) (EQ 'Y (ASKUSER NIL 'Y " Switch default textstream? "))) then (SETQ LASTTEXTSTREAM TSTREAM)) TSTREAM elseif (AND (NULL ARG) LASTTEXTSTREAM) elseif NOERROR then NIL else (TEXTSTREAM ARG]) (GTW [LAMBDA (ARG) (* ; "Edited 5-Nov-2024 13:50 by rmk") (\TEDIT.PRIMARYPANE (GTO ARG]) (GSEL [LAMBDA (WHICH ARG) (* ; "Edited 25-Nov-2024 14:19 by rmk") (* ; "Edited 11-Feb-2024 09:07 by rmk") (* ; "Edited 23-May-2023 00:03 by rmk") (TEXTSEL (GTO ARG]) ) (RPAQ? LASTTEXTSTREAM NIL) (DEFINEQ (TEST.TEMPLATE [LAMBDA (FILE) (* ; "Edited 17-Apr-2025 19:41 by rmk") (* ; "Edited 29-Mar-2025 09:51 by rmk") (CL:WHEN (AND (TEXTSTREAM LASTTEXTSTREAM T) (TEDITWINDOWP LASTTEXTSTREAM) (OPENWP (TEDITWINDOWP LASTTEXTSTREAM))) (for ST SW in (GETTEXTPROP LASTTEXTSTREAM 'SHOWSTREAMS) when (AND (SETQ SW ( \TEDIT.PRIMARYPANE ST)) (OPENWP SW)) do (PUTTEXTPROP ST 'DIRTY NIL) (CLOSEW SW)) (PUTTEXTPROP LASTTEXTSTREAM 'DIRTY NIL) (CLOSEW (TEDITWINDOWP LASTTEXTSTREAM))) (LET [(TSTREAM (TEXTSTREAM (TEDIT FILE NIL NIL '(LEAVETTY T] (SETQ LASTTEXTSTREAM TSTREAM) (GTS TSTREAM) (STUFF TSTREAM) TSTREAM]) ) (DEFINEQ (TESTACTION [LAMBDA (CHAR TSTREAM) (* ; "Edited 23-Mar-2025 11:06 by rmk") (* ;; "If CHAR is bound to an action in TSTREAM's read table, execute it.") (SETQ TSTREAM (GTS TSTREAM)) (\TEDIT.COMMAND.FUNCTION? TSTREAM (if (CHARCODEP CHAR) then CHAR elseif (CHARCODEP CHAR T) elseif (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM)) then (SETQ CHAR (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM))) (CL:IF (CHARCODEP CHAR) CHAR (CHARCODE.DECODE CHAR)) else (ERROR CHAR "is not a keybinding"]) ) (* ; "Inspect") (DEFINEQ (IPC [LAMBDA (PC TOBJ) (* ; "Edited 3-Dec-2024 16:51 by rmk") (* ; "Edited 4-Oct-2024 11:03 by rmk") (* ; "Edited 29-Sep-2024 15:03 by rmk") (* ; "Edited 22-Aug-2024 23:14 by rmk") (* ; "Edited 25-Jul-2024 17:47 by rmk") (* ;; "Inspects the piece specified by decoding PC and TOBJ")  (* ; "Edited 6-Nov-2023 08:03 by rmk") (LET (PCWINDOW OBJWINDOW TAG (DECODED (IPC.DECODEARGS PC TOBJ))) (SETQ PC (POP DECODED)) (if PC then (SETQ TAG (POP DECODED)) (SETQ PCWINDOW (INSPECT PC NIL NIL TAG)) (CL:WHEN (POBJ PC) (SETQ OBJWINDOW (INSPECT (POBJ PC) NIL (RELCREATEPOSITION (LIST PCWINDOW 'RIGHT -2) (LIST PCWINDOW 'BOTTOM)) TAG)) (CLOSEWITH OBJWINDOW PCWINDOW) (MOVEWITH OBJWINDOW PCWINDOW)) else (PRINTOUT T "No such piece")) PC]) (ILINES [LAMBDA (LINES TAG WHERE) (* ; "Edited 28-Jun-2024 15:22 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Apr-2024 13:48 by rmk") (* ; "Edited 27-Nov-2023 12:52 by rmk") (* ; "Edited 21-Oct-2023 10:22 by rmk") (* ; "Edited 9-May-2023 15:45 by rmk") (* ; "Edited 28-Mar-2023 22:02 by rmk") (* ; "Edited 25-Mar-2023 15:26 by rmk") (* ; "Edited 22-Feb-2023 11:08 by rmk") (* ; "Edited 21-Feb-2023 00:11 by rmk") (* ; "Edited 9-Oct-2022 08:36 by rmk") (DECLARE (USEDFREE TEXTOBJ)) (* ; "Edited 17-Sep-2022 11:50 by rmk") (if (type? SELECTION LINES) then [LET (WINDOW) (CL:WHEN (type? LINEDESCRIPTOR (CAR (fetch L1 of LINES))) (SETQ WINDOW (ILINES (fetch L1 of LINES) 'L2))) (CL:WHEN (type? LINEDESCRIPTOR (CAR (fetch LN of LINES))) (if WINDOW then (ATTACHWINDOW (ILINES (fetch LN of LINES) 'LN) WINDOW 'RIGHT 'TOP) else (ILINES (fetch LN of LINES) 'LN)))] else [SETQ LINES (if (type? LINEDESCRIPTOR LINES) then LINES elseif (type? LINEDESCRIPTOR (CAR (LISTP LINES))) then (CAR LINES) else (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO LINES] (INSPECT/TOP/LEVEL/LIST (COLLECTLINES LINES) WHERE TAG]) (ISEL [LAMBDA (ARG TAG) (* ; "Edited 3-Oct-2024 14:51 by rmk") (* ; "Edited 6-Sep-2024 10:36 by rmk") (* ; "Edited 4-Jun-2023 13:02 by rmk") (* ; "Edited 27-Apr-2023 10:29 by rmk") (LET [(SEL (CL:IF (type? SELECTION ARG) ARG (TEXTSEL (GTO ARG)))] (INSPECT SEL NIL NIL TAG) SEL]) (ITS [LAMBDA (TS NPIECES) (* ; "Edited 25-Nov-2024 18:27 by rmk") (* ; "Edited 26-Nov-2023 20:46 by rmk") (* ; "Edited 31-Oct-2023 19:44 by rmk") (* ; "Edited 21-Oct-2023 17:04 by rmk") (* ; "Edited 9-Oct-2022 13:01 by rmk") (* ; "Edited 14-Sep-2022 08:33 by rmk") (* ;; "Inspect the key components of a Text stream TS") (SETQ TS (GTS TS)) (LET (TSW WS) (SETQ TSW (INSPECT TS 'TEXTSTREAM (RELCREATEPOSITION 'TTY 5))) (* ; "The text stream fields") (push WS (INSPECT TS 'STREAM (RELCREATEPOSITION (LIST TSW 'RIGHT 2) 5))) (* ; "All stream fields") (push WS (INSPECT (TEXTOBJ TS) 'TEXTOBJ (RELCREATEPOSITION (LIST (CAR WS) 'RIGHT 2) 5))) (push WS (INSPECT (GETTOBJ (TEXTOBJ TS) PCTB) 'LIST (RELCREATEPOSITION (LIST (CAR WS) 'RIGHT 2) 5))) (CLOSEWITH WS TSW) (MOVEWITH WS TSW)) (SP TS (OR NPIECES 10)) TS]) (IPANES [LAMBDA (ARG TAG WHERE) (* ; "Edited 28-Jun-2024 21:21 by rmk") (INSPECT/ALIST (for P inpanes (GTO ARG) collect (CONS P (PANEPROPS P))) WHERE TAG]) (ITL [LAMBDA (THISLINE) (* ; "Edited 29-Jul-2024 09:42 by rmk") (* ;; "Inspect THISLINE") (CL:UNLESS (type? THISLINE THISLINE) (CL:WHEN (EQ THISLINE T) (SETQ THISLINE NIL) (SETQ LASTCS CHARSLOT)) (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) (INSPECT THISLINE) THISLINE]) (IHIST [LAMBDA (LAST ARG) (* ; "Edited 8-Dec-2024 20:33 by rmk") (* ; "Edited 21-Jun-2023 14:24 by rmk") (* ; "Edited 1-Jun-2023 22:31 by rmk") (* ; "Edited 31-May-2023 11:35 by rmk") (* ; "Edited 4-May-2023 20:25 by rmk") (LET* ((TEXTOBJ (GTO ARG)) (EVENTS (GETTOBJ TEXTOBJ TXTHISTORY)) (UNDONEEVENTS (GETTOBJ (GTO ARG) TXTHISTORYUNDONE)) HISTW HISTUNDOW HISTUNDOWHERE) (CL:WHEN EVENTS [SETQ HISTW (if LAST then (INSPECT (CAR EVENTS) 'LIST NIL 'HIST) else (INSPECT EVENTS 'LIST NIL 'HIST]) (CL:WHEN UNDONEEVENTS (CL:WHEN HISTW [SETQ HISTUNDOWHERE (RELCREATEPOSITION (LIST HISTW 'RIGHT) (LIST HISTW 'BOTTOM] (* ;; "Make it wide so the undo events show up") [SETQ HISTUNDOWHERE (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of HISTUNDOWHERE ) (fetch (POSITION YCOORD) of HISTUNDOWHERE) 600 (TIMES (FONTPROP (DSPFONT DEFAULTFONT) 'HEIGHT) (IPLUS 1 (LENGTH UNDONEEVENTS]) [SETQ HISTUNDOW (if LAST then (INSPECT (CAR UNDONEEVENTS) (AND (LIST (CAR UNDONEEVENTS)) 'LIST) HISTUNDOWHERE 'HISTUNDO) else (INSPECT UNDONEEVENTS 'LIST HISTUNDOWHERE 'HISTUNDO] (CL:WHEN HISTW (CLOSEWITH HISTUNDOW HISTW) (MOVEWITH HISTUNDOW HISTW))) (LIST (LENGTH EVENTS) (LENGTH UNDONEEVENTS]) (IPCTB [LAMBDA (ARG) (* ; "Edited 28-Mar-2025 20:42 by rmk") (* ; "Edited 31-Oct-2023 19:45 by rmk") (* ; "Edited 4-May-2023 20:28 by rmk") (SETQ ARG (GTO ARG)) (INSPECT (GETTOBJ ARG PCTB) 'LIST) ARG]) (IMB [LAMBDA (IDENTIFIER ARG) (* ; "Edited 28-Mar-2025 20:45 by rmk") (* ; "Edited 22-Aug-2024 16:34 by rmk") (* ; "Edited 21-Aug-2024 10:00 by rmk") (* ; "Edited 8-Aug-2024 09:08 by rmk") (* ; "Edited 4-Aug-2024 09:05 by rmk") (* ;; "Inspect the menu button for IDENTIFIER") (LET [(OBJ (MB.GET IDENTIFIER (GTO ARG) 'OBJECT] (CL:IF OBJ (INSPECT OBJ NIL NIL IDENTIFIER)) OBJ]) (ICL [LAMBDA (PC ARG) (* ; "Edited 28-Mar-2025 20:39 by rmk") (* ; "Edited 25-Nov-2024 17:01 by rmk") (* ; "Edited 4-Oct-2024 13:33 by rmk") (* ;; "Inspect the character looks of PC")  (* ; "Edited 11-Apr-2023 11:42 by rmk") (LET ((DECODED (IPC.DECODEARGS PC ARG))) (SETQ PC (POP DECODED)) (INSPECT (PCHARLOOKS PC) NIL NIL (CONCAT PC " " (POP DECODED))) (PCHARLOOKS PC]) (IPL [LAMBDA (PC ARG) (* ; "Edited 28-Mar-2025 20:39 by rmk") (* ; "Edited 25-Nov-2024 17:01 by rmk") (* ; "Edited 11-Apr-2023 11:42 by rmk") (LET ((DECODED (IPC.DECODEARGS PC ARG))) (SETQ PC (POP DECODED)) (INSPECT (PPARALOOKS PC) NIL NIL (CONCAT PC " " (POP DECODED))) (PPARALOOKS PC]) (ICARET [LAMBDA (ARG) (* ; "Edited 28-Mar-2025 20:40 by rmk") (* ; "Edited 27-Nov-2024 13:48 by rmk") (* ; "Edited 4-Oct-2024 13:33 by rmk") (* ; "Edited 11-Apr-2023 11:42 by rmk") (SETQ ARG (GTW ARG)) (INSPECT (PANECARET ARG)) (PANECARET ARG]) (INSPECTPIECES [LAMBDA (PIECE N TAG WHERE) (* ; "Edited 16-Mar-2024 10:07 by rmk") (* ; "Edited 30-Dec-2023 14:47 by rmk") (* ; "Edited 1-Dec-2023 21:34 by rmk") (* ; "Edited 27-Nov-2023 12:51 by rmk") (CL:UNLESS (type? PIECE PIECE) [SETQ PIECE (if (FIXP PIECE) then (NTHPIECE (GTO) PIECE) elseif (type? SELECTION PIECE) then (SELPIECE PIECE) else (\TEDIT.FIRSTPIECE (GTO PIECE]) (CL:UNLESS (FIXP N) (SETQ WHERE TAG) (SETQ TAG N) (SETQ N 20)) (LET (W PIECES) (SETQ PIECES (for PC inpieces PIECE as I from 1 to N collect PC)) (SETQ W (INSPECT/TOP/LEVEL/LIST PIECES)) (WINDOWPROP W 'TITLE PIECE) PIECE]) ) (* ; "Show") (DEFINEQ (SP [LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 17-Apr-2025 13:37 by rmk") (* ; "Edited 15-Apr-2025 13:53 by rmk") (* ; "Edited 11-Apr-2025 12:15 by rmk") (* ; "Edited 29-Mar-2025 22:34 by rmk") (* ; "Edited 6-Jan-2025 22:18 by rmk") (* ; "Edited 16-Dec-2024 15:50 by rmk") (* ; "Edited 30-Nov-2024 19:34 by rmk") (* ; "Edited 9-Sep-2024 14:53 by rmk") (* ; "Edited 11-Aug-2024 21:06 by rmk") (* ; "Edited 15-Jun-2024 11:52 by rmk") (* ; "Edited 21-May-2024 11:29 by rmk") (* ; "Edited 17-Mar-2024 12:58 by rmk") (* ; "Edited 11-Jan-2024 22:19 by rmk") (* ; "Edited 3-Jan-2024 00:41 by rmk") (* ; "Edited 21-Oct-2023 10:56 by rmk") (* ;; "PC is the starting piece, NP is the number of pieces including it.") (* ;; "OFILE=T or TEDIT means Tedit stream. NIL means primary output (usually T)") (PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC) PC (GTO TOBJ))) WTYPE TITLE) (if OFILE then (CL:WHEN (MEMB OFILE '(T TEDIT)) (SETQ WTYPE 'SP) (SETQ OFILE NIL)) elseif (AND NP (LITATOM NP)) then (SETQ WTYPE (CL:IF (EQ NP T) 'SP NP)) (SETQ NP NIL)) (CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ)) (PRINTOUT T "Document is empty" T) (RETURN)) [if (type? PIECE PC) elseif (NULL PC) then [SETQ PC (\TEDIT.FIRSTPIECE (OR TEXTOBJ (GTO] elseif [AND (FIXP PC) (OR TEXTOBJ (AND TOBJ (SETQ TEXTOBJ (GTO] then (SETQ PC (NTHPIECE TEXTOBJ PC)) elseif [OR (type? SELECTION PC) (MEMB PC '(SEL T] then (CL:UNLESS TEXTOBJ (SETQ TEXTOBJ (TEXTOBJ PC))) (SETQ PC (SELPIECE TEXTOBJ)) elseif (OR (EQ PC TEXTOBJ) (SETQ TEXTOBJ (GTO PC T))) then (SETQ PC (\TEDIT.FIRSTPIECE TEXTOBJ)) elseif (type? LINEDESCRIPTOR (CAR (MKLIST PC))) then (* ;; "Assume it's from the current TEXTOBJ") (SETQ PC (\TEDIT.CHTOPC (GETLD (CAR (MKLIST PC)) LCHAR1) (GTO TEXTOBJ] (CL:UNLESS (SMALLP NP) (SETQ NP (CL:IF NP 20 MAX.SMALLP))) (DEBUGOUTPUT [DEBUGOUTPUT.STREAM OFILE WTYPE TITLE 120 (OR FONT '(TERMINAL 8] (for P PFILES inpieces PC as I from 1 to NP as PCNO from (OR (PIECENUM PC TEXTOBJ) 1) do (* ;; "Put the fileptrs back where they were.") (CL:WHEN (AND (MEMB (PTYPE PC) FILE.PTYPES) (NOT (MEMB (PCONTENTS PC) PFILES))) (CL:UNLESS (GETSTREAM (PCONTENTS PC) 'INPUT T) (\TEDIT.REOPEN.STREAM TEXTOBJ)) [RESETSAVE (GETFILEPTR (PCONTENTS PC)) `(PROGN (SETFILEPTR ,(PCONTENTS PC) OLDVALUE]) (PRINTOUT OFILE .I3 PCNO "/") (SPPRINT P OFILE TEXTOBJ NOCR)) (TERPRI OFILE) (CL:WHEN (TEXTSTREAMP OFILE) (TEXTPROP.ADD TEXTOBJ 'SHOWSTREAMS OFILE))) (RETURN PC]) (SL [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 17-Apr-2025 13:36 by rmk") (* ; "Edited 15-Apr-2025 13:57 by rmk") (* ; "Edited 11-Apr-2025 12:15 by rmk") (* ; "Edited 29-Mar-2025 20:27 by rmk") (* ; "Edited 21-Jan-2025 15:39 by rmk") (* ; "Edited 6-Jan-2025 22:58 by rmk") (* ; "Edited 7-Dec-2024 16:34 by rmk") (* ; "Edited 3-Dec-2024 10:29 by rmk") (* ; "Edited 25-Nov-2024 21:42 by rmk") (* ; "Edited 18-Nov-2024 21:28 by rmk") (* ; "Edited 9-Nov-2024 23:22 by rmk") (* ; "Edited 28-Oct-2024 22:25 by rmk") (* ; "Edited 27-Oct-2024 18:38 by rmk") (* ; "Edited 25-Oct-2024 22:25 by rmk") (* ; "Edited 21-Oct-2024 23:08 by rmk") (LET (LINES WTYPE PNO TITLE) (if OFILE then (CL:WHEN (MEMB OFILE '(T TEDIT)) (SETQ WTYPE 'SL) (SETQ OFILE NIL)) elseif (MEMB LASTLINE '(T TEDIT)) then (SETQ WTYPE 'SL) (SETQ LASTLINE NIL) elseif (STRINGP LASTLINE) then (SETQ WTYPE 'SL) (SETQ TITLE (CONCAT "SL: " LASTLINE)) (SETQ LASTLINE NIL)) (CL:WHEN [AND (type? LINEDESCRIPTOR (CAR (LISTP FIRSTLINE))) (NULL LASTLINE) (OR (NULL (CDR FIRSTLINE)) (type? LINEDESCRIPTOR (CDR FIRSTLINE] (SETQ LASTLINE (CDR FIRSTLINE)) (* ; "BITMAPLINES ?") (SETQ FIRSTLINE (CAR FIRSTLINE))) (SETQ LINES (SL.GETLINES FIRSTLINE LASTLINE PANE TOBJ)) (SETQ FIRSTLINE (pop LINES)) (SETQ LASTLINE (pop LINES)) (SETQ TOBJ (pop LINES)) (SETQ PANE (pop LINES)) (SETQ PNO (pop LINES)) (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE WTYPE TITLE NIL '(TERMINAL 8)) (PRINTOUT OFILE .FONT '(TERMINAL 8) "Pane " PNO " = " PANE T) (PRINTOUT OFILE .FONT '(TERMINAL 8) 15 "HT" -3 "BOT" 27 .FONT '(TERMINAL 8 BOLD) "C1" 36 "CN" .FONT '(TERMINAL 8) 40 "LN/*=PARALAST" T) (for L inlines FIRSTLINE do (SHOWLINE L OFILE TOBJ) repeatuntil (EQ L LASTLINE) finally (CL:WHEN (EQ LASTLINE (PANEBOTTOMLINE PANE)) (SHOWLINE (PANESUFFIX PANE) OFILE TOBJ))) (TERPRI OFILE) (CL:WHEN (EQ FIRSTLINE LASTLINE) (printout OFILE (for L inlines (FGETLD LASTLINE NEXTLINE) sum 1) " lines below LASTLINE" T T)) (CL:WHEN (TEXTSTREAMP OFILE) (TEXTPROP.ADD TOBJ 'SHOWSTREAMS OFILE))) FIRSTLINE]) (SSP [LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 11-Apr-2025 12:16 by rmk") (* ; "Edited 29-Mar-2025 22:35 by rmk") (* ; "Edited 30-Jan-2025 11:25 by rmk") (* ; "Edited 26-Nov-2024 20:54 by rmk") (* ; "Edited 3-Mar-2024 12:58 by rmk") (* ; "Edited 12-Feb-2024 12:33 by rmk") (* ; "Edited 22-Nov-2023 20:23 by rmk") (* ; "Edited 21-Oct-2023 10:52 by rmk") (* ; "Edited 9-May-2023 13:50 by rmk") (* ; "Edited 7-May-2023 20:47 by rmk") (* ;; "Prints up to NP pieces from SELPIECES.") (if (TEXTOBJ NP T) then (SETQ TEXTOBJ (TEXTOBJ NP)) (SETQ NP NIL) elseif (TEXTOBJ OFILE T) then (SETQ TEXTOBJ (TEXTOBJ OFILE)) (SETQ OFILE NIL) else (GTO TEXTOBJ)) (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE (CL:UNLESS OFILE 'SSP) NIL) (for PC inselpieces SELPIECES as I from 1 to (OR NP 50) do (PRINTOUT OFILE .I3 I "/") (SPPRINT PC OFILE TEXTOBJ))) SELPIECES]) (SPF [LAMBDA (ARG TITLE OFILE) (* ; "Edited 11-Apr-2025 12:16 by rmk") (* ; "Edited 29-Mar-2025 22:36 by rmk") (* ; "Edited 30-Aug-2024 21:25 by rmk") (* ; "Edited 15-Aug-2024 22:39 by rmk") (* ; "Edited 13-Aug-2024 10:45 by rmk") (* ; "Edited 11-Jul-2024 10:34 by rmk") (* ; "Edited 19-Jan-2024 22:32 by rmk") (* ; "Edited 6-Nov-2023 21:24 by rmk") (* ;;  "PAGEFRAMES can be one or more PAGEREGIONs. ARG can be a TEXTOBJ or one of the PAGEREGIONS.") (LET (TEXTOBJ PAGEREGIONS) (if (AND ARG (for PF inside ARG always (type? PAGEREGION PF))) then (SETQ PAGEREGIONS ARG) else (SETQ TEXTOBJ (GTO ARG)) (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) (SETQ TEXTOBJ (TEXTOBJ (\TEDIT.MAINW TEXTOBJ)))) (SETQ PAGEREGIONS (GETTOBJ TEXTOBJ TXTPAGEFRAMES))) (SETQ TITLE (CONCAT "Page regions for " (OR TITLE TEXTOBJ PAGEREGIONS))) (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE 'SPF TITLE) (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD) TITLE .FONT '(TERMINAL 8) T) (for TYPE PF (FIRSTPF _ (TEDIT.GET.PAGEFORMAT PAGEREGIONS 'FIRST/DEFAULT)) in '(FIRST/DEFAULT LEFT RIGHT) collect (SETQ PF (TEDIT.GET.PAGEFORMAT PAGEREGIONS TYPE)) (PRINTOUT OFILE T .FONT '(TERMINAL 8 BOLD) (L-CASE TYPE T) " region " PF .FONT '(TERMINAL 8)) (if (AND (EQ PF FIRSTPF) (NEQ TYPE 'FIRST/DEFAULT)) then (PRINTOUT OFILE " defaults to first" T) else (TERPRI OFILE) (PRINTDEF (SPF1 PF) NIL NIL NIL NIL OFILE)) (TERPRI OFILE) PF]) (SLF [LAMBDA (FORMATSTREAM OUTFILE TITLE SHOWPAGEFRAMES) (* ; "Edited 14-Dec-2024 12:38 by rmk") (* ; "Edited 24-Nov-2024 22:28 by rmk") (* ; "Edited 23-Nov-2024 13:21 by rmk") (* ; "Edited 14-Jan-2024 13:14 by rmk") (* ; "Edited 19-Dec-2023 10:20 by rmk") (* ; "Edited 28-Aug-2023 21:58 by rmk") (* ; "Edited 26-Aug-2023 20:07 by rmk") (RESETLST [if (GTS FORMATSTREAM T) then (SETQ FORMATSTREAM (TXTFILE (GTS FORMATSTREAM))) else (RESETSAVE (SETQ FORMATSTREAM (\TEDIT.OPENTEXTFILE FORMATSTREAM)) '(PROGN (CLOSEF? OLDVALUE] [RESETSAVE (GETFILEPTR FORMATSTREAM) '(PROGN (SETFILEPTR FORMATSTREAM OLDVALUE] [SELECTQ OUTFILE (NIL) ((T TEDIT) [SETQ OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL '(APPEND QUIET FONT DEFAULTFONT]) (RESETSAVE (SETQ OUTFILE (OPENSTREAM OUTFILE 'OUTPUT 'NEW)) `(PROGN (CLOSEF? OUTFILE OLDVALUE) (AND (EQ RESETSTATE 'ERROR) (DELFILE OLDVALUE] (PROG* ((TRAILER (\TEDIT.GET.TRAILER FORMATSTREAM)) (PCCOUNT (CADDDR TRAILER))) (CL:UNLESS TRAILER (PRINTOUT T FORMATSTREAM " is not a Tedit looks file" T) (RETURN)) (for PCNO BYTELEN LTYPE LOOKSMAP PLOOKSMAP LASTCHARLOOKNO (PFPOS _ 0) (CHNO _ 0) (TEXTPCNO _ 0) (START _ (CAR TRAILER)) (TYPETAB _ 13) (FPOSTAB _ 28) (BYTESTAB _ 38) from 1 to PCCOUNT first (PRINTOUT OUTFILE "Starting FILEPTR = " START " " "PCCOUNT = " PCCOUNT T) (SETFILEPTR FORMATSTREAM START) do (SETQ BYTELEN (\DWIN FORMATSTREAM)) (SETQ LTYPE (\WIN FORMATSTREAM)) (if (EQ \PieceDescriptorPARA LTYPE) then (TERPRI OUTFILE) else (PRINTOUT OUTFILE PCNO "|" (IDIFFERENCE (GETFILEPTR FORMATSTREAM) 6))) (SELECTC LTYPE (\PieceDescriptorPARA (LET ((PLOOKNO (\WIN FORMATSTREAM)) PLOOK) (SETQ PLOOK (ELT PARAMAP PLOOKNO)) (PRINTOUT OUTFILE .TAB TYPETAB "Paragraph looks " PLOOKNO ": " (SUBSTRING PLOOK (ADD1 (STRPOS ":" PLOOK 6)) -2) T))) (\PieceDescriptorLOOKS (LET ((FLAGS (BIN FORMATSTREAM)) LOOKNO FAT CLOOK) (SETQ FAT (EQ 2 (LOGAND FLAGS 2))) (SETQ LOOKNO (\WIN FORMATSTREAM)) (SETQ CLOOK (ELT LOOKSMAP LOOKNO)) (SETQ LASTCHARLOOKNO LOOKNO) (ADD TEXTPCNO 1) (PRINTOUT OUTFILE .TAB TYPETAB "Char piece #" TEXTPCNO " " .I3 PFPOS "-" (CL:IF FAT (SLF.FATPLEN FORMATSTREAM PFPOS BYTELEN) BYTELEN) (CL:IF FAT " fat" "") .TAB BYTESTAB .I4 BYTELEN " bytes") (CL:IF (EQ 1 (LOGAND FLAGS 1)) " New" "") (PRINTOUT OUTFILE " " "Looks " LOOKNO ": ") (PRIN3 (CAR (\TEDIT.CHARLOOKS.DEFPRINT CLOOK NIL NIL T)) OUTFILE) (TERPRI OUTFILE) (ADD PFPOS BYTELEN))) (\PieceDescriptorOBJECT (ADD TEXTPCNO 1) (PRINTOUT OUTFILE .TAB TYPETAB "Objt piece #" TEXTPCNO " " PFPOS "-1" -1 .I4 BYTELEN " bytes") (PRINTOUT OUTFILE " " (\ATMIN FORMATSTREAM) " ") (LET (CLOOK INDEX) (SELECTQ (BIN FORMATSTREAM) (0 (SETQ CLOOK (ELT LOOKSMAP LASTCHARLOOKNO)) (PRINTOUT OUTFILE "Previous looks " LASTCHARLOOKNO " ")) (1 (SETQ CLOOK (\TEDIT.GET.SINGLE.CHARLOOKS FORMATSTREAM)) (PRINTOUT OUTFILE "Inline looks ")) (SHOULDNT)) (PRIN3 (CAR (\TEDIT.CHARLOOKS.DEFPRINT CLOOK NIL NIL T)) OUTFILE) (TERPRI OUTFILE)) (ADD PFPOS BYTELEN)) (\PieceDescriptorPAGEFRAME (LET ((PFS (READ FORMATSTREAM))) (PRINTOUT OUTFILE .TAB TYPETAB "Pageframes") (if SHOWPAGEFRAMES then (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 4) .PPV PFS) else (PRINTOUT OUTFILE "..." T)) (TERPRI OUTFILE))) (\PieceDescriptorCHARLOOKSLIST (PRINTOUT OUTFILE .TAB TYPETAB "Charlooks list") (add PCNO -1) (* ; "Lists don't count in this format") (LET ((CHARLOOKLIST (\TEDIT.GET.CHARLOOKS.LIST FORMATSTREAM))) (SETQ LOOKSMAP (ARRAY (LENGTH CHARLOOKLIST))) (for I from 1 as CSLOOKS IN CHARLOOKLIST do (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 2) .I2 I ": " (CL:IF (type? FONTCLASS (fetch (CHARLOOKS CLFONT) of CSLOOKS)) (fetch (FONTCLASS FONTCLASSNAME) of (fetch (CHARLOOKS CLFONT) of CSLOOKS)) CSLOOKS) T) (SETA LOOKSMAP I CSLOOKS)))) (\PieceDescriptorPARALOOKSLIST (PRINTOUT OUTFILE .TAB TYPETAB "Paralooks list") (add PCNO -1) (* ; "Lists don't count in this format") (LET ((PARALOOKS (\TEDIT.GET.PARALOOKS.LIST FORMATSTREAM))) (SETQ PARAMAP (ARRAY (LENGTH PARALOOKS))) (for I from 1 as PLOOKS in PARALOOKS do (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 2) .I2 I ": " PLOOKS T) (SETA PARAMAP I PLOOKS)) (TERPRI OUTFILE))) "Unknown type")) (if (TEXTSTREAMP OUTFILE) then (* ;;  "Don't return the text stream, let it be collected when the window closes") [TEDIT OUTFILE 'Looks% File NIL `(LEAVE TTY TITLE ,(OR TITLE (CONCAT "SLF for " (FULLNAME FORMATSTREAM ] else (RETURN OUTFILE))))]) (SHOWLINE [LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 20-Nov-2024 00:31 by rmk") (* ; "Edited 17-Nov-2024 15:56 by rmk") (* ; "Edited 9-Nov-2024 10:37 by rmk") (* ; "Edited 1-Sep-2024 16:49 by rmk") (* ; "Edited 10-May-2024 00:27 by rmk") (* ; "Edited 2-Dec-2023 23:07 by rmk") (* ; "Edited 29-Sep-2023 12:37 by rmk") (* ; "Edited 26-Sep-2023 17:22 by rmk") (* ; "Edited 15-Jul-2023 21:19 by rmk") (* ; "Edited 2-Jul-2023 23:55 by rmk") (LET ((LOC (LOC LINE))) (PRINTOUT FILE .FONT '(TERMINAL 8) "L" (CAR LOC) "/" (CDR LOC) ": " 13 .I4 (GETLD LINE LHEIGHT) " " %# (CL:IF (GETLD LINE YBOT) (PRINTOUT NIL .I5 (GETLD LINE YBOT)) (PRINTOUT T "---")) " " .FONT '(TERMINAL 8 BOLD) .I5 (GETLD LINE LCHAR1) " -> " .I5 (GETLD LINE LCHARLAST) .FONT '(TERMINAL 8) " " .I3 (GETLD LINE LNCH) (CL:IF (GETLD LINE LSTLN) "*" " ") .FONT '(TERMINAL 6) " ") (if (GETLD LINE LDUMMY) then (PRINTOUT FILE -8 (CL:IF (GETLD LINE LDUMMY) "l" "") "dummy" T) else (for CNO C LASTC (TSTREAM _ (TEXTSTREAM TEXTOBJ)) from (GETLD LINE LCHAR1) to (GETLD LINE LCHARLAST) first (SETFILEPTR TSTREAM (SUB1 (GETLD LINE LCHAR1))) (PRINTOUT FILE " %"") until (EOFP TSTREAM) do (SETQ C (BIN TSTREAM)) (* ;  "This may read LF if that's what's on the file") (if (SMALLP C) then (SETQ LASTC C) (SELCHARQ C (TAB (PRIN3 "[TAB]" FILE)) ((EOL CR) (PRIN3 "[EOL]" FILE)) (LF (PRIN3 "[LF]" FILE)) (FORM (PRIN3 "[FORM]" FILE)) (meta,EOL (PRIN3 "[MLB]" FILE)) (PRINTCCODE C FILE)) elseif (IMAGEOBJP C) then (printout FILE " " C " ")) finally (PRIN3 "%"" FILE) (TERPRI FILE) (CL:WHEN (GETLD LINE FORCED-END) (TERPRI FILE]) (SLL [LAMBDA (LINELIST FILE TEXTOBJ) (* ; "Edited 2-Jul-2023 23:48 by rmk") (* ;; "Show a list of lines.") (SETQ TEXTOBJ (GTO TEXTOBJ)) (RESETLST [RESETSAVE (DSPFONT '(TERMINAL 8) FILE) '(PROGN (DSPFONT OLDVALUE FILE] (for L inside LINELIST do (if (LISTP L) then (PRINTOUT FILE T "SUBLIST:" T) (SLL L FILE TEXTOBJ) elseif L then (SHOWLINE L FILE TEXTOBJ) else (PRINTOUT FILE "(NIL LINE)" T))))]) (STBYTES [LAMBDA (FILE OUTFILE) (* ; "Edited 12-Dec-2024 16:44 by rmk") (* ;; "Shows the bytes that ought to make up the trailer for FILE as a Tedit formatted file.") (SETQ FILE (FINDFILE-WITH-EXTENSIONS FILE NIL *TEDIT-EXTENSIONS*)) (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) (LET (VERSION) (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) 8)) (PRINTOUT OUTFILE "Piece start: " (BIN STREAM) " " (BIN STREAM) " " (BIN STREAM) " " (BIN STREAM) " = ") (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) 8)) (PRINTOUT OUTFILE (\DWIN STREAM) T) (PRINTOUT OUTFILE "Piece count: " (BIN STREAM) " " (BIN STREAM) " = ") (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) 4)) (PRINTOUT OUTFILE (\WIN STREAM) T) (PRINTOUT OUTFILE "Version: " (BIN STREAM) " " (BIN STREAM) " = ") (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) 2)) (SETQ VERSION (\SMALLPIN STREAM)) (PRINTOUT OUTFILE VERSION " (" (IDIFFERENCE VERSION 31415) ")" T]) (SSEL [LAMBDA (SEL TEXTOBJ OFILE) (* ; "Edited 3-Feb-2025 23:05 by rmk") (SETQ TEXTOBJ (GTO TEXTOBJ)) (CL:UNLESS SEL (SETQ SEL (TEXTSEL TEXTOBJ))) (for I from (GETSEL SEL CH#) to (GETSEL SEL CHLAST) do (PRINTOUT OFILE (TEDIT.NTHCHAR TEXTOBJ I)) ) (TERPRI OFILE]) ) (DEFINEQ (STL [LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 11-Apr-2025 13:02 by rmk") (* ; "Edited 29-Mar-2025 22:36 by rmk") (* ; "Edited 22-Aug-2024 23:51 by rmk") (* ; "Edited 4-Aug-2024 12:08 by rmk") (* ; "Edited 31-Jul-2024 19:55 by rmk") (* ; "Edited 29-Jul-2024 09:20 by rmk") (* ; "Edited 1-Feb-2024 17:00 by rmk") (* ; "Edited 25-Nov-2023 10:50 by rmk") (* ; "Edited 23-Nov-2023 11:41 by rmk") (* ; "Edited 23-Mar-2023 23:00 by rmk") (* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done. During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible. When complete, they shouldn't appear.") (* ;; "If OFILE isn't given, this goes to a textstream") (DECLARE (USEDFREE PREVSP CHARSLOT)) (CL:UNLESS (type? THISLINE THISLINE) (CL:WHEN (EQ THISLINE T) (SETQ THISLINE NIL) (SETQ LASTCS CHARSLOT)) (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) (\DTEST THISLINE 'THISLINE) (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE (CL:IF OFILE NIL 'STL) NIL 80) (for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW CHARCL (SPACEFACTOR _ (FETCH TLSPACEFACTOR OF THISLINE)) (FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE)) (LINE _ (fetch (THISLINE DESC) of THISLINE)) (NSPACES _ 0) (NCHARS _ 0) (SPACETOTAL _ 0) (PSP _ (AND (BOUNDP 'PREVSP) (NEQ PREVSP (GETATOMVAL 'PREVSP)) PREVSP)) incharslots THISLINE as NSLOTS from 0 first (if (NULL LINE) then (printout OFILE THISLINE ":" T 5 "No line parameters, start at CHNO = 1 LX1 = 0" T) (SETQ CHNO 1) (SETQ TX 0) elseif (type? LINEDESCRIPTOR LINE) then (SETQ CHNO (GETLD LINE LCHAR1)) (SETQ TX (GETLD LINE LX1)) (printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO " LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM) T)) (CL:WHEN LCHAR1 (SETQ CHNO (OR LCHAR1 1))) (SETQ LENGTH TX) (printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT)) (SETQ CHARW (CHARW CSLOT)) (SETQ CHARCL (CHARCL CSLOT)) (CL:UNLESS (CHARSLOTP CSLOT THISLINE) (HELP "THISLINE RUNS OFF THE EDGE" THISLINE)) repeatuntil [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE] do (printout OFILE .I4 NSLOTS) [if (IMAGEOBJP CHAR) then (add NCHARS 1) (printout OFILE " " .I5 CHNO ": ") (add TX CHARW) (printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ") (SPPRINT.OBJ CHAR OFILE) (add LENGTH CHARW) (ADD CHNO 1) elseif (SMALLP CHAR) then (add NCHARS 1) (printout OFILE " " .I5 CHNO ": ") (printout OFILE .I3 CHAR " " (SELCHARQ CHAR ((EOL CR LF) (add TX CHARW) (add LENGTH CHARW) "EOL") (FORM "FORM") (SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT) (SETQ EXPANDSPACES T)) (if EXPANDSPACES then (add LENGTH (SCALEUP SPACEFACTOR CHARW)) (add TX (SCALEUP SPACEFACTOR CHARW)) else (add LENGTH CHARW) (add TX CHARW)) (ADD NSPACES 1) " ") (TAB (add LENGTH CHARW) (add TX CHARW) "TAB") (Meta,TAB (add LENGTH CHARW) (add TX CHARW) "MTAB") (PROGN (add LENGTH CHARW) (add TX CHARW) (CHARACTER CHAR))) .FR 28 CHARW " " .I4 TX 35 CHARCL 64 CSLOT) (ADD CHNO 1) elseif [AND [OR (CHARSLOTP CHAR THISLINE) (AND (NULL CHAR) (NOT (TYPE? CHARLOOKS CHARW] (OR (EQ CSLOT PSP) (find CS incharslots (NEXTCHARSLOT CSLOT) while (CHARSLOTP CS THISLINE) suchthat (EQ CSLOT CHAR] then (* ; "Presumably a PREVSP") (ADD NSPACES 1) (printout OFILE " " .I5 CHNO ":") (ADD LENGTH CHARW) (ADD TX CHARW) (PRINTOUT OFILE " " (OR CHAR "[ENDSP]") .FR 28 CHARW " " .I4 TX 35 CSLOT) (ADD CHNO 1) elseif (SMALLP CHARW) then (if (EQ CSLOT FIRSTSPACESLOT) then (PRINTOUT OFILE "First space") else (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW) (add CHNO CHARW)) elseif (type? CHARLOOKS CHARW) then (printout OFILE 7 CHARW 35 CSLOT) else (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T ) (TERPRI OFILE) (GO $$OUT) (AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? ")) (TERPRI OFILE) (GO $$OUT))] (TERPRI OFILE) finally (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2 "next avail = " (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE) T) (printout OFILE "line length = " LENGTH -3 "right margin = " (AND LINE (GETLD LINE RIGHTMARGIN)) -3 "X limit = " (AND LINE (GETLD (fetch (THISLINE DESC) of THISLINE) LXLIM)) T) (printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = " (CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR)) T]) (CLEARTHISLINE [LAMBDA (TSTREAM) (* ; "Edited 11-Apr-2025 11:04 by rmk") (* ; "Edited 6-Mar-2025 11:28 by rmk") (LET ((THISLINE (GETTOBJ (GTO TSTREAM) THISLINE))) (replace (THISLINE DESC) of THISLINE with NIL) (for CSLOT incharslots THISLINE do (FILLCHARSLOT CSLOT NIL NIL NIL]) (CHARSLOTP [LAMBDA (X TL) (* ; "Edited 30-May-2025 21:57 by rmk") (* ;; "True if TL is a THISLINE and X is a pointer into its CHARSLOTS block. A tool for consistency assertions.") (CL:WHEN (TYPE? THISLINE TL) [LET [(FIRSTSLOT (FIRSTCHARSLOT TL)) (LASTSLOT (LASTCHARSLOT TL)) (LASTUSEDSLOT (PREVCHARSLOT (fetch (THISLINE NEXTAVAILABLECHARSLOT) of TL] (AND [OR (IGREATERP (\HILOC X) (\HILOC FIRSTSLOT)) (AND (EQ (\HILOC X) (\HILOC FIRSTSLOT)) (IGEQ (\LOLOC X) (\LOLOC FIRSTSLOT] [OR (ILESSP (\HILOC X) (\HILOC LASTUSEDSLOT)) (AND (EQ (\HILOC X) (\HILOC LASTUSEDSLOT)) (ILEQ (\LOLOC X) (\LOLOC LASTUSEDSLOT] (OR (ILESSP (\HILOC X) (\HILOC LASTSLOT)) (AND (EQ (\HILOC X) (\HILOC LASTSLOT)) (ILEQ (\LOLOC X) (\LOLOC LASTSLOT])]) (\TLVALIDATE [LAMBDA (THISLINE LINE) (* ; "Edited 31-May-2025 10:29 by rmk") (* ; "Edited 29-May-2025 15:28 by rmk") (* ; "Edited 21-Oct-2024 00:26 by rmk") (* ; "Edited 15-Mar-2024 19:33 by rmk") (* ; "Edited 7-Nov-2022 10:16 by rmk") (* ;; "Check validity of THISLINE, anytime after \TEDIT.FORMATLINE") (CL:WHEN LINE (CL:UNLESS (EQ (fetch (THISLINE DESC) of THISLINE) LINE) (HELP "THISLINE-DESC is not LINE" THISLINE))) [LET ((CHARSLOTS (fetch (THISLINE CHARSLOTS) of THISLINE))) (CL:UNLESS (type? ARRAYBLOCK CHARSLOTS) (HELP "CHARSLOTS is not an ARRAYBLOCK" THISLINE)) (\CHECKARRAYBLOCK (\ADDBASE CHARSLOTS (IMINUS \ArrayBlockHeaderWords] (for CHARSLOT incharslots THISLINE do (CL:UNLESS (OR (CHARCODEP CHAR) (IMAGEOBJP CHAR) (CHARSLOTP CHAR THISLINE)) (* ;; "CHARSLOTP if spaces haven't been instantiated") (HELP "BAD CHARSLOT CHAR" CHARSLOT)) (CL:UNLESS (SMALLP CHARW) (HELP "BAD CHARSLOT CHARW" CHARSLOT)) (CL:UNLESS (type? CHARLOOKS CHARCL) (HELP "BAD CHARSLOT CLOOKS" CHARSLOT]) ) (DEFINEQ (NTHPIECE [LAMBDA (PIECES N) (* ; "Edited 16-Mar-2024 10:07 by rmk") (* ; "Edited 16-Sep-2023 12:17 by rmk") (* ; "Edited 22-Jun-2023 12:46 by rmk") (* ; "Edited 22-May-2023 21:21 by rmk") (* ; "Edited 9-Apr-2023 11:36 by rmk") (* ;; "N=0 means the previous piece of PIECES (if any). This might be the dummy empty piece before the firstpiece of a text object.") (CL:UNLESS (type? PIECE PIECES) (SETQ PIECES (\TEDIT.FIRSTPIECE (GTO PIECES)))) (if (NULL N) then (SETQ N 1) elseif (ILESSP N 0) then (SETQ N (IPLUS (NPIECES PIECES) N 1))) (if (EQ N 0) then (PREVPIECE PIECES) else (for PC inpieces PIECES as I from 1 when (EQ I N) do (RETURN PC]) (NPIECES [LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2024 10:07 by rmk") (* ; "Edited 2-Sep-2023 11:02 by rmk") (* ; "Edited 6-Apr-2023 23:39 by rmk") (* ; "Edited 24-Mar-2023 10:20 by rmk") (* ; "Edited 21-Aug-2022 14:47 by rmk") (* ; "Edited 8-Aug-2022 08:52 by rmk") (for PC inpieces [if (type? PIECE TSTREAM) then TSTREAM else (NEXTPIECE (\TEDIT.FIRSTPIECE (GTO TSTREAM] count T]) (NTHPIECECHAR [LAMBDA (PC N) (* ; "Edited 26-Sep-2023 17:48 by rmk") (* ; "Edited 8-May-2023 21:25 by rmk") (* ; "Edited 24-Oct-2022 21:10 by rmk") (* ;; "Gets the Nth CHAR of PC, 0 origin. The last character is either -1 or (SUB1 PLEN)") (LET ((PLEN (PLEN PC)) (PCONTENTS (PCONTENTS PC))) (CL:WHEN (ILESSP N 0) (add N PLEN)) (CL:WHEN (AND (IGEQ N 0) (ILESSP N PLEN)) (SELECTC (PTYPE PC) (STRING.PTYPES (NTHCHARCODE PCONTENTS N)) (THINFILE.PTYPE (SETFILEPTR PCONTENTS (IPLUS N (fetch (PIECE PFPOS) of PC))) (BIN PCONTENTS)) (FATFILE2.PTYPE (SETFILEPTR PCONTENTS (IPLUS (UNFOLD N 2) (fetch (PIECE PFPOS) of PC))) (LOGOR (UNFOLD (BIN PCONTENTS) 256) (BIN PCONTENTS))) (OBJECT.PTYPE PCONTENTS) (SHOULDNT)))]) (SELPIECE [LAMBDA (ARG) (* ; "Edited 17-Mar-2024 12:58 by rmk") (* ; "Edited 10-Aug-2023 16:57 by rmk") (* ;; "Returns the piece containing the first character of the current selection") (SETQ ARG (GTO ARG)) (\TEDIT.CHTOPC (GETSEL (TEXTSEL ARG) CH#) ARG]) (PIECENUM [LAMBDA (PIECE ARG) (* ; "Edited 23-Nov-2024 13:10 by rmk") (* ; "Edited 16-Mar-2024 10:07 by rmk") (* ; "Edited 16-Sep-2023 09:08 by rmk") (* ;; "Returns N if PIECE is the NTH piece of PIECES") (CL:UNLESS (type? PIECE PIECE) (ERROR "NOT A PIECE" PIECE)) (LET [(PIECES (if (type? PIECE ARG) then ARG else (\TEDIT.FIRSTPIECE (GTO ARG] (find I from 1 as PC inpieces PIECES suchthat (EQ PC PIECE]) (PCBYTES [LAMBDA (PC) (* ; "Edited 31-Jan-2024 22:32 by rmk") (* ; "Edited 23-Jan-2024 12:04 by rmk") (* ; "Edited 5-Jan-2024 11:14 by rmk") (* ;; "Returns a list of the PFILE bytes for file-piece PC") (CL:WHEN (MEMB (PTYPE PC) FILE.PTYPES) [LET ((PFILE (PCONTENTS PC))) (SETFILEPTR PFILE (PFPOS PC)) (for I BYTE from 1 to (PBYTELEN PC) collect (SETQ BYTE (BIN PFILE)) (LIST I (CHARACTER BYTE) BYTE (SUB1 (GETFILEPTR PFILE])]) ) (DEFINEQ (FILEBYTES [LAMBDA (FILE START NBYTES) (* ; "Edited 15-May-2024 10:44 by rmk") (* ; "Edited 23-Jan-2024 12:03 by rmk") (* ; "Edited 20-Jan-2024 14:13 by rmk") (* ;; "CHARS means return CHARACTER of bytes, since we don't know whether START respects FILES external format alignments.") (CL:WHEN (GTO FILE T) (SETQ FILE (SELPIECE FILE))) (CL:WHEN (type? PIECE FILE) (CL:WHEN (MEMB (PTYPE FILE) FILE.PTYPES) (CL:UNLESS START (SETQ START (PFPOS FILE))) (SETQ FILE (PCONTENTS FILE)))) (CL:UNLESS START (SETQ START 0)) (CL:UNLESS NBYTES (SETQ NBYTES 40)) (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) (SETFILEPTR STREAM START) (SETQ NBYTES (IMIN NBYTES (IDIFFERENCE (GETEOFPTR STREAM) START))) (FOR I B FROM START AS J FROM 1 TO NBYTES COLLECT (SETQ B (BIN STREAM)) (* ;; "Do CHARACTER of the byte, since we don't know whether START respected FILE's external-format character alignment.") (LIST I B (CHARACTER B]) (TFILEBYTES [LAMBDA (FILE START NBYTES) (* ; "Edited 14-Dec-2024 00:04 by rmk") (* ; "Edited 23-Nov-2024 15:41 by rmk") (* ; "Edited 23-Sep-2024 11:40 by rmk") (LET ((BYTES (FILEBYTES FILE START NBYTES))) (TEVAL (for B in BYTES first (DSPFONT DEFAULTFONT T) do (printout T .I6 (CAR B) " " .I3 (CADR B) " " .FONT '(MODERN 8) (SELCHARQ (CADR B) (EOL 'EOL) (LF 'LF) (CR 'CR) (SPACE "SP") (CADDR B)) .FONT DEFAULTFONT T) T) 'FILEBYTES (CONCAT "Bytes from " FILE]) ) (DEFINEQ (TRELMOVE [LAMBDA (DY ARG) (* ; "Edited 5-Nov-2024 15:29 by rmk") (RELMOVEW (GTW ARG) (create POSITION XCOORD _ 0 YCOORD _ DY]) (TSCROLL [LAMBDA (DY ARG) (* ; "Edited 5-Nov-2024 15:30 by rmk") (SCROLLW (GTW ARG) 0 DY]) (TSCROLL* [LAMBDA (DIST ARG) (* ; "Edited 27-Nov-2024 17:17 by rmk") (* ;; "Repeatedly scrolls up or down by DIST") (bind (W _ (GTW ARG)) do (SELECTQ [ASKUSER NIL NIL NIL '((U NIL CONFIRMFLG NIL RETURN 'UP) (D NIL CONFIRMFLG NIL RETURN 'DOWN) (F NIL CONFIRMFLG NIL RETURN 'FINISHED] (UP (SCROLLW W 0 DIST)) (DOWN (SCROLLW W 0 (IMINUS DIST))) (FINISHED (RETURN)) (RETURN]) ) (DEFINEQ (TRY [LAMBDA (FILE VAR KEEPOPEN) (* ; "Edited 17-Mar-2024 12:57 by rmk") (* ; "Edited 5-Sep-2022 18:48 by rmk") (* ; "Edited 1-Sep-2022 22:43 by rmk") (* ; "Edited 10-Aug-2022 13:12 by rmk") (* ; "Edited 1-Aug-2022 21:30 by rmk") (CL:UNLESS VAR (SETQ VAR 'TSTR)) (LET [(TSTREAM (AND (BOUNDP VAR) (TEXTSTREAMP (EVAL VAR] (CL:WHEN (AND TSTREAM (OPENWP (WFROMDS TSTREAM))) (CL:UNLESS KEEPOPEN (CLOSEW (WFROMDS TSTREAM)))) (SETQ TSTREAM (OPENTEXTSTREAM (SELECTQ FILE (NIL '{LI}FEW.TXT) (T '{LI}LOTS.TXT) FILE))) (TEDIT TSTREAM (CREATEREGION 817 900 397 80) NIL '(LEAVETTY T)) (SET VAR TSTREAM) (PROG1 (ITS TSTREAM KEEPOPEN) (\TEDIT.CHECK-BTREE TSTREAM]) (TEDITCLOSEW [LAMBDA NIL (* ; "Edited 1-Sep-2022 22:52 by rmk") (LET ((W (WHICHW))) (CL:WHEN (MEMB 'TEDIT.DEACTIVATE.WINDOW (WINDOWPROP W 'CLOSEFN)) [WINDOWPROP W 'CLOSEFN (REMOVE 'TEDIT.DEACTIVATE.WINDOW (WINDOWPROP W 'CLOSEFN] (CLOSEW W))]) (PARALASTWITHOUTEOL [LAMBDA (TSTREAM HELP) (* ; "Edited 17-Mar-2024 12:55 by rmk") (* ; "Edited 16-Mar-2024 10:06 by rmk") (* ; "Edited 21-Oct-2023 10:54 by rmk") (* ; "Edited 24-Oct-2022 21:07 by rmk") (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) (for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) when (PPARALAST PC) unless (MEMB (NTHPIECECHAR PC -1) (CHARCODE (EOL CR LF))) do (SPPRINT PC NIL TEXTOBJ) (CL:WHEN HELP (HELP PC (\TEDIT.PCTOCH PC TEXTOBJ)))]) (FIXPARALAST [LAMBDA (TSTREAM HELP) (* ; "Edited 16-Mar-2024 10:06 by rmk") (* ; "Edited 24-Oct-2022 21:59 by rmk") (for (PC _ (\TEDIT.FIRSTPIECE (TEXTOBJ TSTREAM))) by (NEXTPIECE PC) while PC when (PPARALAST PC) unless (MEMB (NTHPIECECHAR PC -1) (CHARCODE (EOL CR LF))) do (replace (PIECE PPARALAST) of PC with NIL]) ) (DEFINEQ (SPPRINT [LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "Edited 24-Apr-2025 16:04 by rmk") (* ; "Edited 19-Feb-2025 12:21 by rmk") (* ; "Edited 8-Feb-2025 22:41 by rmk") (* ; "Edited 5-Aug-2024 00:30 by rmk") (* ; "Edited 5-May-2024 12:55 by rmk") (* ; "Edited 23-Apr-2024 08:54 by rmk") (* ; "Edited 17-Mar-2024 12:58 by rmk") (* ; "Edited 22-Jan-2024 20:52 by rmk") (* ; "Edited 13-Jan-2024 23:54 by rmk") (* ; "Edited 28-Dec-2023 21:21 by rmk") (* ; "Edited 26-Dec-2023 09:00 by rmk") (* ; "Edited 23-Dec-2023 16:55 by rmk") (* ; "Edited 7-Dec-2023 15:55 by rmk") (* ; "Edited 9-Nov-2023 17:04 by rmk") (* ; "Edited 24-Oct-2022 17:13 by rmk") (* ; "Edited 8-Aug-2022 15:36 by rmk") (* ;  "TMAX image objects want TEXTOBJ context, although they shouldn't") (DECLARE (SPECVARS TEXTOBJ)) (CL:WHEN (FIXP P) (SETQ P (\TEDIT.CHTOPC P TEXTOBJ))) (* ;; "Prints a summary of PC on OSTREAM. If PC is acharno and TEXTOBJ is provided, maps the CHNO to its pc.") (COND ((PCONTENTS P) (LET ((POS (POSITION OSTREAM)) (PLEN (PLEN P)) (PCONTENTS (PCONTENTS P)) (PTYPE (PTYPE P)) (CHNO (CL:IF (FGETPC P PTREENODE) (\TEDIT.PCTOCH P TEXTOBJ) 1)) (FONT (DSPFONT NIL OSTREAM)) (PARALOOKS (PPARALOOKS P))) (CL:WHEN (AND (STREAMP PCONTENTS) (NOT (\GETSTREAM PCONTENTS 'INPUT T))) (SETQ PCONTENTS (\TEDIT.REOPEN.STREAM TEXTOBJ PCONTENTS))) (PRINTOUT OSTREAM .TAB0 POS .I3 CHNO " P" (SUBSTRING P (IPLUS 2 (STRPOS "}" P))) .TAB0 (IPLUS 22 POS) " ") (CL:WHEN (MEMB PTYPE FILE.PTYPES) (SETFILEPTR PCONTENTS (PFPOS P))) (PRINTOUT OSTREAM (SELECTC PTYPE (THINFILE.PTYPE 'Thinfile) (FATFILE1.PTYPE "Fatfile1") (FATFILE2.PTYPE 'Fatfile2) (THINSTRING.PTYPE 'Thinstring) (FATSTRING.PTYPE 'Fatstring) (UTF8.PTYPE 'UFT-8) (SUBSTREAM.PTYPE 'Substream) (OBJECT.PTYPE 'Object) (LOOKS.PTYPE 'Looks) NIL) .TAB0 (IPLUS POS 35) .I4 PLEN (CL:IF (PPARALAST P) "*" "") (CL:IF (type? PARALOOKS PARALOOKS) (if (GETPLOOKS PARALOOKS FMTNEWPAGEBEFORE) then (CL:IF (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER) "ba" "b") elseif (GETPLOOKS PARALOOKS FMTNEWPAGEAFTER) then "a" else "") "") .TAB0 (IPLUS POS 43)) (CL:WHEN (EQ OSTREAM T) (DSPFONT '(MODERN 8) OSTREAM)) [if (EQ PLEN 0) then (PRINTOUT OSTREAM "[Empty piece]" T) elseif (EQ OBJECT.PTYPE (PTYPE P)) then (PRINTOUT OSTREAM PCONTENTS -3) (SPPRINT.OBJ PCONTENTS OSTREAM (IPLUS POS 43)) else (CL:WHEN (AND (type? CHARLOOKS (PLOOKS P)) (fetch (CHARLOOKS CLINVISIBLE) of (PLOOKS P))) (PRIN1 "i " OSTREAM)) (PRIN1 "%"" OSTREAM) (for I C from 1 to PLEN do (SETQ C (\TEDIT.PIECE.NTHCHARCODE P I)) (PRIN1 (SELCHARQ C ((EOL CR) "[EOL]") (LF "[LF]") (FORM "[FORM]") (TAB "[TAB]") (Meta,TAB "[MTAB]") (Meta,EOL "[MLB]") (CHARACTER C)) OSTREAM) (CL:WHEN (IEQP I PLEN) (PRIN1 '%" OSTREAM)) (CL:WHEN [AND (NOT NOCR) (MEMB C (CHARCODE (EOL CR LF FORM] (TERPRI OSTREAM) (CL:UNLESS (IEQP I PLEN) (DSPFONT (PROG1 (DSPFONT FONT OSTREAM) (* ;; "Add1 for %"") (TAB (ADD1 42) 0 OSTREAM)) OSTREAM)))] (TERPRI OSTREAM) (DSPFONT FONT OSTREAM))) (T (PRINTOUT OSTREAM "Piece has no CONTENTS" P T))) P]) (SPPRINT.CHAR [LAMBDA (C OSTREAM LAST FONT) (* ; "Edited 4-Nov-2023 22:51 by rmk") (* ; "Edited 8-Aug-2023 18:15 by rmk") (* ; "Edited 6-Aug-2023 22:20 by rmk") (HELP 'NOTUSED) (PRIN1 (SELCHARQ C ((EOL CR) "[EOL]") (LF "[LF]") (FORM "[FORM]") (TAB "[TAB]") (Meta,TAB "[MTAB]") (CHARACTER C)) OSTREAM) (CL:WHEN LAST (PRIN1 '%" OSTREAM)) (CL:WHEN (MEMB C (CHARCODE (EOL CR LF FORM))) (TERPRI OSTREAM) (CL:UNLESS LAST (DSPFONT (PROG1 (DSPFONT FONT OSTREAM) (* ;; "Add1 for %"") (TAB (ADD1 42) 0 OSTREAM)) OSTREAM)))]) (SPPRINT.OBJ [LAMBDA (OBJ STREAM POS) (* ; "Edited 9-Jan-2025 16:48 by rmk") (* ; "Edited 6-Oct-2024 20:54 by rmk") (* ; "Edited 29-Sep-2024 14:45 by rmk") (* ; "Edited 29-Aug-2024 10:44 by rmk") (* ; "Edited 25-Aug-2024 14:31 by rmk") (* ; "Edited 21-Aug-2024 09:36 by rmk") (* ; "Edited 5-Aug-2024 00:31 by rmk") (* ; "Edited 1-Aug-2024 00:09 by rmk") (* ; "Edited 28-Jul-2024 09:47 by rmk") (* ; "Edited 26-Jul-2024 13:19 by rmk") (* ; "Edited 23-Apr-2024 15:02 by rmk") (* ; "Edited 29-Jul-2023 23:36 by rmk") (* ; "Edited 16-Jul-2023 15:20 by rmk") (* ; "Edited 8-Jul-2023 23:09 by rmk") (* ; "Edited 25-Jun-2023 18:27 by rmk") (* ; "Edited 28-Sep-2022 11:13 by rmk") (* ; "Edited 7-Sep-2022 15:21 by rmk") (CL:UNLESS [NLSETQ (SELECTQ (IMAGEOBJPROP OBJ 'DISPLAYFN) (MB.NWAY.DISPLAYFN (PRINTOUT STREAM (IMAGEOBJPROP OBJ 'IDENTIFIER) T .TAB (IPLUS POS 2)) (for SOBJ in (IMAGEOBJPROP OBJ 'SUBOBJECTS) do (PRINTOUT STREAM (IMAGEOBJPROP SOBJ 'IDENTIFIER) " "))) (if (OR (IMAGEOBJPROP OBJ 'IDENTIFIER) (IMAGEOBJPROP OBJ 'LABEL)) then (PRIN1 (OR (IMAGEOBJPROP OBJ 'IDENTIFIER) (IMAGEOBJPROP OBJ 'LABEL)) STREAM) elseif (IMAGEOBJPROP OBJ 'PREPRINTFN) then (LET ((PPRINT (APPLY* (IMAGEOBJPROP OBJ 'PREPRINTFN) OBJ STREAM))) (CL:WHEN PPRINT (PRIN1 PPRINT STREAM] (PRIN1 "**IMAGEOBJECT DISPLAY ERROR**" STREAM]) (SHOWPIECEBYTES [LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 15:52 by rmk") (* ; "Edited 21-Oct-2023 10:45 by rmk") (* ;; "Shows the bytes that define the contents of a file piece.")  (* ; "Edited 11-Oct-2022 13:58 by rmk") (SETQ ARG (TEXTOBJ ARG)) (CL:WHEN (FIXP PC) (SETQ PC (NTHPIECE ARG PC))) (CL:UNLESS (TYPE? PIECE PC) (ERROR "NOT A PIECE" PC)) (CL:UNLESS (MEMB (PTYPE PC) FILE.PTYPES) (ERROR "NOT A FILE PIECE TYPE")) (LET ((FILE (PCONTENTS PC)) (FAT (EQ FATFILE2.PTYPE (PTYPE PC))) NBYTES) (SPPRINT PC T ARG) (SETQ NBYTES (CL:IF FAT (UNFOLD (PLEN PC) 2) (PLEN PC))) (SETFILEPTR FILE (PFPOS PC)) (for I from 1 to NBYTES do (PRINTOUT T (BIN FILE) " ")) (TERPRI T) (SETFILEPTR FILE (PFPOS PC)) [for I from 1 to (CL:IF FAT (FOLDLO NBYTES 2) NBYTES) do (PRINTOUT T (CHARACTER (CL:IF FAT (\WIN FILE) (BIN FILE))] (TERPRI T]) (CHECKPLENGTHS [LAMBDA (MSG TOBJ) (* ; "Edited 16-Mar-2024 10:07 by rmk") (* ; "Edited 13-Apr-2023 23:11 by rmk") (find P inpieces (\TEDIT.FIRSTPIECE (GTO TOBJ)) when (ILESSP (PLEN P) 0) do (HELP (CONCAT "negative" MSG) P]) (SBT [LAMBDA (DONTCLOSE ARG) (* ; "Edited 28-Mar-2025 20:41 by rmk") (* ; "Edited 13-Jun-2024 22:00 by rmk") (* ; "Edited 31-Oct-2023 19:44 by rmk") (* ; "Edited 29-May-2023 17:23 by rmk") (* ; "Edited 26-May-2023 11:05 by rmk") (* ;; "Inspect the BTREE") (SETQ ARG (GTO ARG)) (LET ([W (WINDOWP (GETATOMVAL 'BTW] (POS (CREATEPOSITION 50 10))) (if DONTCLOSE then (CL:WHEN W (SETQ POS (CREATEPOSITION [IPLUS 2 (FETCH (REGION RIGHT) OF (WINDOWPROP W 'REGION] 10))) else (CLOSEW W)) (SETATOMVAL 'BTW (INSPECT (GETTOBJ ARG PCTB) 'LIST POS)) (GETTOBJ ARG PCTB]) (COPYPCHAIN [LAMBDA (PIECES I J) (* ; "Edited 23-Sep-2023 11:38 by rmk") (* ;; "Produces a chain of copies of the pieces in PIECES from I to J. The pieces are chained in both directions so a copy can be copied or shortened.") (for PC NEWPC [LASTPC _ (NTHPIECE PIECES (IMIN (NPIECES PIECES) (OR J (NPIECES PIECES] inpieces (NTHPIECE PIECES (IMAX 1 (OR I 1))) do (SETQ NEWPC (create PIECE using PC PREVPIECE _ NEWPC)) repeatuntil (EQ PC LASTPC) finally (RETURN (for NPC NEXTPC backpieces NEWPC do (SETPC NPC NEXTPIECE NEXTPC) (SETQ NEXTPC NPC) finally (RETURN NPC]) ) (DEFINEQ (POSLINE [LAMBDA (FILEPOS INSTREAM OUTSTREAM) (* ; "Edited 7-Aug-2023 22:22 by rmk") (* ; "Edited 6-Aug-2023 09:16 by rmk") (* ;; "Copies the characters in the line containing the byte after FILEPOS (e.g. byte presumably after the one just read) in INSTREAM to OUTSTREAM") (RESETLST (CL:UNLESS (\GETSTREAM INSTREAM 'INPUT T) [RESETSAVE (SETQ INSTREAM (OPENSTREAM INSTREAM 'INPUT)) `(PROGN (CLOSEF? OLDVALUE]) [RESETSAVE (GETFILEPTR INSTREAM) `(PROGN (SETFILEPTR ,INSTREAM OLDVALUE] (* ; "Back up to just read") (LET (START END AFTERCR) (SETFILEPTR INSTREAM FILEPOS) (* ;  "If we just read an EOL, go to the next line") (SETQ AFTERCR (CL:IF (EQ (CHARCODE EOL) (\BACKCCODE.EOLC INSTREAM 'ANY)) (ADD1 FILEPOS) FILEPOS)) (SETFILEPTR INSTREAM AFTERCR) (SETQ START (DO (SELCHARQ (\BACKCCODE.EOLC INSTREAM 'ANY) (EOL (\INCCODE.EOLC INSTREAM) (RETURN (GETFILEPTR INSTREAM))) (NIL (RETURN 0)) NIL))) (SETFILEPTR INSTREAM AFTERCR) (SETQ END (DO (SELCHARQ (AND (\PEEKCCODE INSTREAM T) (\INCCODE.EOLC INSTREAM 'ANY)) (EOL (RETURN (GETFILEPTR INSTREAM))) (NIL (RETURN 0)) NIL))) (PRINTOUT OUTSTREAM .I6 FILEPOS ": ") (COPYCHARS INSTREAM OUTSTREAM START FILEPOS) (PRIN1 (CHARACTER 128) OUTSTREAM) (COPYCHARS INSTREAM OUTSTREAM FILEPOS END)))]) ) (DEFINEQ (PRESPLIT [LAMBDA (N SPREAD) (* ; "Edited 26-May-2023 11:07 by rmk") (TTEST) (CL:UNLESS N (SETQ N 7)) (CL:UNLESS SPREAD (SETQ SPREAD 4)) (LET ((TEXTOBJ (GTO))) [for I (POS _ (CL:IF (IGREATERP SPREAD 0) 0 90)) from 1 to 3 do (TEDIT.INSERT TEXTOBJ (CONCAT I) (add POS 4) '(FACE BOLD] [for I (POS _ 90) from (IDIFFERENCE N 3) to N do (TEDIT.INSERT TEXTOBJ (CONCAT I) (add POS -4) '(FACE BOLD] (SP TEXTOBJ) (SBT TEXTOBJ]) ) (DEFINEQ (ALLTL [LAMBDA (THISLINE N) (* ; "Edited 13-Mar-2023 15:12 by rmk") (* ; "Edited 10-Mar-2023 11:03 by rmk") (* ;; "This shows the whole THISLINE, no matter what the final slot eventually might be") (DECLARE (USEDFREE TEXTOBJ)) (CL:UNLESS THISLINE (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) (CL:UNLESS (FIXP N) (SETQ N MAX.SMALLP)) (for (CHARSLOT _ (FIRSTCHARSLOT THISLINE)) (LASTSLOT _ (LASTCHARSLOT THISLINE)) CHAR CHARW by (NEXTCHARSLOT CHARSLOT) as I from 0 to (SUB1 N) repeatuntil (EQ CHARSLOT LASTSLOT) do (SETQ CHAR (CHAR CHARSLOT)) (SETQ CHARW (CHARW CHARSLOT)) (PRINTOUT T .I3 I " " CHARSLOT) (if (SMALLP CHAR) then (PRINTOUT T .FR 20 CHAR " " (CHARACTER CHAR) " " CHARW T) elseif CHAR then (PRINTOUT T " " CHAR " " CHARW T) else (PRINTOUT T .FR 20 CHAR " " " " " " CHARW T]) (NTHCHARSLOT [LAMBDA (THISLINE SLOTN) (* ; "Edited 13-Mar-2023 15:12 by rmk") (* ; "Edited 8-Mar-2023 13:22 by rmk") (CL:UNLESS (TYPE? THISLINE THISLINE) (SETQ THISLINE (FETCH THISLINE of (GTO THISLINE)))) (find CHARSLOT incharslots THISLINE as I from 1 suchthat (EQ I SLOTN]) ) (* ; "THISLINE") (DEFINEQ (PLCHAIN [LAMBDA (LN TSTREAM) (* ; "Edited 25-Apr-2024 00:04 by rmk") (* ; "Edited 14-Sep-2022 16:07 by rmk") (* ; "Edited 29-May-91 18:20 by jds") (PRINTLINE LN TSTREAM) (COND ((fetch (LINEDESCRIPTOR NEXTLINE) of LN) (PLCHAIN (fetch (LINEDESCRIPTOR NEXTLINE) of LN) TSTREAM]) (PRINTLINE [LAMBDA (LN TSTREAM) (* ; "Edited 13-Dec-2024 17:07 by rmk") (* ; "Edited 17-Nov-2024 15:56 by rmk") (* ; "Edited 26-Oct-2024 11:20 by rmk") (* ; "Edited 24-Oct-2024 20:25 by rmk") (* ; "Edited 10-May-2024 00:26 by rmk") (* ; "Edited 25-Apr-2024 00:09 by rmk") (* ; "Edited 17-Mar-2024 17:18 by rmk") (* ; "Edited 2-Dec-2023 23:11 by rmk") (* ; "Edited 26-Mar-2023 11:46 by rmk") (* ; "Edited 29-Sep-2022 08:43 by rmk") (* ; "Edited 8-Sep-2022 23:41 by rmk") (* ; "Edited 29-May-91 18:20 by jds") (* ;  "Print out a line descriptor in a reasonable form.") (printout T "-----" T LN " Bot: " (GETLD LN YBOT) " Base: " (GETLD LN YBASE) " Height: " (GETLD LN LHEIGHT) " Ascent: " (GETLD LN LASCENT) " Descent: " (GETLD LN LDESCENT) T "Char1: " (GETLD LN LCHAR1) " Lim: " (GETLD LN LCHARLAST)) (COND ((GETLD LN FORCED-END) (PRIN1 " Forced-end" T))) (PRIN1 ". ") (printout T "RMar: " (GETLD LN RIGHTMARGIN) " XLim: " (GETLD LN LXLIM) T "Prev: " (GETLD LN PREVLINE) T "Next: " (GETLD LN NEXTLINE) T) (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) (COND ((AND (IGEQ (fetch (LINEDESCRIPTOR LCHAR1) of LN) 1) (ILEQ (GETLD LN LCHAR1) (GETTOBJ TEXTOBJ TEXTLEN))) (* ; "The line is real -- print it.") (PRIN1 "|" T) [bind CH first (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (GETLD LN LCHAR1))) for CHNO from (GETLD LN LCHAR1) to (IMIN (GETTOBJ TEXTOBJ TEXTLEN) (GETLD LN LCHARLAST)) do (SETQ CH (BIN TSTREAM)) (COND ((SMALLP CH) (PRIN1 (CHARACTER CH) T)) (T (PRINT CH T] (PRINTOUT T "|" T]) (SL.GETLINES [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ) (* ; "Edited 30-Nov-2024 17:00 by rmk") (* ; "Edited 28-Oct-2024 22:24 by rmk") (* ; "Edited 21-Oct-2024 23:10 by rmk") (* ; "Edited 9-Sep-2024 14:25 by rmk") (* ; "Edited 7-Sep-2024 21:44 by rmk") (* ; "Edited 1-Sep-2024 23:21 by rmk") (* ;; "A selection goes to its L1, NIL goes to the first line of PANE, T goes to the first line of TEXTOBJ's SEL.") (* ;; "If FIRSTLINE is already a line.") (* ;; "LASTLINE also coerces a selection to its LN, but it can be a number of lines.") (LET [TEXTOBJ SEL PANEPREFIX (PNO PANE) (NLINES (OR (FIXP LASTLINE) (CL:IF (type? LINEDESCRIPTOR FIRSTLINE) 1 100)] [SETQ TEXTOBJ (if (type? TEXTOBJ FIRSTLINE) then (PROG1 FIRSTLINE (SETQ FIRSTLINE NIL)) elseif (GTO TOBJ T) elseif (GTO FIRSTLINE T) then (PROG1 (GTO FIRSTLINE) (SETQ FIRSTLINE NIL] (SETQ PANE (if (WINDOWP PANE) elseif (AND (FIXP PANE) (find P inpanes TEXTOBJ as I from 1 suchthat (EQ I PANE))) else (SETQ PNO 1) (\TEDIT.PRIMARYPANE TEXTOBJ))) (CL:UNLESS (type? LINEDESCRIPTOR FIRSTLINE) (CL:WHEN (EQ FIRSTLINE 'SEL) (SETQ FIRSTLINE (TEXTSEL TEXTOBJ))) [SETQ FIRSTLINE (if (AND (type? SELECTION FIRSTLINE) (FGETSEL FIRSTLINE SET)) then (SETQ SEL FIRSTLINE) (* ; "For lastline") (\TEDIT.SEL.L1 SEL PANE TEXTOBJ) elseif (NULL FIRSTLINE) then (PANEPREFIX PANE) elseif (AND (EQ FIRSTLINE T) (FGETSEL (TEXTSEL TEXTOBJ) SET)) then (SETQ SEL (TEXTSEL TEXTOBJ)) (SETQ FIRSTLINE (\TEDIT.SEL.L1 SEL PANE TEXTOBJ]) (CL:WHEN FIRSTLINE (CL:UNLESS (type? LINEDESCRIPTOR LASTLINE) [SETQ LASTLINE (if SEL then (\TEDIT.SEL.LN SEL PANE TEXTOBJ) else (find L inlines FIRSTLINE as I from 1 suchthat (OR (NULL (FGETLD L NEXTLINE)) (EQ I NLINES])) (LIST FIRSTLINE LASTLINE TEXTOBJ PANE (OR PNO 1]) (CHECKLINES [LAMBDA (LINE1 LINEN MSG) (* ; "Edited 20-Nov-2024 23:44 by rmk") (* ; "Edited 17-Nov-2024 15:56 by rmk") (* ; "Edited 9-Nov-2024 10:30 by rmk") (* ; "Edited 11-Mar-2023 17:38 by rmk") (CL:WHEN LINE1 (CL:WHEN (EQ 0 (GETLD LINE1 LCHAR1)) (* ; "Dummy") (SETQ LINE1 (GETLD LINE1 NEXTLINE))) (for L NEXT inlines LINE1 while (SETQ NEXT (GETLD L NEXTLINE)) do (CL:UNLESS (IEQP (GETLD L LCHARLIM L) (GETLD NEXT LCHAR1)) (CL:WHEN MSG (PRINTOUT T "Line sequence error: " MSG T)) (HELP L NEXT)) (CL:WHEN (AND LINEN (EQ L LINEN)) (RETURN))))]) (COLLECTLINES [LAMBDA (LINE) (* ; "Edited 25-Mar-2023 15:27 by rmk") (for L inlines (CL:IF (LISTP LINE) (CAR LINE) LINE) collect L]) (NTHLINE [LAMBDA (LINE N) (* ; "Edited 28-Jun-2024 15:24 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Apr-2024 13:45 by rmk") (* ; "Edited 17-Mar-2024 17:19 by rmk") (* ; "Edited 21-Oct-2023 10:23 by rmk") (* ; "Edited 1-Apr-2023 21:15 by rmk") (LET (TOBJ) (if (TYPE? LINEDESCRIPTOR LINE) else (SETQ TOBJ (GTO LINE)) (SETQ LINE (GETLD (PANEPREFIX (\TEDIT.PRIMARYPANE TOBJ)) NEXTLINE))) (for I from 1 as L in (COLLECTLINES LINE) when (EQ I N) do (RETURN L]) (HEIGHT [LAMBDA (LINE) (* ; "Edited 17-Mar-2024 13:03 by rmk") (* ; "Edited 1-Apr-2023 12:47 by rmk") (for L inlines LINE SUM (GETLD L LHEIGHT]) (LINEBOTS [LAMBDA (LINE) (* ; "Edited 28-Jun-2024 15:24 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Apr-2024 13:48 by rmk") (* ; "Edited 21-Oct-2023 10:23 by rmk") (* ; "Edited 19-Apr-2023 20:50 by rmk") (* ; "Edited 1-Apr-2023 21:24 by rmk") (CL:UNLESS (type? LINEDESCRIPTOR LINE) [SETQ LINE (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO]) (for L inlines (CAR (MKLIST LINE)) collect (GETLD L YBOT]) ) (DEFINEQ (IPC.DECODEARGS [LAMBDA (PC TOBJ) (* ; "Edited 3-Dec-2024 09:37 by rmk") (* ; "Edited 26-Oct-2024 12:35 by rmk") (* ; "Edited 4-Oct-2024 13:32 by rmk") (* ;; "Finds the piece specified by decoding PC and TOBJ") (LET ((TEXTOBJ (GTO TOBJ T)) (ID (AND PC (LITATOM PC) PC)) N) (SETQ PC (if (type? PIECE PC) then (CL:WHEN TEXTOBJ [SETQ N (find I from 1 suchthat (EQ PC (NTHPIECE TEXTOBJ I]) PC elseif (FIXP PC) then (SETQ N PC) (SETQ PC (NTHPIECE TEXTOBJ PC)) elseif (MEMB PC '(SEL T)) then (SETQ PC (SELPIECE TEXTOBJ)) elseif (TEXTOBJ PC T) then (SETQ PC (NTHPIECE (TEXTOBJ PC) TOBJ)) elseif [AND ID TEXTOBJ (SETQ N (find I OBJ from 1 as TPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) suchthat (AND (SETQ OBJ (POBJ TPC)) (OR (EQ ID (IMAGEOBJPROP OBJ 'IDENTIFIER)) (EQ ID (IMAGEOBJPROP OBJ 'LABEL] then (SETQ PC (NTHPIECE TEXTOBJ N)) elseif (AND TEXTOBJ (NULL PC)) then (SELPIECE TEXTOBJ) else (ERROR "NOT A PIECE" PC))) [SETQ ID (AND (POBJ PC) (OR (IMAGEOBJPROP (POBJ PC) 'IDENTIFIER) (IMAGEOBJPROP (POBJ PC) 'LABEL] (LIST PC (CL:IF ID (CONCAT N "-" ID) N)]) ) (DEFINEQ (SPF1 [LAMBDA (PAGEREGION) (* ; "Edited 30-Aug-2024 15:24 by rmk") (* ; "Edited 6-Nov-2023 22:39 by rmk") `(,(fetch REGIONFILLMETHOD OF PAGEREGION) (LOCALINFO ,(fetch REGIONLOCALINFO of PAGEREGION)) (TYPE ,(fetch (PAGEREGION REGIONTYPE) of PAGEREGION)) ,(fetch REGIONSPEC of PAGEREGION) ,@(for PAGEREGION inside (fetch REGIONSUBBOXES of PAGEREGION) collect (SPF1 PAGEREGION]) ) (* ; "Page frames") (DEFINEQ (SLF.FATPLEN [LAMBDA (LOOKSFILE PFPOS BYTELEN) (* ; "Edited 28-Aug-2023 22:03 by rmk") (* ;; "Calculates the eventual PLEN given that there is an XCCS fat charlooks piece of BYTELEN bytes starting at PFPOS") (LET ((ORIGPTR (GETFILEPTR LOOKSFILE))) (SETFILEPTR LOOKSFILE PFPOS) (PROG1 (if (EQ NSCHARSETSHIFT (BIN LOOKSFILE)) then (SELECTC (BIN LOOKSFILE) (0 (ADD BYTELEN -2)) (NSCHARSETSHIFT (BIN LOOKSFILE) (FOLDLO (IDIFFERENCE BYTELEN 3) 2)) (ADD BYTELEN -2)) else (FOLDLO BYTELEN 2)) (SETFILEPTR LOOKSFILE ORIGPTR]) (FILEPIECE [LAMBDA (FILEPOS FILE) (* ; "Edited 24-Nov-2024 23:17 by rmk") (* ;; "Interprets the bytes in the looks file that represent a character piece at the FILEPOS value shown by SLF") (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) (SETFILEPTR STREAM FILEPOS) (LET* [(BYTELEN (\DWIN STREAM)) (BYTELENBYTES (LIST (LRSH BYTELEN 24) (LOGAND 255 (LRSH BYTELEN 16)) (LOGAND 255 (LRSH BYTELEN 8)) (LOGAND 255 BYTELEN))) (TYPE (\WIN STREAM)) (PTYPEBYTES (LIST (LRSH PTYPE 8) (LOGAND PTYPE BYTELEN))) (FLAG (BIN STREAM)) (CLOOKSINDEX (\WIN STREAM)) (CLOOKSBYTES (LIST (LRSH CLOOKSINDEX 8) (LOGAND 255 CLOOKSINDEX] (SELECTC TYPE (\PieceDescriptorLOOKS `((FILEPOS ,FILEPOS) (BYTELEN ,BYTELEN) (BYTELENBYTES ,BYTELENBYTES) (TYPE ,TYPE) (FLAG ,FLAG) (CLOOKSINDEX ,CLOOKSINDEX) (CLOOKSBYTES ,CLOOKSBYTES))) (\PieceDescriptorOBJECT) (HELP "Piece type?"]) ) (* ; "Show looks file") (DEFINEQ (SELTEDIT [LAMBDA (SRC START LEN) (* ; "Edited 2-Dec-2024 09:01 by rmk") (* ; "Edited 15-May-2024 15:40 by rmk") (* ;; "This brings up a Tedit that contains the contents of a selection in the SRC Tedit, to help in focusing on a specific problem.") (SETQ SRC (GTS SRC)) (LET [(TARG (TEXTSTREAM (TEDIT NIL 'SELTEDIT NIL `(LEAVETTY T] (CL:UNLESS START (SETQ START (TEDIT.SELPROP SRC 'CH#)) (CL:UNLESS LEN (SETQ LEN (TEDIT.SELPROP SRC 'LENGTH)))) (TEDIT.SETSEL SRC START LEN) (TEDIT.COPY SRC TARG) (TEXTPROP TARG 'DIRTY NIL) TARG]) ) (* ; "New editor on an old selection") (* ; "Bravo") (DEFINEQ (PPARA [LAMBDA (PARA BSTR) (* ; "Edited 8-Aug-2023 17:00 by rmk") (CL:UNLESS BSTR (SETQ BSTR BSTREAM)) (RESETLST [RESETSAVE (GETFILEPTR BSTR) `(PROGN (SETFILEPTR ,BSTR OLDVALUE] (PRINTOUT T "FILEPOS = " (GETFILEPTR BSTR) T) (for R in (fetch (PARA RUNS) of PARA) do (PRUN R BSTR)))]) (PRUN [LAMBDA (RUN BSTR) (* ; "Edited 2-Jan-2025 10:28 by rmk") (* ; "Edited 22-Aug-2023 10:59 by rmk") (* ; "Edited 8-Aug-2023 16:47 by rmk") (* ;; "Shows the characters in RUN, with font information") (CL:UNLESS BSTR (SETQ BSTR BSTREAM)) (RESETLST [RESETSAVE (GETFILEPTR BSTR) `(PROGN (SETFILEPTR ,BSTR OLDVALUE] (PRINTOUT T .I5 (fetch (RUN RUNSTART) of RUN) "/" (fetch (RUN RUNLENGTH) of RUN) ": " 11) (SETFILEPTR BSTR (fetch (RUN RUNSTART) of RUN)) (for I from 1 to (fetch (RUN RUNLENGTH) of RUN) do (SBC (BIN BSTR) BSTR T)) (LET (FONT (CL (fetch (RUN RUNLOOKS) of RUN))) (SETQ FONT (fetch (CHARLOOKS CLFONT) of CL)) (TAB 13 NIL T) (PRINTOUT T (FONTPROP FONT 'FAMILY) (FONTPROP FONT 'SIZE) (CL:IF [EQ 'BOLD (CAR (FONTPROP FONT 'FACE] 'B "") (CL:IF [EQ 'ITALIC (CADR (FONTPROP FONT 'FACE] 'I "") T)) RUN)]) (ADDLINEPOSITIONS [LAMBDA (FILE) (* ; "Edited 22-Aug-2023 11:06 by rmk") (* ; "Edited 13-Aug-2023 19:07 by rmk") (* ; "Edited 11-Aug-2023 08:30 by rmk") (* ; "Edited 8-Aug-2023 22:17 by rmk") (* ;; "Makes a copy of FILE except that each each CR is followed by the fileptr of the next byte, and and ^z and \ are also marked with the file position of the nexxt character. This helps in decoding Bravo files.") (CL:WITH-OPEN-FILE (INSTREAM FILE :DIRECTION :INPUT) (STREAMPROP INSTREAM 'ENDOFSTREAMOP (FUNCTION NILL)) (CL:WITH-OPEN-FILE (OUTSTREAM (PACKFILENAME 'EXTENSION 'POS 'VERSION NIL 'BODY (FULLNAME INSTREAM)) :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) (LINELENGTH MAX.SMALLP OUTSTREAM) (bind B first (PRINTOUT OUTSTREAM .I6 0 ": ") while (SETQ B (BIN INSTREAM)) do (* ;; "Line endings are marked, then executed. Tabs are replaced") (SBC B INSTREAM OUTSTREAM T)) (FULLNAME OUTSTREAM]) (SBR [LAMBDA (RUN) (* ; "Edited 22-Aug-2023 11:07 by rmk") (* ;; "Show Bravo run") (LET ((ORIGPTR (GETFILEPTR BSTREAM))) (SETFILEPTR BSTREAM (fetch (RUN RUNSTART) of RUN)) (printout T (fetch (RUN RUNSTART) of RUN) "/" (fetch (RUN RUNLENGTH) of RUN) ": ") (for I from 1 to (fetch (RUN RUNLENGTH) of RUN) do (SBC (BIN BSTREAM) BSTREAM T)) (SETFILEPTR BSTREAM ORIGPTR) RUN]) (SBC [LAMBDA (BYTE INSTREAM OUTSTREAM SPACELINES) (* ; "Edited 22-Aug-2023 12:12 by rmk") (* ;; "Show Bravo char-byte") (SELCHARQ BYTE (CR (PRINTOUT OUTSTREAM "[CR]") (if SPACELINES then (PRINTOUT OUTSTREAM T T .I6 (GETFILEPTR INSTREAM) ": ") else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) "]"))) (LF (PRINTOUT OUTSTREAM "[LF]") (if SPACELINES then (PRINTOUT OUTSTREAM T T .I6 (GETFILEPTR INSTREAM) ": ") else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) "]"))) (FORM (PRINTOUT OUTSTREAM "[FORM]") (if SPACELINES then (PRINTOUT OUTSTREAM T T .I6 (GETFILEPTR INSTREAM) ": ") else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) "]"))) (TAB (PRINTOUT OUTSTREAM "[TAB]")) (^Z (BOUT OUTSTREAM (CHARCODE ^Z)) (* ; "Comes out black") (if SPACELINES then (PRINTOUT OUTSTREAM T .I6 (GETFILEPTR INSTREAM) ": " -5) else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) "]"))) (\ (PRINTOUT OUTSTREAM (CHARACTER (CHARCODE \)) "[" (GETFILEPTR INSTREAM) "]")) (BOUT OUTSTREAM BYTE]) ) (RPAQ? LASTTS NIL) (RPAQQ OK.TO.MODIFY.FNS T) (DEFINEQ (OLDWI [LAMBDA (FN) (* ; "Edited 16-May-2023 12:02 by rmk") (for F COMS in TEDITFILES when (AND (SETQ F (DFOV.OLDEST F)) (INFILECOMS? FN NIL (GETDEF (FILECOMS F) 'VARS F))) collect F]) (COMP [LAMBDA (FN) (* ; "Edited 5-Feb-2023 20:14 by rmk") (COMPAREDEFS FN 'FNS (LIST 'SAVE (CAR (REMOVE 'SAVE (WHEREIS FN 'FNS T]) (DFR [NLAMBDA (FN FILE) (* ; "Edited 12-Mar-2023 13:18 by rmk") (* ; "Edited 10-Sep-2022 16:15 by rmk") (* ; "Edited 6-Sep-2022 23:35 by rmk") (* ; "Edited 4-Sep-2022 20:57 by rmk") (* ; "Edited 9-Aug-2022 22:37 by rmk") (* ; "Edited 8-Aug-2022 16:17 by rmk") (* ; "Edited 7-Aug-2022 00:08 by rmk") (* ;; "Gets the definition from the release") (CL:UNLESS FILE (SETQ FILE (CAR (WHEREIS FN 'FNS T)))) (CL:UNLESS FILE (ERROR FN " not found")) (SETQ FILE (FINDFILE FILE T)) (CL:UNLESS FILE (ERROR FN " not found")) (LET [FILEPKGFLG (FNR (PACK* FN '-R] (COPYDEF FN FNR 'FNS (PACKFILENAME 'HOST '{RMEDLEY} 'VERSION NIL 'BODY FILE)) (EDITDEF.FNS FNR NIL '(:DONTWAIT]) ) (DEFINEQ (DFGV [NLAMBDA ARGS (* ; "Edited 15-Dec-2023 12:26 by rmk") (* ; "Edited 13-Aug-2023 14:09 by rmk") (* ;; "Brings in a function from an earlier version on {MEDLEY}, for comparison. FILE can be a version number, it uses WHEREIS") (APPLY (FUNCTION DFOV) (LIST (POP ARGS) (POP ARGS) (POP ARGS) (GDIRECTORIES]) (GDIRECTORIES [LAMBDA NIL (* ; "Edited 15-Dec-2023 12:19 by rmk") (for D in DIRECTORIES when (EQ 'WMEDLEY (FILENAMEFIELD D 'HOST)) collect (PACKFILENAME 'HOST '{MEDLEY} 'BODY D]) ) (DEFINEQ (TTEST [LAMBDA (FILE REGION OPENONLY AFTERFORMS DONTQUIT READONLY)(* ; "Edited 27-Sep-2024 11:18 by rmk") (* ; "Edited 5-May-2024 21:55 by rmk") (* ; "Edited 29-Nov-2023 10:50 by rmk") (* ; "Edited 23-Nov-2023 14:28 by rmk") (* ; "Edited 22-Oct-2023 00:07 by rmk") (* ; "Edited 9-Sep-2023 17:21 by rmk") (* ; "Edited 8-Sep-2023 00:16 by rmk") (* ; "Edited 19-Aug-2023 10:57 by rmk") (* ; "Edited 17-Jul-2023 18:01 by rmk") (* ; "Edited 15-Jul-2023 21:05 by rmk") (* ;; "FILE NIL gets the last file.") (* ;; "Region NIL defaults to last region, T always gets a new one. If we are reusing the region, we also close the previous file and kill its process.") (* ;; "OPENONLY creates the text stream, doesn't create the window or process") [if (NULL REGION) then [SETQ REGION (REGIONP (EVALV 'LASTTEXTSTREAMREGION] elseif (AND (LITATOM REGION) (REGIONP (EVALV REGION))) then (SETQ REGION (COPY (EVALV REGION] (IF FILE THEN [LET ((SUBDIR (LISTGET (UNPACKFILENAME.STRING FILE) 'SUBDIRECTORY)) (TESTDIR '{TTESTS})) (CL:WHEN SUBDIR (SETQ TESTDIR (CONCAT TESTDIR "/" SUBDIR)) (SETQ FILE (ROOTFILENAME FILE))) (CL:UNLESS (STRINGP FILE) (SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE (CONS (PSEUDOFILENAME (DIRECTORYNAME T)) (CONS TESTDIR DIRECTORIES)) '(TEDIT TXT NIL)) (ERROR "FILE NOT FOUND" FILE))))] (SETQ LASTTESTFILE FILE) elseif (AND (BOUNDP 'LASTTESTFILE) LASTTESTFILE) then (SETQ FILE (OR (STRINGP LASTTESTFILE) (PACKFILENAME 'VERSION NIL 'BODY LASTTESTFILE))) else (ERROR "NO FILE SPECIFIED")) (CL:WHEN (STRINGP FILE) (SETQ FILE (OPENSTRINGSTREAM FILE))) (LET (TEXTSTREAM TEXTOBJ) (DECLARE (SPECVARS TEXTSTREAM TEXTOBJ)) (CL:WHEN (AND (BOUNDP 'LASTTESTSTREAM) (TEXTSTREAMP LASTTESTSTREAM)) (CL:UNLESS DONTQUIT (SETTOBJ (TEXTOBJ LASTTESTSTREAM) \DIRTY NIL) (TEDIT.QUIT LASTTESTSTREAM))) [SETQ TEXTSTREAM (if OPENONLY then [OPENTEXTSTREAM FILE NIL NIL NIL (CL:WHEN READONLY '(READONLY T))] else (if (REGIONP REGION) then (SETQ REGION (COPY REGION)) elseif REGION else (SETQ REGION 'TTEST)) (TEXTSTREAM (TEDIT FILE (COPY REGION) NIL `(LEAVETTY T ,@(CL:WHEN READONLY `(READONLY T))] (SETQ LASTTESTSTREAM TEXTSTREAM) (SETQ LASTTEXTSTREAMREGION (REGIONP REGION)) (SETQ TEXTOBJ (TEXTOBJ TEXTSTREAM)) (CL:WHEN AFTERFORMS (if (NLISTP AFTERFORMS) then (APPLY* AFTERFORMS) elseif (NLISTP (CAR (LISTP AFTERFORMS))) then (EVAL AFTERFORMS) elseif (LISTP (CAR AFTERFORMS)) then (EVAL (CONS (FUNCTION PROGN) AFTERFORMS)))) (SETQ LASTTEXTSTREAM TEXTSTREAM) (* ; "for GTS") TEXTSTREAM]) (LTEST [LAMBDA (FILE SCROLL) (* ; "Edited 28-Jun-2024 15:25 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Apr-2024 13:50 by rmk") (* ; "Edited 17-Mar-2024 13:04 by rmk") (* ; "Edited 21-Oct-2023 10:24 by rmk") (* ; "Edited 17-May-2023 09:48 by rmk") (* ; "Edited 13-May-2023 21:34 by rmk") (* ;; "Line reformatting with inserts and deletes") (LET (LPC) (CL:WHEN (NUMBERP FILE) (SETQ SCROLL FILE) (SETQ FILE NIL)) (TTEST FILE) (CL:WHEN SCROLL (SCROLLW (WFROMDS (TEXTSTREAM (GTO))) 0 SCROLL)) (SETQ LPC (\TEDIT.CHTOPC (GETLD (GETLD (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO))) NEXTLINE) LCHAR1) (GTO))) (SP LPC) (SPLINES]) (THC [LAMBDA (TSTREAM PRINTER TYPE) (* ; "Edited 10-Jul-2023 23:00 by rmk") (CL:UNLESS TYPE (SETQ TYPE DEFAULTPRINTERTYPE)) (LET ((TFILE (TXTFILE (GTO TSTREAM))) HCFILE) (CL:UNLESS PRINTER (SETQ HCFILE (OUTFILEP (PACKFILENAME 'EXTENSION TYPE 'VERSION NIL 'NAME (PACK* (FILENAMEFIELD TFILE 'NAME) 'W) 'BODY TFILE)))) (HARDCOPY.SOMEHOW (WFROMDS (TEXTSTREAM (GTO TSTREAM))) HCFILE TYPE) HCFILE]) ) (RPAQ? LASTTTESTFILE ) (RPAQQ TTESTREGIONS (RBRAVO RHUGE RMID RSMALL RBIG RHIGH)) (RPAQQ RBRAVO (1321 246 561 554)) (RPAQQ RHUGE (865 26 811 957)) (RPAQQ RMID (753 774 531 169)) (RPAQQ RSMALL (858 796 462 81)) (RPAQQ RBIG (900 400 600 358)) (RPAQQ RHIGH (877 880 462 103)) (DEFINEQ (SHOWSAFE [LAMBDA (PIECE TAG HELP FILE TEXTOBJ) (* ; "Edited 21-Oct-2023 10:50 by rmk") (* ; "Edited 4-Sep-2023 23:31 by rmk") (CL:UNLESS FILE (SETQ FILE TTY)) (CL:WHEN (OR (EQ SAFESHOW T) (EQMEMB TAG SAFESHOW)) (CL:WHEN TAG (PRINTOUT FILE TAG " ")) (PRINTOUT FILE (PFPOS PIECE) " Left = " BYTESLEFT " Inbuffer = " BYTESLEFTINBUFFER " Prefix = " PREFIXBYTES T) (SPPRINT PIECE FILE (GTO TEXTOBJ))) (CL:WHEN (OR HELP (EQ SAFEHELP T) (EQMEMB TAG SAFEHELP)) (HELP PIECE TAG]) ) (RPAQ? SAFESHOW NIL) (RPAQ? SAFEHELP NIL) (DEFINEQ (MYH [LAMBDA (MESS1 MESS2 SKIP N) (* ; "Edited 30-Nov-2024 14:18 by rmk") (* ; "Edited 31-Jul-2024 21:41 by rmk") (* ;; "Call HELP after waiting for the mouse to get to a safe place and the buttons to come up.") (CL:UNLESS SKIP (DISMISS (OR N 1000) NIL T) (HELP MESS1 MESS2))]) ) (RPAQQ VTDIR {DSK}kaplan>local>medley3.5>pregit-medley>venuelispcore>library>.) (RPAQQ VTF {DSK}kaplan>local>medley3.5>pregit-medley>venuelispcore>library>TFBRAVO.) (RPAQQ TF {WMEDLEY}TEDIT>TEDIT-TFBRAVO.) (DEFINEQ (DFVENUE [NLAMBDA (FN FILE) (* ; "Edited 2-Aug-2023 12:30 by rmk") (* ; "Edited 31-Jul-2023 20:42 by rmk") (* ;; "Edit from pregit Venue files, default to TFBRAVO.") (CL:UNLESS FILE (SETQ FILE 'TFBRAVO)) (SETQ FILE (PACKFILENAME 'NAME FILE 'BODY VTDIR)) (LET (VNAME DEF) (CL:UNLESS FILE (SETQ FILE)) (SETQ DEF (GETDEF FN NIL FILE 'NOERROR)) (if DEF then (SETQ VNAME (PACK* FN "-" "Venue")) (PRINTOUT T "Editing " FN " from " FILE T) (PUTDEF VNAME 'FNS DEF) (ADDTOFILE VNAME 'FNS NIL) (EDITDEF VNAME 'FNS NIL NIL '(:DONTWAIT)) else (PRINTOUT T FN " not found on " FILE) NIL]) (VSEE [NLAMBDA FILE (* ; "Edited 2-Aug-2023 12:08 by rmk") (PFI.MAYBE.SEE.PRETTY (PACKFILENAME 'DIRECTORY VTDIR 'BODY FILE) T]) ) (DEFINEQ (PTT [LAMBDA (FILE NOTREADONLY) (* ; "Edited 30-Nov-2023 10:40 by rmk") (* ; "Edited 12-Aug-2023 23:27 by rmk") (* ; "Edited 11-Aug-2023 08:40 by rmk") (* ;; "Plaintext readonly") (TEDIT FILE NIL NIL `(UNFORMATTED T READONLY ,(NOT NOTREADONLY]) ) (* ; "Plain text") (DECLARE%: EVAL@COMPILE (PUTPROPS DEBUGOUTPUT MACRO [(FILE . FORMS) (RESETLST [LET ((OFILE FILE)) [RESETSAVE (DSPFONT NIL OFILE) '(PROGN (DSPFONT OLDVALUE OFILE] . FORMS])]) ) (DEFINEQ (DEBUGOUTPUT.STREAM [LAMBDA (OFILE WTYPE TITLE WIDTH FONT) (* ; "Edited 25-Apr-2025 09:11 by rmk") (* ; "Edited 15-Apr-2025 13:55 by rmk") (* ; "Edited 11-Apr-2025 12:13 by rmk") (* ;; "Passed as the first argument in a call to DEBUGOUTPUT") (CL:UNLESS FONT (SETQ FONT DEFAULTFONT)) [if WTYPE then [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE) NIL NIL `(FONT ,FONT PARALOOKS (RIGHTMARGIN ,(AND WIDTH (ITIMES WIDTH (CHARWIDTH (CHARCODE SPACE) FONT] (CL:WHEN WIDTH (LINELENGTH WIDTH OFILE)) (CL:UNLESS TITLE (SETQ TITLE WTYPE)) [RESETSAVE NIL `(PROGN (CL:UNLESS RESETSTATE [TEDIT ,OFILE ',WTYPE NIL '(READONLY QUIET LEAVETTY T TITLE ,TITLE] (WINDOWPROP (WFROMDS ,OFILE) 'TEDIT-DEBUG T))] elseif OFILE then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW)) '(PROGN (CLOSEF? OLDVALUE] OFILE]) ) (DEFINEQ (TEDIT-DEBUG [LAMBDA (DONTOVERLOAD) (* ; "Edited 9-Aug-2024 13:20 by rmk") (* ; "Edited 16-Jul-2024 12:37 by rmk") (* ; "Edited 6-Jul-2024 21:16 by rmk") (* ; "Edited 10-Jun-2024 14:21 by rmk") (* ; "Edited 19-May-2024 21:32 by rmk") (* ; "Edited 6-May-2024 22:13 by rmk") (* ; "Edited 22-Apr-2024 23:42 by rmk") (* ; "Edited 4-Apr-2024 12:13 by rmk") (* ; "Edited 17-Mar-2024 19:46 by rmk") (* ; "Edited 15-Mar-2024 15:28 by rmk") (* ; "Edited 3-Dec-2023 21:00 by rmk") (* ; "Edited 29-Nov-2023 10:49 by rmk") (* ; "Edited 24-Nov-2023 12:53 by rmk") (CL:WHEN (DIRECTORYNAMEP (MEDLEYDIR "../oldtedit/")) (PSEUDOHOST 'OT (MEDLEYDIR "../oldtedit/"))) (FILESLOAD (NOERROR FROM LOADUPS) FULLER.DATABASE) (CL:IF DONTOVERLOAD (LOAD 'TEDIT-EXPORTS.ALL) (EDIT-TEDIT)) (FILESLOAD (NOERROR FROM {WMEDLEY}/library/tedit/) TEDIT-STRESS TEDIT-RENAMES) (CL:UNLESS DONTOVERLOAD (%. ANALYZE ON (TEDIT-STRESS TEDIT-DEBUG))) [SETQ TFILES `(TEDIT-DEBUG TEDIT-STRESS ,@TEDITFILES] (CNDIR (PSEUDOFILENAME (MEDLEYDIR "library/tedit"))) [GIT-PUT-PROJECT-FIELD 'MEDLEY 'EXCLUSIONS `("tedit-tests/" ,@(GIT-GET-PROJECT 'MEDLEY 'EXCLUSIONS] (FILESLOAD (NOERROR) {OT}OTWHEREIS) (PRINTOUT T T "Connected to " (PSEUDOFILENAME (MEDLEYDIR "library/tedit")) T]) ) (DEFINEQ (HEXTOHILO [LAMBDA (NUM) (* ; "Edited 4-May-2025 21:52 by rmk") (* ;; "Shows NUM as a standard Medley address") (CL:UNLESS (FIXP NUM) (SETQ NUM (HEXNUM? NUM))) (CONCAT (OCTALSTRING (LRSH NUM 16)) "," (OCTALSTRING (LOGAND NUM 65535]) (CW [LAMBDA NIL (* ; "Edited 5-May-2025 00:04 by rmk") (CLOSEW (WHICHW]) ) (DEFINEQ (TRENAME [LAMBDA (FNS FILES) (* ; "Edited 16-Mar-2024 09:22 by rmk") (CL:UNLESS FILES (SETQ FILES TEDITFILES)) (LET [(MAP (FOR F TRANS INSIDE FNS WHEN (SETQ TRANS (if (EQ (CHARCODE \) (NTHCHARCODE F 1)) then (CL:UNLESS (STRPOS "TEDIT." F 2 NIL T) (PACK* "\TEDIT." (SUBSTRING F 2))) elseif (STRPOS "TEDIT" F NIL NIL T) then (PACK* "\" F) else (PACK* "\TEDIT." F))) COLLECT (CONS F TRANS] (for M in MAP do (COPYDEF (CAR M) (CDR M))) (for M WH FS in MAP DO [SETQ WH (CAR (WHEREIS (CAR M) 'FNS] (SETQ FS (%. WHO ON IN FILES CALLS (CAR M))) (CL:WHEN WH (pushnew FS WH)) (DSUBLIS MAP (GETD (CDR M))) (MARKASCHANGED (CDR M) 'FNS) (%. ERASE IN (CAR M)) (CL:WHEN WH (DSUBST (CDR M) (CAR M) (FILECOMS WH)) (MARKASCHANGED (FILECOMS WH) 'VARS)) (%. ANALYZE ON IN FS)) MAP]) ) (FILESLOAD (NOERROR) VERSIONDEFS) (* ; "Until this is release") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA VSEE DFGV) (ADDTOVAR NLAML DFVENUE DFR) (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (5124 7683 (GTO 5134 . 5384) (GTS 5386 . 7157) (GTW 7159 . 7315) (GSEL 7317 . 7681)) ( 7716 8837 (TEST.TEMPLATE 7726 . 8835)) (8838 9773 (TESTACTION 8848 . 9771)) (9798 23613 (IPC 9808 . 11312) (ILINES 11314 . 13855) (ISEL 13857 . 14468) (ITS 14470 . 16194) (IPANES 16196 . 16431) (ITL 16433 . 16852) (IHIST 16854 . 19516) (IPCTB 19518 . 19944) (IMB 19946 . 20705) (ICL 20707 . 21408) ( IPL 21410 . 21950) (ICARET 21952 . 22479) (INSPECTPIECES 22481 . 23611)) (23635 52303 (SP 23645 . 28689) (SL 28691 . 32526) (SSP 32528 . 34230) (SPF 34232 . 36762) (SLF 36764 . 45897) (SHOWLINE 45899 . 49461) (SLL 49463 . 50210) (STBYTES 50212 . 51938) (SSEL 51940 . 52301)) (52304 64970 (STL 52314 . 61315) (CLEARTHISLINE 61317 . 61797) (CHARSLOTP 61799 . 63118) (\TLVALIDATE 63120 . 64968)) (64971 70344 (NTHPIECE 64981 . 66113) (NPIECES 66115 . 66980) (NTHPIECECHAR 66982 . 68290) (SELPIECE 68292 . 68734) (PIECENUM 68736 . 69455) (PCBYTES 69457 . 70342)) (70345 72819 (FILEBYTES 70355 . 71779) ( TFILEBYTES 71781 . 72817)) (72820 74142 (TRELMOVE 72830 . 73073) (TSCROLL 73075 . 73241) (TSCROLL* 73243 . 74140)) (74143 77192 (TRY 74153 . 75422) (TEDITCLOSEW 75424 . 75767) (PARALASTWITHOUTEOL 75769 . 76654) (FIXPARALAST 76656 . 77190)) (77193 91941 (SPPRINT 77203 . 83889) (SPPRINT.CHAR 83891 . 84875) (SPPRINT.OBJ 84877 . 87935) (SHOWPIECEBYTES 87937 . 89493) (CHECKPLENGTHS 89495 . 89952) (SBT 89954 . 91091) (COPYPCHAIN 91093 . 91939)) (91942 94003 (POSLINE 91952 . 94001)) (94004 94887 ( PRESPLIT 94014 . 94885)) (94888 96601 (ALLTL 94898 . 96151) (NTHCHARSLOT 96153 . 96599)) (96627 106840 (PLCHAIN 96637 . 97165) (PRINTLINE 97167 . 100157) (SL.GETLINES 100159 . 103452) (CHECKLINES 103454 . 104434) (COLLECTLINES 104436 . 104688) (NTHLINE 104690 . 105695) (HEIGHT 105697 . 105985) (LINEBOTS 105987 . 106838)) (106841 109289 (IPC.DECODEARGS 106851 . 109287)) (109290 109883 (SPF1 109300 . 109881)) (109912 112290 (SLF.FATPLEN 109922 . 110781) (FILEPIECE 110783 . 112288)) (112323 113091 ( SELTEDIT 112333 . 113089)) (113161 118773 (PPARA 113171 . 113593) (PRUN 113595 . 115071) ( ADDLINEPOSITIONS 115073 . 116500) (SBR 116502 . 117156) (SBC 117158 . 118771)) (118830 120606 (OLDWI 118840 . 119215) (COMP 119217 . 119412) (DFR 119414 . 120604)) (120607 121640 (DFGV 120617 . 121143) ( GDIRECTORIES 121145 . 121638)) (121641 128206 (TTEST 121651 . 126183) (LTEST 126185 . 127550) (THC 127552 . 128204)) (128520 129212 (SHOWSAFE 128530 . 129210)) (129265 129712 (MYH 129275 . 129710)) ( 129957 131052 (DFVENUE 129967 . 130846) (VSEE 130848 . 131050)) (131053 131507 (PTT 131063 . 131505)) (131866 133447 (DEBUGOUTPUT.STREAM 131876 . 133445)) (133448 135764 (TEDIT-DEBUG 133458 . 135762)) ( 135765 136257 (HEXTOHILO 135775 . 136115) (CW 136117 . 136255)) (136258 137994 (TRENAME 136268 . 137992))))) STOP