From f721045f7cfa8646acdb1274940740c928a3d999 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 14 Jul 2022 18:46:04 -0700 Subject: [PATCH 1/4] TEDIT files: deleted from library/, renamed to library>tedit.TEDIT-xxx --- library/TEDITABBREV.LCOM | Bin 3994 -> 0 bytes library/TEDITCHAT | 439 -- library/TEDITCHAT.LCOM | Bin 9714 -> 0 bytes library/TEDITFILE | 3702 ----------------- library/TEDITSCREEN | 3007 ------------- library/TEDITSELECTION | 2277 ---------- library/TFBRAVO.LCOM | Bin 21952 -> 0 bytes library/{ => tedit}/TEDIT | 64 +- library/{TEDITABBREV => tedit/TEDIT-ABBREV} | 80 +- library/tedit/TEDIT-ABBREV.LCOM | Bin 0 -> 3842 bytes library/tedit/TEDIT-CHAT | 359 ++ library/tedit/TEDIT-CHAT.LCOM | Bin 0 -> 8296 bytes library/{TEDITCOMMAND => tedit/TEDIT-COMMAND} | 660 ++- .../TEDIT-COMMAND.LCOM} | Bin 16622 -> 16461 bytes library/{TEDITDCL => tedit/TEDIT-DCL} | 1057 +++-- .../{TEDITDCL.LCOM => tedit/TEDIT-DCL.LCOM} | 41 +- library/tedit/TEDIT-FILE | 3505 ++++++++++++++++ .../{TEDITFILE.LCOM => tedit/TEDIT-FILE.LCOM} | Bin 61417 -> 61226 bytes library/{TEDITFIND => tedit/TEDIT-FIND} | 457 +- .../{TEDITFIND.LCOM => tedit/TEDIT-FIND.LCOM} | Bin 10023 -> 9927 bytes library/{TEDITFNKEYS => tedit/TEDIT-FNKEYS} | 304 +- .../TEDIT-FNKEYS.LCOM} | Bin 15015 -> 14902 bytes library/{TEDITHCPY => tedit/TEDIT-HCPY} | 1273 +++--- .../{TEDITHCPY.LCOM => tedit/TEDIT-HCPY.LCOM} | Bin 23024 -> 22906 bytes library/{TEDITHISTORY => tedit/TEDIT-HISTORY} | 359 +- .../TEDIT-HISTORY.LCOM} | Bin 11114 -> 10994 bytes library/{TEDITLOOKS => tedit/TEDIT-LOOKS} | 1912 ++++----- .../TEDIT-LOOKS.LCOM} | Bin 46219 -> 46107 bytes library/{TEDITMENU => tedit/TEDIT-MENU} | 2204 +++++----- .../{TEDITMENU.LCOM => tedit/TEDIT-MENU.LCOM} | Bin 94826 -> 94683 bytes library/{TEDITPAGE => tedit/TEDIT-PAGE} | 1197 +++--- .../{TEDITPAGE.LCOM => tedit/TEDIT-PAGE.LCOM} | Bin 28813 -> 28658 bytes library/{PCTREE => tedit/TEDIT-PCTREE} | 269 +- .../{PCTREE.LCOM => tedit/TEDIT-PCTREE.LCOM} | Bin 9087 -> 9227 bytes library/tedit/TEDIT-SCREEN | 2778 +++++++++++++ .../TEDIT-SCREEN.LCOM} | Bin 34814 -> 34695 bytes library/tedit/TEDIT-SELECTION | 2132 ++++++++++ .../TEDIT-SELECTION.LCOM} | Bin 35998 -> 35900 bytes library/{TEXTOFD => tedit/TEDIT-TEXTOFD} | 1433 +++---- .../TEDIT-TEXTOFD.LCOM} | Bin 39391 -> 39574 bytes library/{TFBRAVO => tedit/TEDIT-TFBRAVO} | 1015 +++-- library/tedit/TEDIT-TFBRAVO.LCOM | Bin 0 -> 25307 bytes library/{TEDITWINDOW => tedit/TEDIT-WINDOW} | 1582 ++++--- .../TEDIT-WINDOW.LCOM} | Bin 56680 -> 56543 bytes library/{ => tedit}/TEDIT.LCOM | Bin 39244 -> 39334 bytes 45 files changed, 15226 insertions(+), 16880 deletions(-) delete mode 100644 library/TEDITABBREV.LCOM delete mode 100644 library/TEDITCHAT delete mode 100644 library/TEDITCHAT.LCOM delete mode 100644 library/TEDITFILE delete mode 100644 library/TEDITSCREEN delete mode 100644 library/TEDITSELECTION delete mode 100644 library/TFBRAVO.LCOM rename library/{ => tedit}/TEDIT (98%) rename library/{TEDITABBREV => tedit/TEDIT-ABBREV} (72%) create mode 100644 library/tedit/TEDIT-ABBREV.LCOM create mode 100644 library/tedit/TEDIT-CHAT create mode 100644 library/tedit/TEDIT-CHAT.LCOM rename library/{TEDITCOMMAND => tedit/TEDIT-COMMAND} (52%) rename library/{TEDITCOMMAND.LCOM => tedit/TEDIT-COMMAND.LCOM} (53%) rename library/{TEDITDCL => tedit/TEDIT-DCL} (51%) rename library/{TEDITDCL.LCOM => tedit/TEDIT-DCL.LCOM} (96%) create mode 100644 library/tedit/TEDIT-FILE rename library/{TEDITFILE.LCOM => tedit/TEDIT-FILE.LCOM} (98%) rename library/{TEDITFIND => tedit/TEDIT-FIND} (56%) rename library/{TEDITFIND.LCOM => tedit/TEDIT-FIND.LCOM} (60%) rename library/{TEDITFNKEYS => tedit/TEDIT-FNKEYS} (67%) rename library/{TEDITFNKEYS.LCOM => tedit/TEDIT-FNKEYS.LCOM} (94%) rename library/{TEDITHCPY => tedit/TEDIT-HCPY} (58%) rename library/{TEDITHCPY.LCOM => tedit/TEDIT-HCPY.LCOM} (96%) rename library/{TEDITHISTORY => tedit/TEDIT-HISTORY} (63%) rename library/{TEDITHISTORY.LCOM => tedit/TEDIT-HISTORY.LCOM} (54%) rename library/{TEDITLOOKS => tedit/TEDIT-LOOKS} (58%) rename library/{TEDITLOOKS.LCOM => tedit/TEDIT-LOOKS.LCOM} (59%) rename library/{TEDITMENU => tedit/TEDIT-MENU} (73%) rename library/{TEDITMENU.LCOM => tedit/TEDIT-MENU.LCOM} (99%) rename library/{TEDITPAGE => tedit/TEDIT-PAGE} (65%) rename library/{TEDITPAGE.LCOM => tedit/TEDIT-PAGE.LCOM} (96%) rename library/{PCTREE => tedit/TEDIT-PCTREE} (66%) rename library/{PCTREE.LCOM => tedit/TEDIT-PCTREE.LCOM} (64%) create mode 100644 library/tedit/TEDIT-SCREEN rename library/{TEDITSCREEN.LCOM => tedit/TEDIT-SCREEN.LCOM} (96%) create mode 100644 library/tedit/TEDIT-SELECTION rename library/{TEDITSELECTION.LCOM => tedit/TEDIT-SELECTION.LCOM} (65%) rename library/{TEXTOFD => tedit/TEDIT-TEXTOFD} (70%) rename library/{TEXTOFD.LCOM => tedit/TEDIT-TEXTOFD.LCOM} (55%) rename library/{TFBRAVO => tedit/TEDIT-TFBRAVO} (58%) create mode 100644 library/tedit/TEDIT-TFBRAVO.LCOM rename library/{TEDITWINDOW => tedit/TEDIT-WINDOW} (68%) rename library/{TEDITWINDOW.LCOM => tedit/TEDIT-WINDOW.LCOM} (98%) rename library/{ => tedit}/TEDIT.LCOM (96%) diff --git a/library/TEDITABBREV.LCOM b/library/TEDITABBREV.LCOM deleted file mode 100644 index 8013733b794fe66753d8b3bf4d2fd58d2f744ff1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 3994 zcmbtXTW=Fb6gGy?7O`!pN`?A>j<%v*tHkl%dk$6k?(@w&bs zP%r9Vs8m%I>M!UMq9C;eDN^71Q1!L^i~NM1nX_vg@$5Y}8u| zw}NIXxT~i1h1O25(+Il(cDB0p?%f4k-^PP1)vS&51ucck6lRQ07x&8GUirCDrDyj;Owd{kU zkAZS_xE{h3d_fxK7$sNQ#Htf#m{tN%v)QSVnfpjNzXyitrQI()I6|_F(B&| zR!iBYDWPIJf&_X7#Pe89Gz}XOFc^|ps<#JN*-%~%wz^Swt=?^HBZQ@Gr-k3OI#VbO z+5!Kxn1m&E(CcHz3p)Ma)>hEPzT4=B)T@NIW6%s5)J+XtH>wRI&y91FWgB-M(GjVK z8OdBnQQ+>2YfIt_^g{Af_1NMK<_+$pNAD7iM#$CXL#vr2j=Wz^?r^m$kEY7WX%0@8 zo5`soKaj?BvZ*c}JUCq@@m@Lk#3;3r&O2{UM-cj4mNQ^&7!DLLU+E$Yxmk3ukmCs*qh?{PW;QOeCGn006Vtlr zRyRSyeDi#x;(H)n^NKYC3xQ)H*EEbW-UFzNBaUmBY-)edae@S zd|}0Lmkeig1;tLmF}q^>d_X$vF6q*`i#(MiaZ7|Wh^n4DFKby5r-*QHg6qph-Sw5@_>{{$krbNIi8Zp3BO+Np&FzyS=PBLwDl4uf)BCgTV*ge2@f1YB@Hwz1F ze184~8Y%uq&uouzdPHX`DHjQdc?kcXZLc8PFo7px+bhY&vv^{*jfnLEvSEP~Ct@2n zDPRzDA;?IyR{xvdop}ij4 z@FrjPtN5Ni^cxG`c-2jM>q_EA&>jTv5nK+s;Tr8_jf|P%;Z8|WexteD&%$6 iWLcAAO&*&9{#GsEt3|+8VO^$;zr@%tX1u-GWAR_0zHIye diff --git a/library/TEDITCHAT b/library/TEDITCHAT deleted file mode 100644 index 6a6ec61e..00000000 --- a/library/TEDITCHAT +++ /dev/null @@ -1,439 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10) -(IL:FILECREATED "28-Mar-94 16:05:24" IL:|{PELE:MV:ENVOS}LIBRARY>TEDITCHAT.;3| 31193 - - IL:|changes| IL:|to:| (IL:FNS IL:\\TEXTSTREAMBOUT) - - IL:|previous| IL:|date:| "12-Jun-90 18:01:39" IL:|{PELE:MV:ENVOS}LIBRARY>TEDITCHAT.;2| -) - - -; Copyright (c) 1985, 1986, 1990, 1994 by Venue & Xerox Corporation. All rights reserved. - -(IL:PRETTYCOMPRINT IL:TEDITCHATCOMS) - -(IL:RPAQQ IL:TEDITCHATCOMS - ((IL:COMS (IL:* IL:\; "character routines") - (IL:FNS IL:TEDITCHAT.CHARFN IL:\\TEXTSTREAMBOUT)) - (IL:COMS (IL:FNS IL:TEDITSTREAM.INIT IL:TEDITCHAT.MENUFN)) - (IL:COMS (IL:* IL:\; "TEDIT update routines") - (IL:FNS IL:TEDIT.DISPLAYTEXT)) - (IL:GLOBALVARS IL:TEDITCHAT.MENU IL:CHAT.DRIVERTYPES IL:CHAT.DISPLAYTYPES) - (IL:VARS IL:TEDITCHAT.MENUITEMS (IL:TEDITCHAT.MENU)) - (IL:ADDVARS (IL:CHAT.DRIVERTYPES (IL:TEDIT IL:TEDITCHAT.CHARFN IL:NILL))) - (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SOURCE) - IL:CHATDECLS)))) - - - -(IL:* IL:\; "character routines") - -(IL:DEFINEQ - -(IL:TEDITCHAT.CHARFN - (IL:LAMBDA (IL:CH IL:CHAT.STATE) (IL:* IL:\; "Edited 12-Jun-90 18:00 by mitani") - (LET* ((IL:TEXTSTREAM (IL:|fetch| (IL:CHAT.STATE IL:TEXTSTREAM) IL:|of| IL:CHAT.STATE)) - (IL:SEL (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of| (IL:TEXTOBJ IL:TEXTSTREAM)))) - (IL:\\CARET.DOWN (IL:|fetch| (IL:TEXTOBJ IL:DS) IL:|of| (IL:TEXTOBJ IL:TEXTSTREAM)) - ) - (IL:SELCHARQ IL:CH - (IL:BS (IL:\\TEDIT.CHARDELETE IL:TEXTSTREAM "" IL:SEL) - (IL:MOVETO (IL:|fetch| IL:X0 IL:|of| IL:SEL) - (IL:|fetch| IL:Y0 IL:|of| IL:SEL) - (CAR (IL:|fetch| (IL:TEXTOBJ IL:\\WINDOW) IL:|of| (IL:TEXTOBJ - - IL:TEXTSTREAM - ))))) - (IL:LF NIL) - (IL:BOUT IL:TEXTSTREAM IL:CH))))) - -(IL:\\TEXTSTREAMBOUT - (IL:LAMBDA (STREAM BYTE) (IL:* IL:\; "Edited 28-Mar-94 15:29 by jds") - - (IL:* IL:|;;| "Do BOUT to a text stream, which is an insertion at the caret.") - - (PROG ((IL:TEXTOBJ (IL:|fetch| (IL:TEXTSTREAM IL:TEXTOBJ) IL:|of| STREAM)) - IL:CH# IL:WINDOW IL:TEXTLEN IL:PS IL:PC IL:PSTR IL:OFFST IL:SEL) - (IL:SETQ IL:TEXTLEN (IL:|fetch| (IL:TEXTOBJ IL:TEXTLEN) IL:|of| IL:TEXTOBJ)) - (IL:SETQ IL:WINDOW (IL:|fetch| (IL:TEXTOBJ IL:\\WINDOW) IL:|of| IL:TEXTOBJ)) - (IL:SETQ IL:SEL (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of| IL:TEXTOBJ)) - (COND - ((NOT (CAR (IL:|fetch| IL:L1 IL:|of| IL:SEL))) - (RETURN))) (IL:* IL:\; - "Return if caret out of bounds, ie, user scrolls past end of text") - (IL:SETQ IL:CH# (IL:|fetch| IL:CH# IL:|of| IL:SEL)) - (AND IL:WINDOW (IL:\\TEDIT.MARK.LINES.DIRTY IL:TEXTOBJ IL:CH# IL:CH#)) - (COND - ((IL:IEQP BYTE 13) - (IL:\\INSERTCR BYTE IL:CH# IL:TEXTOBJ)) - (T (IL:\\INSERTCH BYTE IL:CH# IL:TEXTOBJ))) - (AND IL:WINDOW - (PROG ((IL:THISLINE (IL:|fetch| (IL:TEXTOBJ IL:THISLINE) IL:|of| IL:TEXTOBJ)) - IL:EOLFLAG IL:CHORIG IL:CHWIDTH IL:OXLIM IL:OCHLIM IL:OCR\\END IL:PREVSPACE - IL:FIXEDLINE IL:NEXTLINE IL:LINES IL:NEWLINEFLG IL:DX IL:PREVLINE IL:SAVEWIDTH - IL:OFLOWFN IL:OLHEIGHT IL:DY IL:TABSEEN IL:IMAGECACHE IL:CURLINE IL:FONT - (IL:L1 (CAR (IL:|fetch| IL:L1 IL:|of| IL:SEL))) - (IL:LN (CAR (IL:|fetch| IL:LN IL:|of| IL:SEL))) - (IL:LOOKS (IL:\\TEDIT.APPLY.STYLES (IL:|fetch| (IL:TEXTOBJ IL:CARETLOOKS) - IL:|of| IL:TEXTOBJ) - (IL:|fetch| (IL:TEXTOBJ IL:\\INSERTPC) IL:|of| - IL:TEXTOBJ) - IL:TEXTOBJ))) - (IL:|add| (IL:|fetch| IL:CH# IL:|of| IL:SEL) - 1) (IL:* IL:\; - "These must be here, since SELs are valid even without a window.") - (IL:|replace| IL:CHLIM IL:|of| IL:SEL IL:|with| (IL:|fetch| - IL:CH# IL:|of| - IL:SEL)) - (IL:|replace| IL:POINT IL:|of| IL:SEL IL:|with| 'IL:LEFT) - (IL:|replace| IL:DCH IL:|of| IL:SEL IL:|with| 0) - (IL:|replace| IL:SELKIND IL:|of| IL:SEL IL:|with| 'IL:CHAR) - (IL:SETQ IL:CURLINE IL:L1) - (IL:|add| (IL:|fetch| IL:CHARLIM IL:|of| IL:CURLINE) - 1) - (IL:|add| (IL:|fetch| IL:CHARTOP IL:|of| IL:CURLINE) - 1) - (IL:SETQ IL:FONT (IL:|fetch| IL:CLFONT IL:|of| IL:LOOKS)) - (IL:DSPFONT IL:FONT (CAR IL:WINDOW)) - (COND - ((OR (IL:IGREATERP (IL:PLUS (IL:|fetch| IL:X0 IL:|of| IL:SEL) - (IL:CHARWIDTH BYTE IL:FONT)) - (IL:IDIFFERENCE (IL:|fetch| (IL:TEXTOBJ IL:WRIGHT) - IL:|of| IL:TEXTOBJ) - 8)) - (IL:IEQP BYTE (IL:CHARCODE IL:CR))) - (IL:* IL:\; - "gone off the edge of the line reformat and add new line") - (IL:TEDIT.UPDATE.SCREEN IL:TEXTOBJ) - (IL:\\FIXSEL IL:SEL IL:TEXTOBJ (CAR IL:WINDOW)) - (IL:SETQ IL:L1 (CAR (IL:|fetch| IL:L1 IL:|of| IL:SEL))) - (IL:SETQ IL:LN (CAR (IL:|fetch| IL:LN IL:|of| IL:SEL))) - (COND - ((OR (NULL (IL:SELECTQ (IL:|fetch| IL:POINT IL:|of| IL:SEL) - (IL:LEFT IL:L1) - (IL:RIGHT IL:LN) - NIL)) - (IL:ILEQ (IL:SELECTQ (IL:|fetch| IL:POINT IL:|of| IL:SEL) - (IL:LEFT (IL:|fetch| IL:YBOT IL:|of| IL:L1)) - (IL:RIGHT (IL:|fetch| IL:YBOT IL:|of| IL:LN)) - 0) - (IL:|fetch| (IL:REGION IL:BOTTOM) - IL:|of| (IL:DSPCLIPPINGREGION NIL (CAR IL:WINDOW))))) - (IL:* IL:\; - "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.") - (IL:|while| (IL:ILESSP (IL:|fetch| IL:Y0 IL:|of| IL:SEL) - (IL:|fetch| (IL:TEXTOBJ IL:WBOTTOM) - IL:|of| IL:TEXTOBJ)) - IL:|do| (IL:* IL:\; - "The caret just went off-screen. Move it up some.") - (IL:|replace| (IL:TEXTOBJ IL:EDITOPACTIVE) IL:|of| - IL:TEXTOBJ - IL:|with| NIL) - (IL:SCROLLW (CAR IL:WINDOW) - 0 - (IL:LLSH (COND - ((IL:SELECTQ (IL:|fetch| IL:POINT - IL:|of| IL:SEL) - (IL:LEFT IL:L1) - (IL:RIGHT IL:LN) - NIL) - (IL:|fetch| IL:LHEIGHT - IL:|of| (IL:SELECTQ (IL:|fetch| - IL:POINT - IL:|of| - IL:SEL) - (IL:LEFT IL:L1) - (IL:RIGHT IL:LN) - (IL:SHOULDNT)))) - (T 12)) - 1)))))) - (T (IL:TEDIT.DISPLAYTEXT IL:TEXTOBJ BYTE (IL:CHARWIDTH BYTE IL:FONT) - IL:CURLINE - (IL:|fetch| IL:X0 IL:|of| IL:SEL) - (CAR IL:WINDOW) - IL:SEL) (IL:* IL:\; - "Print out the character on the screen") - (IL:|add| (IL:|fetch| IL:X0 IL:|of| IL:SEL) - (IL:CHARWIDTH BYTE IL:FONT)) - - (IL:* IL:|;;| "And move the selection's notion of our X position to the right to account for that character's width.") - - (IL:|replace| IL:XLIM IL:|of| IL:SEL IL:|with| (IL:|fetch| - IL:X0 - IL:|of| - IL:SEL)))) - -(IL:* IL:|;;;| "Fix up the TEXTSTREAM so that the FILEPTR looks like it ought to after the BOUT, even though we've been updating the screen (which usually moves the fileptr....)") - - (IL:SETQ IL:PS (IL:|ffetch| (IL:PIECE IL:PSTR) IL:|of| - (IL:SETQ IL:PC - (IL:|fetch| (IL:TEXTOBJ - - IL:\\INSERTPC - ) - IL:|of| IL:TEXTOBJ))) - ) (IL:* IL:\; - "This piece resides in a STRING. Because it's newly 'typed' material.") - (IL:|replace| (IL:TEXTSTREAM IL:PIECE) IL:|of| STREAM IL:|with| - IL:PC) - (IL:* IL:\; - "Remember the current piece for others.") - (IL:* IL:\; - "And which number piece this is.") - (IL:|freplace| (STREAM IL:CPPTR) IL:|of| STREAM - IL:|with| (IL:ADDBASE (IL:|ffetch| (IL:STRINGP IL:BASE) IL:|of| - IL:PS) - (IL:LRSH (IL:SETQ IL:OFFST (IL:|ffetch| (IL:STRINGP - IL:OFFST) - IL:|of| IL:PS)) - 1))) (IL:* IL:\; - "Pointer to the actual characters in the string (allowing for substrings.)") - (IL:|freplace| (STREAM IL:CPAGE) IL:|of| STREAM IL:|with| 0) - (IL:|freplace| (STREAM IL:COFFSET) IL:|of| STREAM - IL:|with| (IL:IPLUS (IL:|freplace| (IL:TEXTSTREAM IL:PCSTARTCH) - IL:|of| STREAM IL:|with| (LOGAND 1 - IL:OFFST)) - (IL:|fetch| (IL:TEXTOBJ IL:\\INSERTLEN) IL:|of| - IL:TEXTOBJ)) - ) - (IL:|freplace| (IL:TEXTSTREAM IL:PCSTARTPG) IL:|of| STREAM IL:|with| - 0) - (IL:* IL:\; - "Page # within the 'file' where this piece starts") - (IL:|freplace| (STREAM IL:CBUFSIZE) IL:|of| STREAM - IL:|with| (IL:|fetch| (STREAM IL:COFFSET) IL:|of| STREAM)) - (IL:|freplace| (STREAM IL:EPAGE) IL:|of| STREAM IL:|with| 1) - (IL:|freplace| (IL:TEXTSTREAM IL:CHARSLEFT) IL:|of| STREAM IL:|with| - 0) - (IL:* IL:\; - "We're, perforce, at the end of the piece.") - (IL:|freplace| (IL:TEXTSTREAM IL:REALFILE) IL:|of| STREAM IL:|with| - NIL) - (IL:* IL:\; "We're not on a file....") - ))))) -) -(IL:DEFINEQ - -(IL:TEDITSTREAM.INIT - (IL:LAMBDA (IL:WINDOW IL:MENUFN) (IL:* IL:\; "Edited 12-Jun-90 18:01 by mitani") - - (IL:* IL:|;;| "Initialize and return TEDIT TEXTSTREAM") - - (PROG* ((IL:TEXTSTREAM (IL:OPENTEXTSTREAM NIL IL:WINDOW NIL NIL)) - (IL:TEXTOBJ (IL:TEXTOBJ IL:TEXTSTREAM))) (IL:* IL:\; - "force shift select typein to be put in keyboard buffer") - (IL:TEXTPROP IL:TEXTSTREAM 'IL:COPYBYBKSYSBUF T) - (IL:|replace| (STREAM IL:STRMBOUTFN) IL:|of| IL:TEXTSTREAM IL:|with| - 'IL:\\TEXTSTREAMBOUT) - (IL:|replace| SET IL:|of| (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of| - IL:TEXTOBJ) - IL:|with| T) - (IL:|replace| IL:L1 IL:|of| (IL:|fetch| (IL:TEXTOBJ IL:SEL) IL:|of| - IL:TEXTOBJ) - IL:|with| (LIST (IL:|fetch| IL:DESC IL:|of| (IL:|fetch| (IL:TEXTOBJ - IL:THISLINE) - IL:|of| IL:TEXTOBJ)))) - (IL:* IL:\; - "hookup middle button menu instead of TEDIT menu") - (IL:WINDOWPROP IL:WINDOW 'IL:TEDIT.TITLEMENUFN IL:MENUFN) - (RETURN IL:TEXTSTREAM)))) - -(IL:TEDITCHAT.MENUFN - (IL:LAMBDA (IL:WINDOW) (IL:* IL:|| "20-Oct-86 15:03") - (DECLARE (IL:GLOBALVARS IL:TEDITCHAT.MENU) - (IL:SPECVARS IL:WINDOW IL:STATE)) (IL:* IL:MIDDLEBUTTON) - (PROG ((IL:STATE (IL:WINDOWPROP IL:WINDOW 'IL:CHATSTATE)) - IL:COMMAND) - (COND - ((NOT IL:STATE) (IL:* IL:N\o IL:|Connection| - IL:|here;| IL:|try| IL:|to| - IL:|reestablish|) - (RETURN (COND - ((IL:LASTMOUSESTATE IL:MIDDLE) - (IL:CHAT.RECONNECT IL:WINDOW)) - (T (IL:TOTOPW IL:WINDOW)))))) - (IL:|replace| (IL:CHAT.STATE IL:HELD) IL:|of| IL:STATE IL:|with| T) - (IL:\\CHECKCARET IL:WINDOW) - (IL:SELECTQ (IL:SETQ IL:COMMAND (IL:MENU (OR IL:TEDITCHAT.MENU (IL:SETQ IL:TEDITCHAT.MENU - (IL:|create| IL:MENU - IL:ITEMS IL:_ - IL:TEDITCHAT.MENUITEMS - ))))) - (IL:|Close| (IL:|replace| (IL:CHAT.STATE IL:RUNNING?) IL:|of| IL:STATE - IL:|with| 'IL:CLOSE) (IL:* IL:|Ask| IL:CHAT.TYPEIN IL:|to| - IL:|shut| IL:|things| IL:|down.|) - ) - (IL:|New| (IL:|replace| (IL:CHAT.STATE IL:RUNNING?) IL:|of| IL:STATE - IL:|with| 'IL:CLOSE) - (IL:WINDOWPROP IL:WINDOW 'IL:KEEPCHAT 'IL:NEW)) - (IL:|Suspend| (IL:|replace| (IL:CHAT.STATE IL:RUNNING?) IL:|of| IL:STATE - IL:|with| 'IL:CLOSE) - (IL:WINDOWPROP IL:WINDOW 'IL:KEEPCHAT T)) - (IL:|Freeze| (IL:* IL:|Leave| IL:|in| IL:HELD - IL:|state|) - (RETURN)) - (NIL) - (IL:APPLY* IL:COMMAND IL:STATE IL:WINDOW)) - (IL:|replace| (IL:CHAT.STATE IL:HELD) IL:|of| IL:STATE IL:|with| NIL)))) -) - - - -(IL:* IL:\; "TEDIT update routines") - -(IL:DEFINEQ - -(IL:TEDIT.DISPLAYTEXT - (IL:LAMBDA (IL:TEXTOBJ IL:CH IL:CHWIDTH IL:LINE IL:XPOINT IL:DS IL:SEL) - (IL:* IL:\; "Edited 12-Jun-90 18:01 by mitani") - (IL:* IL:|This| IL:|function| - IL:|does| IL:|the| IL:|actual| - IL:|displaying| IL:|of| - IL:|typed-in| IL:|text| IL:|on| - IL:|the| IL:|edit| IL:|window.|) - (PROG ((IL:LOOKS (IL:\\TEDIT.APPLY.STYLES (IL:|fetch| (IL:TEXTOBJ IL:CARETLOOKS) IL:|of| - IL:TEXTOBJ) - (IL:|fetch| (IL:TEXTOBJ IL:\\INSERTPC) IL:|of| IL:TEXTOBJ) - IL:TEXTOBJ)) - (IL:TERMSA (IL:|fetch| (IL:TEXTOBJ IL:TXTTERMSA) IL:|of| IL:TEXTOBJ)) - IL:DY IL:FONT) - (IL:MOVETO IL:XPOINT (IL:IPLUS (IL:|fetch| IL:YBASE IL:|of| IL:LINE) - (OR (IL:|fetch| IL:CLOFFSET IL:|of| IL:LOOKS) - 0)) - IL:DS) (IL:* IL:|Set| IL:|the| IL:|display| - IL:|stream| IL:|position|) - (COND - (IL:TERMSA (IL:* IL:|Special| IL:|terminal| - IL:|table| IL:|for| IL:|controlling| - IL:|character| IL:|display.| - IL:|Use| IL:|it.|) - (IL:RESETLST - (IL:RESETSAVE IL:\\PRIMTERMSA IL:TERMSA) - (IL:|replace| (IL:TEXTSTREAM IL:REALFILE) IL:|of| (IL:|fetch| - (IL:TEXTOBJ - IL:STREAMHINT - ) - IL:|of| - IL:TEXTOBJ) - IL:|with| IL:DS) - (COND - ((IL:STRINGP IL:CH) - (IL:|for| IL:CHAR IL:|instring| IL:CH - IL:|do| (IL:SELCHARQ IL:CHAR - (IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|) - (IL:BITBLT NIL 0 0 IL:DS IL:XPOINT - (IL:|fetch| IL:YBOT IL:|of| - IL:LINE) - 36 - (IL:|fetch| IL:LHEIGHT - IL:|of| IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE) - (IL:RELMOVETO 36 0 IL:DS)) - (IL:CR (IL:BITBLT NIL 0 0 IL:DS IL:XPOINT - (IL:|fetch| IL:YBOT IL:|of| - IL:LINE) - (IL:IMAX 6 (IL:CHARWIDTH IL:CHAR - IL:FONT)) - (IL:|fetch| IL:LHEIGHT - IL:|of| IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE)) - (IL:\\DSPPRINTCHAR (IL:|fetch| (IL:TEXTOBJ - IL:STREAMHINT) - IL:|of| IL:TEXTOBJ) - IL:CHAR)))) - (T (IL:SELCHARQ IL:CH - (IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|) - (IL:BITBLT NIL 0 0 IL:DS IL:XPOINT (IL:|fetch| - IL:YBOT - IL:|of| IL:LINE - ) - 36 - (IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE) - (IL:RELMOVETO 36 0 IL:DS)) - (IL:CR (IL:BITBLT NIL 0 0 IL:DS IL:XPOINT (IL:|fetch| IL:YBOT - IL:|of| IL:LINE) - (IL:IMAX 6 (IL:CHARWIDTH IL:CH IL:FONT)) - (IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE)) - (IL:\\DSPPRINTCHAR (IL:|fetch| (IL:TEXTOBJ IL:STREAMHINT) - IL:|of| IL:TEXTOBJ) - IL:CH)))))) - (T (IL:* IL:N\o IL:|special| - IL:|handling;| IL:|just| IL:|use| - IL:|native| IL:|character| - IL:|codes|) - (COND - ((IL:STRINGP IL:CH) - (IL:|for| IL:CHAR IL:|instring| IL:CH - IL:|do| (IL:SELCHARQ IL:CHAR - (IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|) - (IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS) - (IL:|fetch| IL:YBOT IL:|of| IL:LINE) - 36 - (IL:|fetch| IL:LHEIGHT IL:|of| - IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE) - (IL:RELMOVETO 36 0 IL:DS)) - (IL:CR (IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS) - (IL:|fetch| IL:YBOT IL:|of| IL:LINE) - (IL:IMAX 6 (IL:CHARWIDTH IL:CHAR IL:FONT)) - (IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE - ) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE)) - (IL:BLTCHAR IL:CHAR IL:DS)))) - (T (IL:SELCHARQ IL:CH - (IL:TAB (IL:* IL:|Put| IL:|down| IL:|white|) - (IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS) - (IL:|fetch| IL:YBOT IL:|of| IL:LINE) - 36 - (IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE) - (IL:RELMOVETO 36 0 IL:DS)) - (IL:CR (IL:* IL:|Blank| IL:|out| IL:|the| - IL:|CR's| IL:|width.|) - (IL:BITBLT NIL 0 0 IL:DS (IL:DSPXPOSITION NIL IL:DS) - (IL:|fetch| IL:YBOT IL:|of| IL:LINE) - (IL:IMAX 6 (IL:CHARWIDTH IL:CH IL:FONT)) - (IL:|fetch| IL:LHEIGHT IL:|of| IL:LINE) - 'IL:TEXTURE - 'IL:REPLACE IL:WHITESHADE)) - (IL:BLTCHAR IL:CH IL:DS))))))))) -) -(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY - -(IL:GLOBALVARS IL:TEDITCHAT.MENU IL:CHAT.DRIVERTYPES IL:CHAT.DISPLAYTYPES) -) - -(IL:RPAQQ IL:TEDITCHAT.MENUITEMS - ((IL:|Close| 'IL:|Close| "Closes the connection and returns") - (IL:|Suspend| 'IL:|Suspend| "Closes the connection but leaves window up") - (IL:|New| 'IL:|New| "Closes this connection and prompts for a new host") - (IL:|Freeze| 'IL:|Freeze| "Holds typeout in this window until you bug it again") - ("Dribble" (IL:FUNCTION IL:CHAT.TYPESCRIPT) - "Starts a typescript of window typeout") - ("Input" (IL:FUNCTION IL:CHAT.TAKE.INPUT) - "Allows input from a file") - ("Option" (IL:FUNCTION IL:DO.CHAT.OPTION) - "Do protocol specific option"))) - -(IL:RPAQQ IL:TEDITCHAT.MENU NIL) - -(IL:ADDTOVAR IL:CHAT.DRIVERTYPES (IL:TEDIT IL:TEDITCHAT.CHARFN IL:NILL)) -(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY - -(IL:FILESLOAD (IL:SOURCE) - IL:CHATDECLS) -) -(IL:PUTPROPS IL:TEDITCHAT IL:COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990 1994)) -(IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (1308 15667 (IL:TEDITCHAT.CHARFN 1321 . 2481) (IL:\\TEXTSTREAMBOUT 2483 . 15665)) ( -15668 20008 (IL:TEDITSTREAM.INIT 15681 . 17389) (IL:TEDITCHAT.MENUFN 17391 . 20006)) (20054 30055 ( -IL:TEDIT.DISPLAYTEXT 20067 . 30053))))) -IL:STOP diff --git a/library/TEDITCHAT.LCOM b/library/TEDITCHAT.LCOM deleted file mode 100644 index 4f68870daf0878911df16f8af704cd0a5b8132ba..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9714 zcmbt4TWllOb)>YF*X~N8WWp7Mg?&S-=_-H(&Vv*sy9*7;;c}!QXO=S*rJ8}F6}i@f zB?UdQ-9|xcBXH557D>=LML&v7;RZo}R+|_F(zFEf%+2*`eEjjFU*C?zRw@j9@EzeD{*K4Lx z^o_g?kd1;3fV|~duzOevHe6z?>N^ZWgeScm}D>;^4T2`{lnM{h^NbU4~ z|8TFh~t*4bY7jHN2= zR;PWR0cKV@?R1!T|G0O0!W4Z#^1{MG3OBU2Puj3I6@I8{%bK#BUP@iUx61iGnqSfx zu$;~;t2*KNrfb^fa%FwltgbuWx8D8&mfq6Nn5HO88j9y^XLq~%Zu^+%Kj|%>F%)*y zEPKRP5m_z^;^{&aa+!=a&KzEeR3*UuaX$=J=%z zE&y(!R;se)Vh)wSWeO+3Gj0CkvNZo0(8y;NEy3&ad{7qx;>tpKj>S$!VzCipECzp% zuT92d<(K)8<};J=cz8aI&sJKUs~3;7e!0h2TEB_^X~T#`ze8B2;Y;Xnwge+JUa0LaUP?k_S-pG5VSrrSB-r^?BR1~0N zmrd(dSzuR@L#Jdr4Nw|9P(`LZW8G|6MZYY7C?~gOt`Epik;USMSb=m`%?4jkvTq3} zQqMtX9xhXn_9|Rl2oX|VvNpiM1Wc+(J3r9_wZ?=Fde&O8xlm+JIwpK` z#Pgd2%O(dk$41RJ!L(P%BBv+6^Kw}j={sUD^?PD4vz2Jkvx)dmM&CalO*jdfk8Q4g zzihS8fcr+PGyeJh#fMfI=O2jQ{wm)y@~;9}PVSwE%TXdOp6TNE3SpT1kL#0PPl;7> z@z}wyl4JcSF!_oEz02K4GAXC~$!l^*Pp13MYg>6F-=Uw!(|{7d!@wB;&h(ubVl=i@ zT#ch=lGq-P7)}u(zYcCLQ@^hX8?;RomOSI9NO`tmBdxM1r#_zuZ>@F);#a^$&Z$*X;-B42wP`xz;3C3(HSVt+c4*uVHY8$;0h_TyLt z@X6@b#J~R%P_FDJC;BU-&(6fbueYW?d!z463AERqd=~2y+WpU7m+L->eHQPp93&I+ zQSvo0+D#^RAyzHw=m>t>sMUz9RO-%blyXJ2~jLd0iM$U=lAOgrC&>)73kcP=& z4h0?rYsdoR6OfY_W+C$f8OcT298xd{;n_tJX%OSH#9(NJF1@(O0} z(F8eKuJ6B#2f%cM=6D$xQ~*>kxDL5?<>7 zv7RMd!-VOX&~Z9(7olC(kY^-9hb!S)7Dz~^q>0GY)5JSxOd|yttkiNS{19Lni|r@VNu zoEVm?DY28Yp%j^AgkgcL4hj#lwFRqc`Qc2K3x9UjtvRmk`LnZp3JD-V1$GG?vSeHr zXtpq90E$ATVpi*vtXfpgP#y$@%J;88HnY33+q%Z1N>Hf;CCcRF=qg30(mNmT&=7;y z-tNpyvh*qi0E8sJ(iepaMgN0eBxA!6@i-^q?d}YZDY)0buvbnHYMea$2#OhLYM$>x zJ)>x-1TZA}xty4asuPGF4OPxiMI6_xasWvMZb8veq6Np@%x~t`yiG4(FEK^h6^|*t z1&O1Onj)@Krm0FA^>!M?NJV7cGH#btdjGgV!7(RUcxRgd#8w zDH)iizaY4XRJR4EQZZybK&l?8V+W~ni6MuBf|;YVe6!-svH0X@JQk-*#I$bm%OmBF zXTHw0>EPFpTC8Adkq|$4^9R3x{N-T(V)p`<{Utr?BgchJtw|x#On|2Yr9)Qnn$RxwrssX(|CGh@Lqhd18T3-HYy~=HG9?13Ke!ogVfcyZDwdmF%(c?=CwrN!B z?tICqRXki-VtAuGR`Zo5hCZ<9(M0G2O{o0da2<;}C*T9|6zQCBJERwQQq6?qJbVnr zbJ=x)y&`J_LJaT=pT2Z87DroYp?S{WxN)7T!N&B=&U8bRVhiXM8i{1GF@%);+ zCs$uHp0{aP-zr_igH2Pyh?0K z#41%E{3%DQQrkF+f||M!sIr8FOHBM_05}whNuhRhbPr|u5vU&2uT* zZ*srG@P5LO7dqd-@5(kL>N8O2lE*}U7xeaB@T!-&L6?bg(Q`K-KlC|^(11q&8uX(v z+mtP3;bDI41) z0I-A4#z@6qTU+kN>S9ynKAzn7lpVOg-o2d24SN`Z%@)ZN+J4N;-Sq z3LIJ@{QcH-Sa$GaYub5@`}`j|*FSV-oM~|T-{!wR-%6r?{ax<)&0Q1So8TtanH8hU zeLpey@PYKP(d|xh4blCqGiE=1V1ti+A-eNtO(#i*pFg|(>Ur$Xp$!ZH>Hk5N&B`aU7g6RfM~(#D3nhBcw&T{=Y*ye+5x9^=QNl)g zo0Kh5MlWJ1rJt8I7J2NUI#l{!eej+RgAGY2>S+mm6iOlwFj3|wJ-JRD*2o@>PLDz< zPDxA}^?xNMje084Jru4ZP?bt0iAkj!l9*IVR-$|8#v)MYgK^IuzK}t(L4Ntta7vX^ z5Q~E7#+@s=Rq+TT5P#ndFXnuI6AEukpZJvr^#%YvSO=h*Yuvv5+%tBAKjW+L%{eCe z&9_(zUaTK&@0_%c*b%(`-|M!IQ*+^W>%jr|h8Jp~%ig5U(Ut&viQdcOUg|}*Xud;TEWEcAUJA{!vlmbQVrg=Qa|8swGQkS^n4Rpl*-o$9ZSS1y!B;HX-4;7)pPU|bx&ELY4odtG8d>(g5YZj@ z2Bp*9{zm(l-P`N7diOvBgho=KFOYE|BOr`v?>I`+;SqfJa&pY>_Kw&#>$dN)-QMwu zL@0Y0Ap!*mcu19dofa^9|FF$JjM?h~&v1aGs(Z56VfTBd?9S=CZ103^zq`HH<%mKf^oOJ_7Q#@tEVCqrJlu*1IbY5oaS-t9y8Q z@*t$5V8;f%^-N%i}Hxwb)}I zyp!Heufw2Kv$J=1Z-@10_y3?t4D^>&4a~rIz!10!A^Nb*{V&aczNo4DydyPi&xjS2 xpI(aGNUgWKr)~BXw$VQ7{Q)cVjt+ZA+r%!E5*Y^nvhWWw2Kc9gH2|IC{|%t5YhM5W diff --git a/library/TEDITFILE b/library/TEDITFILE deleted file mode 100644 index b164400d..00000000 --- a/library/TEDITFILE +++ /dev/null @@ -1,3702 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "20-Jun-2022 12:06:04"  -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDITFILE.;3 248098 - - :CHANGES-TO (VARS TEDITFILECOMS) - (FNS TEDIT.GET.PASSWORD) - - :PREVIOUS-DATE "20-Feb-2022 12:43:03" -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDITFILE.;2) - - -(* ; " -Copyright (c) 1983-1994, 1999-2001, 2021-2022 by Venue & Xerox Corporation. -") - -(PRETTYCOMPRINT TEDITFILECOMS) - -(RPAQQ TEDITFILECOMS - ((FILES TEDITDCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDITDCL)) - (COMS - (* ;; "GETting a file") - - (FNS TEDIT.BUILD.PCTB \TEDIT.CONVERT.FOREIGN.FORMAT TEDIT.FORMATTEDFILEP TEDIT.GET - TEDIT.PARSE.PAGEFRAMES1 \ARBIN \ATMIN \DWIN \STRINGIN \TEDIT.FORMATTEDP1 - \TEDIT.SET.WINDOW TEDIT.GET.PASSWORD)) - (COMS - (* ;; "INCLUDEing a file") - - (FNS TEDIT.INCLUDE TEDIT.RAW.INCLUDE)) - (COMS - (* ;; "PUTting a file:") - - (FNS TEDIT.PUT TEDIT.PUT.PCTB \TEDIT.PUTRESET TEDIT.PUT.PIECE.DESCRIPTOR \ARBOUT - \ATMOUT \DWOUT \STRINGOUT \TEDIT-OPEN-FONT-FILE)) - (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS.LIST - \TEDIT.PUT.SINGLE.CHARLOOKS) - (FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS.LIST - \TEDIT.PUT.SINGLE.PARALOOKS) - (GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) - (INITVARS (TEDIT.INPUT.FORMATS NIL) - (*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) - (* ; - "For consistent reading and writing of info on TEdit files.") - ) - (COMS - (* ;; - "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") - - (FNS TEDIT.BUILD.PCTB2 \TEDIT.GET.CHARLOOKS.LIST2 \TEDIT.GET.SINGLE.CHARLOOKS2 - \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.PUT.SINGLE.CHARLOOKS2 - \TEDIT.GET.PARALOOKS.LIST2 \TEDIT.GET.SINGLE.PARALOOKS2 TEDIT.PUT.PCTB2 - \TEDIT.PUT.CHARLOOKS.LIST2 \TEDIT.PUT.PARALOOKS.LIST2)) - (COMS - (* ;; "For converting incoming old-format files (1/27/85 cutover)") - - (FNS TEDIT.BUILD.PCTB1 TEDIT.GET.PAGEFRAMES1 \TEDIT.GET.CHARLOOKS1 - \TEDIT.GET.PARALOOKS1 TEDIT.GET.OBJECT1)) - (COMS - (* ;; "VERSION 0 Compatibility reading functions") - - (FNS TEDIT.BUILD.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0)))) - -(FILESLOAD TEDITDCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDITDCL) -) - - - -(* ;; "GETting a file") - -(DEFINEQ - -(TEDIT.BUILD.PCTB - [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS CLEARGET?) - (* ; "Edited 29-Apr-2021 22:52 by rmk:") - (* ; "Edited 11-Jun-99 14:37 by rmk:") - (* ; "Edited 19-Apr-93 13:46 by jds") - (* ; - "START = 1st char of file to read from, if specified") - (* ; - "END = use this as eofptr of file. For use in reading files within files.") - (PROG (SEL LINES PCTB PC OLDPC PCCOUNT TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN - PIECEINFOCH# CACHE CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP - EXISTINGCHARLOOKS EXLOOK EXISTINGFMTSPECS (*READTABLE* *TEDIT-FILE-READTABLE*) - (*PRINT-BASE* 10) - (CURFILECH# (OR START 0)) - (CURCH# 1) - (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) - LOOKSHASH PARAHASH) - [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (T (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ] - (* ; - "Set the default paragraph formatting for filling in piece PPARALOOKS fields") - (COND - (TEXTOBJ (* ; - "If there's a TEXTOBJ behind this, set its TXTFILE field to point to the right place.") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT))) - (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (* ; - "Set the default CHARLOOKS, for filling in pieces' PLOOKS fields") - (SETQ TEXT (\CREATEPIECEORSTREAM TEXT DEFAULTLOOKS DEFAULTPARALOOKS START END)) - (* ; - "Grab the file, or a single piece (if the text is a string, or such simple cases)") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) - (* ; - "Start by assuming no page formatting") - (COND - ((STREAMP TEXT) (* ; - "OK, it wasn't a string, so check for cases where we have to cache the file locally.") - (AND TEXTOBJ (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT)) - (COND - ((OR [AND TEXTOBJ (SETQ CACHE? (TEXTPROP TEXTOBJ 'CACHE] - (NOT (RANDACCESSP TEXT))) (* ; - "If the file device isn't rancom access, cache the file locally.") - (* ; - "Also do this if he asks for a local cache.") - [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; "The cache file") - (COND - ((OR START END) - (COPYBYTES TEXT CACHE (OR START 0) - (OR END -1))) - (T (COPYBYTES TEXT CACHE))) (* ; "Copy the text there") - (SETQ CACHE? T) (* ; "Remember that we cached it!") - - (* ;; "COPYBYTES can only have start/end args of NIL if the file is not random access. So it's impossible to grab out of the middle of a file on an NS server. Sorry.") - - (COND - (CACHE? - - (* ;; "for the folx who don't trust the connections, since all their pcs will point to core, we can close the txtfile connection") - - (CLOSEF TEXT))) - (replace (STREAM EOLCONVENTION) of CACHE with (fetch (STREAM - EOLCONVENTION - ) - of TEXT)) - (* ; - "Remember the EOL convention from the original file, so that we can do a copychars if need be.") - (SETQ TEXT CACHE) (* ; - "And pretend the cache IS the real file from here on") - (SETQ START (SETQ END NIL)) - - (* ;; "Since we only copied the relevant part of the file into the cache, we don't need to remember the limits of interest.") - - )) - (SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END)) - - (* ;; "RMK: Domestic EOL is now LF, so changed from CR") - - (COND - ((AND (NOT PCCOUNT) - (NEQ (fetch (STREAM EOLCONVENTION) of TEXT) - LF.EOLC)) - - (* ;; "This is an UNFORMATTED file, and it has a foreign EOL convention. Convert it, and save the converted copy locally.") - - [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; "Build a cache file") - (COND - ((OR START END) - (COPYCHARS TEXT CACHE (OR START 0) - (OR END -1)) - - (* ;; "mcf: just like before, we have all the relevant portion") - - (SETQ START (SETQ END NIL))) - (T (COPYCHARS TEXT CACHE))) (* ; - "Copy the text, converting from the foreign EOL convention into CR as end of line.") - (SETQ TEXT CACHE) - - (* ;; "And think of THIS as the cache. At this point, we may have cached twice in succession--no need to clip off START and END.") - - (SETQ CACHE? T) (* ; - "Remember that we cached the file!") - )) (* ; - "Check to see if this is a formatted file, and find out how may pieces we should allocate for it.") - )) - (AND TEXTOBJ (TEXTPROP TEXTOBJ 'CACHE CACHE?)) (* ; - "REMEMBER THAT THIS TEXT WAS CACHED, SO THAT LATER PUTS DON'T INVALIDATE THE CACHE.") - [COND - [(type? PIECE TEXT) (* ; - "If this isn't a text stream, build a piece table with the one piece in it.") - (COND - ((EQ (fetch (PIECE PLEN) of TEXT) - 0) (* ; - "I hate piece whose length is zero.") - (SETQ PCTB (\MAKEPCTB (SETQ TEXT NIL))) (* INSERT-BRT (CREATEPCNODE 1 - (QUOTE LASTPIECE)) PCTB) - ) - (T (SETQ PCTB (\MAKEPCTB TEXT)) (* INSERT-BRT (CREATEPCNODE - (ADD1 (fetch (PIECE PLEN) of TEXT)) - (QUOTE LASTPIECE)) PCTB) - (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) - of TEXT) - TEXTOBJ)) - (* ; - "And note the CHARLOOKS and PARALOOKS of this text--as well as filling them in.") - (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE - PPARALOOKS - ) - of TEXT) - TEXTOBJ] - (CLEARGET? - - (* ;; "If the user wants an uninterpreted stream onto the file , build a piece table with the one piece in it.") - - (SETQ TEXT (create PIECE - PFILE _ TEXT - PFPOS _ (COND - (START START) - (T 0)) - PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - (COND - (START START) - (T 0))) - PREVPIECE _ NIL - PLOOKS _ DEFAULTLOOKS - PPARALAST _ NIL - PPARALOOKS _ DEFAULTPARALOOKS)) - (* ; - "A single piece to describe the whole file") - (SETQ PCTB (\MAKEPCTB TEXT)) - (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) - of TEXT) - TEXTOBJ)) - (* ; - "And note the CHARLOOKS and PARALOOKS for later saving. Keep those caches consistent.") - (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE - PPARALOOKS - ) - of TEXT) - TEXTOBJ)) - (* INSERT-BRT (CREATEPCNODE - (ADD1 (fetch (PIECE PLEN) of TEXT)) - (QUOTE LASTPIECE)) PCTB) - ) - [(NOT PCCOUNT) (* ; "This is an unformatted file") - (COND - [(SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS - when (SETQ USERTEMP (APPLY* (CAR FILETYPE) - TEXT)) - do (RETURN FILETYPE))) - (* ; - "The input file is in a user-sensible format, which he is willing to convert for TEdit's use.") - (* ; "See if there are Bravo headers") - (SETQ PCTB (\TEDIT.CONVERT.FOREIGN.FORMAT (CADR USERFILEFORMAT) - TEXT USERTEMP TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS)) - (* ; - "Convert the foreign format file, and grab its PCTB") - (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] - do (* ; - "Run thru the converted pieces, noting their CHARLOOKS and PARALOOKS for the get/put caches.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) - of PC) - TEXTOBJ)) - (replace (PIECE PPARALOOKS) of PC - with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (PIECE PPARALOOKS) - of PC) - TEXTOBJ)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC] - (T (* ; - "Nope--it's straight unformatted text") - [SETQ PCTB (\MAKEPCTB (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - CURFILECH#) - PREVPIECE _ NIL - PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS - TEXTOBJ) - PPARALAST _ NIL - PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS - DEFAULTPARALOOKS TEXTOBJ] - (* ; - "So create a single piece to describe its contents") - (* INSERT-BRT (CREATEPCNODE - (ADD1 (IDIFFERENCE - (OR END (GETEOFPTR TEXT)) CURFILECH#)) - (QUOTE LASTPIECE)) PCTB) - (* ; "Insert LASTPIECE here") - ] - [(LISTP PCCOUNT) (* ; - "This is an obsolete version of the TEdit file format.") - (SELECTQ (CAR PCCOUNT) - (0 (* ; "VERSION 0") - (SETQ PCTB (TEDIT.BUILD.PCTB0 TEXT TEXTOBJ (CDR PCCOUNT) - START END))) - (1 (* ; - "Version 1; obsoleted at INTERMEZZO release 2/85") - (SETQ PCTB (TEDIT.BUILD.PCTB1 TEXT TEXTOBJ (CDR PCCOUNT) - START END))) - (2 (* ; "Version 2; obsoleted 5/22/85") - (SETQ PCTB (TEDIT.BUILD.PCTB2 TEXT TEXTOBJ (CDR PCCOUNT) - START END))) - (SHOULDNT "File format version incompatible with this version of TEdit.")) - (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] - do (* ; - "Run thru the converted pieces, noting CHARLOOKS and PARALOOKS for the caches.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) - of PC) - TEXTOBJ)) - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE - PPARALOOKS - ) - of PC) - TEXTOBJ)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC] - (T (* ; - "This IS a TEdit-format file, so read in all the parts.") - (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) - (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT - as PCN from 1 - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - [SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ - with (TEDIT.GET.PAGEFRAMES TEXT))) - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorCHARLOOKSLIST (* ; - "This is the list of CHARLOOKSs used in this document.") - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ - with (\TEDIT.GET.CHARLOOKS.LIST TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ - TXTCHARLOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ - - TXTCHARLOOKSLIST - ) - of TEXTOBJ) - do (SETA LOOKSHASH I LOOKS)) - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARALOOKSLIST (* ; - "This is the list of PARALOOKSs used in this document.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ - with (\TEDIT.GET.PARALOOKS.LIST TEXT TEXTOBJ)) - (* ; - "Read the list of looks used in this document.") - [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST - ) of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ - - TXTPARALOOKSLIST - ) - of TEXTOBJ) - do (SETA PARAHASH I LOOKS)) - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with - T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) - (* ; - "Get the new set of looks, for use by later pieces.") - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ - with T)) - (* ; - "Mark the document as containing paragraph formatting info") - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (* ; "Build the new piece") - (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) - (* ; - "Read the character looks for this guy.") - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with - PC))) - (add CURFILECH# PCLEN) (* ; - "And note the passing of characters.") - ) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with - PC))) - (TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) - (* ; - "There are new character looks for this object. Read them in.") - (replace (PIECE PLOOKS) of PC with ( - \TEDIT.GET.SINGLE.CHARLOOKS - TEXT))) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC - with (OR (AND OLDPC (fetch (PIECE PLOOKS) - of OLDPC)) - DEFAULTLOOKS] - (replace (PIECE PLEN) of PC with 1) - (* ; - "OBJECTs are officially one character long.") - ) - (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." - T) - (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) - (\SMALLPIN TEXT] - (COND - (PC (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) - (* ; - "If we created a piece, save it in the table.") - (add CURCH# (fetch (PIECE PLEN) of PC)) - (SETQ OLDPC PC))) finally - - (* ;; "(\\editseta pctb pcn curch#)") - - (* ;; - " (\\editseta pctb (add1 pcn) 'lastpiece)") - - (* ;; - "(\\editseta pctb |\\PCTBLastPieceOffset| (add1 pcn)) ") - - (* ;; - "(\\editseta pctb |\\PCTBFreePieces| 0)") - (* INSERT-BRT (CREATEPCNODE CURCH# - (QUOTE LASTPIECE)) PCTB) - ] - (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEXTOBJ)) (* ; - "And make sure that the default and caret looks are reflected in that list.") - (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ)) - (AND DEFAULTLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ)) - (* ; - "And the default looks we used in this function...") - (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) - TEXTOBJ) (* ; - "And make sure the default paralooks are reflected in that list.") - [AND TEXT (bind (CHARLOOKSLIST _ (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) - (PARALOOKSLIST _ (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - for (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) by (fetch (PIECE NEXTPIECE) of PC) - while [AND PC (NOT (EQ PC 'LASTPIECE] - do (* ; - "Look at every piece, and assure that its CHARLOOKS and PARALOOKS are in the cache.") - [COND - ((FMEMB (fetch (PIECE PLOOKS) of PC) - CHARLOOKSLIST) (* ; - "This piece's CHARLOOKS are known in the cache already. Don't bother doing anything else.") - ) - (T (* ; - "Nope; add these looks to the cache") - (replace (PIECE PLOOKS) of PC - with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE PLOOKS) - of PC) - TEXTOBJ] - (COND - ((FMEMB (fetch (PIECE PPARALOOKS) of PC) - PARALOOKSLIST) (* ; - "This piece's PARALOOKS are known in the cache already. Don't bother doing anything else.") - ) - (T (* ; - "Nope; add these looks to the cache") - (replace (PIECE PPARALOOKS) of PC - with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (PIECE - PPARALOOKS - ) - of PC) - TEXTOBJ] - (RETURN PCTB]) - -(\TEDIT.CONVERT.FOREIGN.FORMAT - [LAMBDA (CONVERSIONFN FILE PREDICATERESULT TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 12-Jun-90 18:16 by mitani") - - (* Perform the conversion from a foreign file format into TEdit-internal form - as an open TextStream.) - - (PROG (TSTREAM TTEXTOBJ SEL WORKINGSTREAM) (* See if there are Bravo headers) - (SETQ WORKINGSTREAM (OPENTEXTSTREAM "")) - (RESETLST - (RESETSAVE (\TEDIT.SET.WINDOW (CONS (TEXTOBJ WORKINGSTREAM) - NIL))) - (SETQ TSTREAM (APPLY* CONVERSIONFN FILE PREDICATERESULT WORKINGSTREAM))) - (COND - (TEXTOBJ - - (* If we're filling in an existing TEXTOBJ, there are fields that need to be - copied.) - - [OR (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ - with (fetch (TEXTOBJ TXTPAGEFRAMES) of (TEXTOBJ TSTREAM] - (* Such as the page formatting, - which the converter may well set.) - )) - (RETURN (fetch (TEXTOBJ PCTB) of (TEXTOBJ TSTREAM]) - -(TEDIT.FORMATTEDFILEP - [LAMBDA (STREAM) (* ; "Edited 19-Apr-93 11:57 by jds") - (* ; - "Test to see if this stream's text would need a TEdit-format file (T) or is just plain text (NIL)") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - (FONTFILE 0) - OLDPARALOOKS PC OLDLOOKS PREVPC TENTATIVE) - (SETQ OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) - (SETQ TENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) - (* ; "If edits are to be shown") - (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - 0)) (* ; "First piece in the document") - (COND - ((ATOM PC) (* ; "Empty document") - (RETURN NIL))) - (SETQ OLDLOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEDIT.DEFAULT.CHARLOOKS)) - (while PC do [COND - ((fetch (PIECE POBJ) of PC) - (* ; - "OBJECTS require the special format") - (SETQ FONTFILE 4)) - ([AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; "We just hit a paragraph break.") - (SETQ FONTFILE (IMAX FONTFILE 3))) - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of - PC))) - (AND TENTATIVE (OR (AND PREVPC (NEQ (fetch (PIECE PNEW) - of PREVPC) - (fetch (PIECE PNEW) - of PC))) - (AND (NOT PREVPC) - (fetch (PIECE PNEW) of PC)) - (AND PREVPC (NEQ (fetch (PIECE PFATP) - of PREVPC) - (fetch (PIECE PFATP) - of PC] - (* ; "Change in font, size, etc.") - (SETQ FONTFILE (IMAX FONTFILE 2))) - ((fetch (PIECE PFATP) of PC) - (* ; "NS Chars in the piece.") - (SETQ FONTFILE (IMAX FONTFILE 1] - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (RETURN (SELECTQ FONTFILE - (0 NIL) - (1 'NSCHARS) - (2 'CHARLOOKS) - (3 'PARALOOKS) - (4 'IMAGEOBJ) - NIL]) - -(TEDIT.GET - [LAMBDA (TEXTOBJ FILE UNFORMATTED?) (* ; "Edited 19-May-2001 11:43 by rmk:") - (* ; "Edited 19-Apr-93 13:12 by jds") - - (* ;; "Get a new file (overwriting the one being edited.)") - - (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) - OFILE OCURSOR LINES USER.CMFILE RESP TITLE FILENAME MENUSTREAM (GETFN (TEXTPROP - TEXTOBJ - 'GETFN)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (TEDIT.GET.FINISHEDFORMS NIL)) - (COND - ([AND (fetch (TEXTOBJ \DIRTY) of TEXTOBJ) - (PROGN (AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) - (FRESHLINE (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) - (NOT (MOUSECONFIRM "Not saved yet; LEFT go Get anyway." T - (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] - - (* ;; "Only do the GET if he knows he'll zorch himself.") - - (RETURN))) - [SETQ OFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to GET: " - (OR (TEXTPROP TEXTOBJ 'LASTGETFILENAME) - (\TEXTSTREAM.FILENAME TEXTOBJ] - (TEXTPROP TEXTOBJ 'LASTGETFILENAME OFILE) - (COND - [(AND OFILE (OR (OPENP OFILE) - (INFILEP OFILE))) (* ; - "Only if there's a file to load and the file exists.") - (COND - ((AND GETFN (EQ (APPLY* GETFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (FULLNAME OFILE) - 'BEFORE) - 'DON'T)) (* ; - "He doesn't want this document put. Bail out.") - (RETURN))) - (TEXTPROP TEXTOBJ 'LASTGETFILENAME NIL) - (RESETLST - (RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ (fetch (TEXTOBJ PROMPTWINDOW) - of TEXTOBJ) - 'DON'T) - (fetch (TEXTOBJ PROMPTWINDOW) - of TEXTOBJ)) - PROMPTWINDOW))) - (RESETSAVE (CURSOR WAITINGCURSOR)) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) - (\TEXTCLOSEF (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (* ; "CLOSE the old files") - [OR (AND (STREAMP FILE) - (OPENP FILE)) - (SETQ OFILE (OPENSTREAM OFILE 'INPUT NIL '((TYPE TEXT] - (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (* ; - "Remove the previous hardcopyfile") - (WINDOWPROP WINDOW 'HARDCOPYFILE NIL)) - - (* ;; "Open the new one.") - - (SETQ PCTB (replace (TEXTOBJ PCTB) of TEXTOBJ - with (TEDIT.BUILD.PCTB OFILE TEXTOBJ NIL NIL - (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) - UNFORMATTED?))) - (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)) - (* ; - "Do any necessary cleanup for outside packages") - (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL) - (for FIRSTLINE inside LINES do (replace (LINEDESCRIPTOR NEXTLINE) - of FIRSTLINE with NIL)) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - - (* ;; "The old cached piece is no longer valid--keep people from stepping on it, to prevent lost type-in and smashing other docuemnts to which it has been moved...") - - (* ;; "(replace TEXTLEN of TEXTOBJ with (SUB1 (\EDITELT PCTB (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)))))") - - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (fetch (BTREENODE TOTLEN - ) - of PCTB)) - (replace (SELECTION CH#) of SEL with (replace (SELECTION CHLIM) - of SEL with 1)) - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (SELECTION SET) of SEL with T) - (replace (SELECTION SET) of (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - with NIL) - (replace (SELECTION SET) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - with NIL) - (replace (SELECTION SET) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - with NIL) - (replace (SELECTION SET) of TEDIT.SELECTION with NIL) - (replace (SELECTION SET) of TEDIT.SHIFTEDSELECTION with NIL) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with ( - \TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) - (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - as LINE inside LINES do (* ; - "Fill the edit window (s) with the new text") - (\FILLWINDOW (fetch (LINEDESCRIPTOR - YBOT) of LINE) - LINE TEXTOBJ NIL WINDOW)) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T) - (SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* ; "find and set the title") - (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL)) - (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) - (COND - ((AND MENUSTREAM (type? LITATOM TITLE)) - (* ; - "if we have a filename then put it in the GET and PUT fields of the menu") - (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE)) - (MBUTTON.SET.FIELD MENUSTREAM 'Get FILENAME) - (MBUTTON.SET.FIELD MENUSTREAM 'Put FILENAME))) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ (\TEDIT.PRIMARYW TEXTOBJ)) - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Get))) - (AND GETFN (APPLY* GETFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (FULLNAME (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - 'AFTER] - (OFILE (TEDIT.PROMPTPRINT TEXTOBJ "[File not found.]") - (TEXTPROP TEXTOBJ 'LASTGETFILENAME OFILE)(* ; - "Remember the file name he tried for, so we offer it next time.") - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "[Get aborted.]" T]) - -(TEDIT.PARSE.PAGEFRAMES1 - [LAMBDA (PAGELIST PARENT) (* ; "Edited 2-Jan-87 12:21 by jds") - (* Take an external pageframe and - internalize it.) - (PROG (FRAMETYPE PAGEFRAME) - (COND - ((type? PAGEREGION PAGELIST) - (RETURN PAGELIST)) - ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) - [SETQ PAGEFRAME (create PAGEREGION - REGIONFILLMETHOD _ FRAMETYPE - REGIONTYPE _ (pop PAGELIST) - REGIONLOCALINFO _ (pop PAGELIST) - REGIONSPEC _ (for VAL - in (OR (pop PAGELIST) - (LIST 0 0 0 0)) - collect (\TEDIT.SCALE VAL - (CONSTANT (FQUOTIENT 1 35.27778] - (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) - collect (TEDIT.PARSE.PAGEFRAMES1 ALIST - PAGEFRAME))) - (RETURN PAGEFRAME)) - (T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC - NIL]) - -(\ARBIN - [LAMBDA (STREAM) (* jds "13-Nov-86 20:21") - (* ; - "Read an arbitrary object from a file, parse it, and return it.") - - (PROG ((LEN (\SMALLPIN STREAM)) - USERSTR) - (COND - ((NOT (ZEROP LEN)) - (SETQ USERSTR (OPENSTRINGSTREAM (\STRINGIN STREAM LEN) - 'INPUT)) - (RETURN (PROG1 (READ USERSTR *TEDIT-FILE-READTABLE*) - (CLOSEF? USERSTR]) - -(\ATMIN - [LAMBDA (STREAM) (* jds " 3-Apr-84 10:41") - (PROG ((LEN (\SMALLPIN STREAM))) - (RETURN (COND - ((ZEROP LEN) - NIL) - (T (PACK (for I from 1 to LEN collect (CHARACTER (\BIN STREAM]) - -(\DWIN - [LAMBDA (FILE) (* jds " 3-JAN-83 16:08") - (IPLUS (LLSH (\BIN FILE) - 24) - (LLSH (\BIN FILE) - 16) - (LLSH (\BIN FILE) - 8) - (\BIN FILE]) - -(\STRINGIN - [LAMBDA (STREAM SETLEN) (* ; "Edited 20-Apr-88 19:54 by jds") - (* Read a string in length-contents form%: One word for the length, and one - byte per character contained. However, the length may be specified by the - caller instead of being read from the file.) - (PROG ((LEN (OR SETLEN (\SMALLPIN STREAM))) - STR) - (SETQ STR (ALLOCSTRING LEN)) - [OR (ZEROP LEN) - (for I from 1 to LEN do (RPLCHARCODE STR I (READCCODE STREAM] - (RETURN STR]) - -(\TEDIT.FORMATTEDP1 - [LAMBDA (FILE LEN) (* ; "Edited 12-Feb-88 11:43 by jds") - (* ; - "Checks for a version-1 formatted file") - - (* ;; "Returns NIL if it isn't a formatted file, or the # of pieces needed if it is; leaves file at start of text or of piece descriptions, resp.") - - (SETQ LEN (OR LEN (GETEOFPTR FILE))) - (PROG (DESCPTR NPIECES PASSWORD) - (COND - ((ILEQ LEN 8) (* ; "Too short to be formatted.") - - (RETURN NIL)) - (T (SETFILEPTR FILE (IDIFFERENCE LEN 8)) (* ; - "Move to start of FILEPTR to descriptions") - - (SETQ DESCPTR (\DWIN FILE)) (* ; - "Read the file pos of the descriptions") - - (SETQ NPIECES (\SMALLPIN FILE)) - (SETQ PASSWORD (\SMALLPIN FILE)) - (COND - ((IEQP PASSWORD 31418) (* ; - "Version 3 TEdit format; instituted on 5/22/85") - - (SETFILEPTR FILE DESCPTR) - (RETURN NPIECES)) - ((IEQP PASSWORD 31417) - - (* ;; "Version 2 format. Obsoleted 5/22/85 to permit revision of looks in the future without loss of compatibility") - - (SETFILEPTR FILE DESCPTR) - (RETURN (CONS 2 NPIECES))) - ((IEQP PASSWORD 31416) (* ; "VERSION 1 TEDIT FORMAT") - - (SETFILEPTR FILE DESCPTR) - (RETURN (CONS 1 NPIECES))) - ((IEQP PASSWORD 31415) (* ; "VERSION 0 TEDIT FORMAT") - - (SETFILEPTR FILE DESCPTR) - (RETURN (CONS 0 NPIECES))) - (T (* ; "NOT A FORMATTED FILE") - - (SETFILEPTR FILE 0) - (RETURN NIL]) - -(\TEDIT.SET.WINDOW - [LAMBDA (TOWIND) (* ; "Edited 12-Jun-90 18:16 by mitani") - (* USED IN RESETSAVES TO NULL OUT A - TEXTSTREAM'S WINDOW BRIEFLY.) - (PROG1 (CONS (CAR TOWIND) - (fetch (TEXTOBJ \WINDOW) of (CAR TOWIND))) - (replace (TEXTOBJ \WINDOW) of (CAR TOWIND) with (CDR TOWIND)))]) - -(TEDIT.GET.PASSWORD - [LAMBDA (FILE LEN) (* ; "Edited 20-Jun-2022 12:04 by rmk") - - (* ;; "Returns the TEDIT password of FILE, if it is a TEDIT formatted file") - - (LET (DESCPTR NPIECES PASSWORD) - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (CL:UNLESS LEN - (SETQ LEN (GETEOFPTR STREAM))) - (CL:WHEN (IGREATERP LEN 8) - (SETFILEPTR STREAM (IDIFFERENCE LEN 8)) (* ; - "Move to start of FILEPTR to descriptions") - (SETQ DESCPTR (\DWIN STREAM)) (* ; - "Read the file pos of the descriptions") - (SETQ NPIECES (\SMALLPIN STREAM)) - [CAR (MEMB (\SMALLPIN STREAM) - '(31415 31416 31417 31418 31419])]) -) - - - -(* ;; "INCLUDEing a file") - -(DEFINEQ - -(TEDIT.INCLUDE - [LAMBDA (STREAM FILE START END SAFE) (* ; "Edited 19-May-2001 11:43 by rmk:") - (* ; - "Edited 1-Jun-93 11:31 by sybalsky:mv:envos") - - (* ;; "Obtain a file name, and include that file's contents at the place where the caret is.") - - (* ;; "Returns T if the insertion happened, NIL if there was no place to put it.") - - (SETQ STREAM (TEXTOBJ STREAM)) - (PROG ((SEL (fetch (TEXTOBJ SEL) of STREAM)) - PCTB TEXTLEN NFILE NNFILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN PCCOUNT NSTREAM - START-OF-PIECE) - (DECLARE (SPECVARS START-OF-PIECE)) - (COND - ((fetch (TEXTOBJ TXTREADONLY) of STREAM)(* ; "This is read-only.") - ) - ((fetch (SELECTION SET) of SEL) (* ; - "There is a place to do the include.") - [SETQ NFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT STREAM - "Name of the file to load: "] - (COND - ((NOT NFILE) (* ; - "If no file was given, don't bother INCLUDEing.") - (TEDIT.PROMPTPRINT STREAM "[Include aborted.]" T) - (RETURN)) - ((STREAMP NFILE)) - ((NOT (INFILEP NFILE)) (* ; - "Can't find the file. Put out a message.") - (TEDIT.PROMPTPRINT STREAM "[File not found.]") - (RETURN))) - (COND - ((NOT SAFE) - - (* ;; "If the caller sets SAFE, we don't need to do any of this copying, because he's guaranteeing that the files'll be there until we don't need 'em any more.") - - [SETQ NFILE (COND - ((OPENP NFILE) - (SETQ WASOPEN T) - NFILE) - (T (* ; - "Wasn't open -- need to open it for input...") - (OPENSTREAM NFILE 'INPUT NIL '((TYPE TEXT] - - (* ;; "Create the holding file") - - (SETQ NNFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT 'NEW)) - - (* ;; "And copy the file-section into it.") - - (* ;; "Have to explicitly fill in 0 and EOFPTR, because if the file was open already, NILs would only copy from current fileptr to EOF.") - - (* ;; - "Use COPYBYTES for formatted files, otherwise allow natural EOL conversion to take place") - - [IF (\TEDIT.FORMATTEDP1 NFILE) - THEN [COPYBYTES NFILE NNFILE (OR START 0) - (OR END (GETFILEINFO NFILE 'LENGTH] - ELSE (COPYCHARS NFILE NNFILE (OR START 0) - (OR END (GETFILEINFO NFILE 'LENGTH] - (OR WASOPEN (CLOSEF NFILE)) (* ; - "If the file didn't come to us open, close it.") - (CLOSEF NNFILE) - (SETQ NFILE NNFILE) - (SETQ START (SETQ END NIL)) (* ; "Then pretend nothing happened.") - )) - (TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* ; "Delete any text, if need be") - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of STREAM)) - (* ; - "We need the POST-deletion text length for later, so this must come after the b-p-d.") - (\SHOWSEL SEL NIL NIL) (* ; - "Turn off SELs before we go any further") - [SETQ NFILE (TEXTOBJ (SETQ NSTREAM (OPENTEXTSTREAM (OPENSTREAM NFILE 'INPUT) - NIL NIL NIL (LIST 'FONT ( - \TEDIT.GET.INSERT.CHARLOOKS - STREAM SEL) - 'PARALOOKS - (fetch (TEXTOBJ FMTSPEC - ) - of STREAM] - - (* ;; "Get a textobj to describe the include source file (need NSTREAM so that if we have to convert it to formatted, we won't have lost the textstream--and thus smash the free list.)") - - (COND - ((AND (fetch (TEXTOBJ FORMATTEDP) of NFILE) - (NOT (fetch (TEXTOBJ FORMATTEDP) of STREAM))) - (* ; - "If the includED text is formatted but this file isn't, let's format it!") - (\TEDIT.CONVERT.TO.FORMATTED STREAM)) - ((AND (fetch (TEXTOBJ FORMATTEDP) of STREAM) - (NOT (fetch (TEXTOBJ FORMATTEDP) of NFILE))) - - (* ;; "The TARGET document is formatted, but the INCLUDEd text isn't. Better format it before completing the include.") - - (\TEDIT.CONVERT.TO.FORMATTED NFILE))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of STREAM)) - (* ; - "HERE, because the conversion to formatted will lengthen the pctb") - [SETQ INSERTCH# (COND - ((EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) - (fetch (SELECTION CH#) of SEL)) - (T (fetch (SELECTION CHLIM) of SEL] - (* ; - "Find the place to make the insertion.") - (SETQ INSPC (\CHTOPC INSERTCH# PCTB T)) (* ; - "The piece to make the insertion in") - [COND - ((NEQ INSPC 'LASTPIECE) - (COND - ((IGREATERP INSERTCH# START-OF-PIECE) (* ; "Must split the piece.") - (SETQ INSPC (\SPLITPIECE INSPC INSERTCH# STREAM INSPC#)) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of STREAM)) - (* ; - "Refresh the PCTB in case it grew.") - ] - (SETQ PCLST (fetch (TEXTOBJ PCTB) of NFILE)) - (* ; - "A temporary pctb, holding the pieces which describe the INCLUDEd text") - (SETQ LEN (fetch (BTREENODE TOTLEN) of PCLST)) - (\TEDIT.INSERT.PIECES STREAM INSERTCH# (SETQ PCLST (\GETBASEPTR (\FIRSTNODE PCLST) - 0)) - LEN INSPC INSPC# NIL) - [COND - ((AND (fetch (TEXTOBJ FORMATTEDP) of STREAM) - (NOT (fetch (TEXTOBJ FORMATTEDP) of NFILE))) - (* ; - "If the includED text is formatted but this file isn't, let's format it!") - (\TEDIT.CONVERT.TO.FORMATTED STREAM INSERTCH# (IPLUS INSERTCH# LEN] - (\TEDIT.HISTORYADD STREAM (create TEDITHISTORYEVENT - THACTION _ 'Include - THCH# _ INSERTCH# - THLEN _ LEN - THFIRSTPIECE _ PCLST)) - (* ; - "Remember that we did this, so it can be undone.") - (replace (TEXTOBJ TEXTLEN) of STREAM with (IPLUS TEXTLEN LEN)) - (* ; - "Inserting the pieces didn't fix up things like the length of the document, so do it now.") - (AND (fetch (TEXTOBJ \WINDOW) of STREAM) - (\FIXILINES STREAM SEL INSERTCH# LEN TEXTLEN)) - (* ; "Mark any changed lines dirty.") - (replace (SELECTION CHLIM) of SEL with (IPLUS (replace (SELECTION - CH#) - of SEL with - INSERTCH# - ) - LEN)) - (* ; - "Now fix up the selection to be the included text, point_left, character selection grain.") - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'RIGHT) - (* ; - "So that several things INCLUDED in sequence fall in sequence.") - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (replace (SELECTION SELOBJ) of SEL with NIL) - (COND - ((fetch (TEXTOBJ \WINDOW) of STREAM)(* ; - "We're displaying; update the display and the selection's line references") - (TEDIT.UPDATE.SCREEN STREAM) - (\FIXSEL SEL STREAM) - (\SHOWSEL SEL NIL T))) - (replace (TEXTOBJ \DIRTY) of STREAM with T) - (* ; "Mark the document changed") - (\SETUPGETCH (IPLUS -1 INSERTCH# LEN) - STREAM) (* ; - "Set the fileptr to the end of the insertion.") - T) - (T (TEDIT.PROMPTPRINT STREAM "Please choose the place for the INCLUDE first." T]) - -(TEDIT.RAW.INCLUDE - [LAMBDA (STREAM INFILE START END) (* ; "Edited 11-Jun-99 15:05 by rmk:") - (* ; "Edited 11-Jun-99 15:05 by rmk:") - (* ; "Edited 11-Jun-99 14:49 by rmk:") - (* ; "Edited 11-Jun-99 14:41 by rmk:") - (* ; - "Edited 27-May-93 16:36 by sybalsky:mv:envos") - - (* ;; "takes a text stream and an OPEN stream to include. Note: Start and End are inclusive ptrs, unlike in copybytes and friends") - - (* ;; - "no interpretation (alternate file type e.g. Bravo) takes place. Simply include the characters") - - (* ;; "Default character and paragraph looks are applied") - - (LET* ((TEXTOBJ (TEXTOBJ STREAM)) - (START START) - (END END) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - [HOLDING.FILE (OR (fetch (TEXTOBJ TXTRAWINCLUDESTREAM) of TEXTOBJ) - (replace (TEXTOBJ TXTRAWINCLUDESTREAM) of TEXTOBJ - with (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - PCTB TEXTLEN INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN HOLDSTART HOLDLEN START-OF-PIECE - ) - (COND - ((NOT (fetch (SELECTION SET) of SEL)) - (SHOULDNT "\TEDIT.RAW.INCLUDE called with no selection set")) - ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (* ; "Not allowed to change it.") - NIL) - (T (* ; - "There is a place to do the include.") - (\SHOWSEL SEL NIL NIL) (* ; - "Turn any pre-existing selection off") - (COND - (END - (* ;; "This is the copy-part-of-a-file case, with file liable to be volatile. Copy it to core for protection") - - [SETQ INFILE (COND - ((OPENP INFILE) - (SETQ WASOPEN T) - INFILE) - (T (OPENSTREAM INFILE 'INPUT NIL '((TYPE TEXT] - (* ; - "And copy the file-section into it.") - (SETFILEPTR HOLDING.FILE (SETQ HOLDSTART (GETEOFPTR HOLDING.FILE))) - (* ; - "Move to the end of the pre-existing part of the file.") - (COPYBYTES INFILE HOLDING.FILE START END) - (* ; - "must be copychars to respect eol conventions") - (SETQ HOLDLEN (IDIFFERENCE (OR END (GETEOFPTR INFILE)) - START)) - (COND - ((NOT WASOPEN) (* ; - "Close the input file if it wasn't open when we got here.") - (CLOSEF INFILE))) - (SETQ INFILE HOLDING.FILE) - (SETQ START (SETQ END NIL)) (* ; "Then pretend nothing happened.") - )) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ INSERTCH# (TEDIT.GETPOINT NIL SEL)) (* ; - "Find the place to make the insertion.") - (SETQ INSPC (OR (\CHTOPC INSERTCH# PCTB T) - (LASTPIECE PCTB))) (* ; - "The piece to make the insertion in") - [COND - ((NEQ INSPC 'LASTPIECE) - (COND - ((IGREATERP INSERTCH# START-OF-PIECE) (* ; "Must split the piece.") - (SETQ INSPC (\SPLITPIECE INSPC (- INSERTCH# START-OF-PIECE) - TEXTOBJ INSPC#)) - (add INSPC# 1) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (* ; - "Refresh the PCTB in case it grew.") - ] - (SETQ PCLST (create PIECE - PFILE _ INFILE - PFPOS _ (OR HOLDSTART START 0) - PLEN _ - [OR HOLDLEN (IDIFFERENCE - [COND - (END END) - (T (* ; "get the eof pointer") - (COND - ((OPENP INFILE) - (GETEOFPTR INFILE)) - (T [OPENSTREAM INFILE 'INPUT NIL - '((TYPE TEXT] - (PROG1 (GETEOFPTR INFILE) - (CLOSEF INFILE] - (COND - (START START) - (T 0] - PREVPIECE _ NIL - NEXTPIECE _ NIL - PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ) - PPARALAST _ NIL - PPARALOOKS _ (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)) - ) - (SETQ LEN (fetch (PIECE PLEN) of PCLST)) - (\TEDIT.INSERT.PIECES TEXTOBJ INSERTCH# PCLST LEN INSPC INSPC# NIL) - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS TEXTLEN LEN)) - (AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\FIXILINES TEXTOBJ SEL INSERTCH# LEN TEXTLEN)) - (replace (SELECTION CHLIM) of SEL with (IPLUS (replace (SELECTION - CH#) - of SEL with - INSERTCH#) - LEN)) - (* ; - "Now fix up the selection to be the included text, point_left, character selection grain.") - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'RIGHT) - (* ; - "So that several things INCLUDED in sequence fall in sequence.") - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (replace (SELECTION SELOBJ) of SEL with NIL) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) - (* ; "Mark the document changed") - (\SETUPGETCH (create EDITMARK - PC _ INSPC - PCOFF _ 0 - PCNO _ NIL) - TEXTOBJ) (* ; - "Set the fileptr to the end of the insertion.") - T]) -) - - - -(* ;; "PUTting a file:") - -(DEFINEQ - -(TEDIT.PUT - [LAMBDA (STREAM FILE FORCENEW UNFORMATTED? OLDFORMAT?) (* ; "Edited 21-Jun-99 19:02 by rmk:") - (* ; "Edited 21-Jun-99 18:58 by rmk:") - (* ; "Edited 11-Jun-99 15:05 by rmk:") - (* ; "Edited 19-Apr-93 13:04 by jds") - - (* ;; "If the guy was editing a file, make a new updated version; else, ask for a file name") - - (* ;; "If FILE is specd, it's used; else the user must give us one") - - (* ;; "Returns an open stream on the file you PUT to.") - - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - (TEDIT.PUT.FINISHEDFORMS NIL) - (TEDIT.GET.FINISHEDFORMS NIL) - (OUTPUT.FILE.WRITTEN NIL) - OCURSOR OFILE FONTFILEUSED PROPS WINDOW PUTFN CACHE MENUSTREAM FILENAME TITLE CH#S PC) - [COND - (FILE (* ; "We were given a file to use.") - (SETQ OFILE FILE)) - [FORCENEW (* ; - "He insists on a new file. (without giving us one NIL)") - (SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: "] - (T (* ; "Get a file to put the text into") - (SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: " - (\TEXTSTREAM.FILENAME TEXTOBJ] - (SETQ PUTFN (TEXTPROP TEXTOBJ 'PUTFN)) - (SETQ CACHE (TEXTPROP TEXTOBJ 'CACHE)) - (COND - ((NOT OFILE) (* ; - "There's no file to put to; don't bother.") - (RETURN)) - ((AND PUTFN (EQ (APPLY* PUTFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (FULLNAME OFILE) - 'BEFORE) - 'DON'T)) (* ; - "He doesn't want this document put. Bail out.") - (RETURN))) - (RESETLST - [RESETSAVE [SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW - (COND - [UNFORMATTED? (* ; - "If the user forced no formatting, respect his wish.") - '((TYPE TEXT] - [(TEDIT.FORMATTEDFILEP TEXTOBJ) - (* ; - "If this file has objects, para looks, or font changes, then we need a binary file.") - '((TYPE BINARY] - [(AND NIL (EQL (U-CASE (FILENAMEFIELD OFILE - 'EXTENSION)) - 'TEDIT)) - (* ; "If file extension is TEDIT, then we presume that it really is a tedit file, thus making it a binary file. BUT: rmk we really prefer TYPE TEXT even for a file with extension tedit.") - '((TYPE BINARY] - (T (* ; - "Otherwise, we can get by with a text file") - '((TYPE TEXT] - '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] - [RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS) - 'DON'T] - (replace DESC of (fetch (TEXTOBJ THISLINE) of TEXTOBJ) with NIL) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "PUTting file " (fetch (STREAM FULLNAME) - of OFILE) - "...") - T) - [COND - ((IGREATERP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - 0) - (SETQ FONTFILEUSED (COND - (OLDFORMAT? (TEDIT.PUT.PCTB2 TEXTOBJ OFILE UNFORMATTED?)) - (T (TEDIT.PUT.PCTB TEXTOBJ OFILE UNFORMATTED?] - (CLOSEF OFILE) (* ; - "Close the file, to free it up. And re-open it for INPUT only") - [COND - ((NOT CACHE) (* ; - "CSLI if caching do not need to reopen the output file anyway") - - (* ;; "Declare as type text, even if it hasn't been specified as a binary file--could simply be an unformatted stream.") - - (SETQ OFILE (OPENSTREAM (fetch (STREAM FULLFILENAME) of OFILE) - 'INPUT NIL '((TYPE TEXT](* ; - "changed TEMPORary for ns filing with caching. may not work in general") - (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (* ; "Close the old text file") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with OFILE) - (* ; - "And remember the new one for next time.") - (* ; - "We can safely QUIT now without losing anything.") - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL)) - (SETQ CH#S (REVERSE (CDR FONTFILEUSED))) (* ; - "The true filepos's of the pieces in the output file.") - [COND - ((AND (NOT CACHE) - (RANDACCESSP OFILE) - (EQ CR.EOLC (fetch (STREAM EOLCONVENTION) of OFILE))) - - (* ;; "If we've cached this file, DON'T go thru and fill in the real file's location, because the EOL convention may well be wrong.") - - (* ;; "(SETQ PC (ELT (fetch PCTB of TEXTOBJ) (ADD1 \FirstPieceOffset)))") - - (UNINTERRUPTABLY - (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - 0)) - (while (AND PC CH#S) do - - (* ;; - "Run thru the pieces in the PCTB, pointing them to the new file and their new locations.") - - (COND - ((fetch (PIECE POBJ) of PC)) - (T (replace (PIECE PFPOS) of PC - with (pop CH#S)) - (CLOSEF? (fetch (PIECE PFILE) of - PC)) - (* ; - "If this is a piece on an open file, close it, since we're never going to read from it again.") - (replace (PIECE PFILE) of PC - with OFILE) - (replace (PIECE PSTR) of PC - with NIL))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))))] - (TEDIT.PROMPTPRINT TEXTOBJ "done.") (* ; "Tell him we're finished.") - (SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* ; "find and set the title") - (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL)) - (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) - (COND - ((AND MENUSTREAM (type? LITATOM TITLE)) (* ; - "if we have a filename then put it in the GET and PUT fields of the menu") - (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE)) - (MBUTTON.SET.FIELD MENUSTREAM 'Get FILENAME) - (MBUTTON.SET.FIELD MENUSTREAM 'Put FILENAME))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; "Make sure any new insertions happen for real, and not as appends. Since all the pieces now point to the file rather than the strings.") - (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with NIL) - - (* ;; "make sure that TEDIT doesn't try to just add to the \INSERTPC since it will now have a pfile property") - - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Put - THCH# _ 0 - THLEN _ 0 - THFIRSTPIECE _ NIL)) - (* ; "Remember we did this.") - (AND PUTFN (APPLY* PUTFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ)) - 'AFTER)) (* ; - "CSLI changed to not presume ofile is the txtfile anymore") - (RETURN OFILE]) - -(TEDIT.PUT.PCTB - [LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 30-Apr-2021 14:46 by rmk:") - (* ; "Edited 19-May-99 21:58 by rmk:") - (* ; - "Edited 27-May-93 16:00 by sybalsky:mv:envos") - - (* ;; "Put a representation of the piece table onto OFILE, preserving font changes and paragraph looks. UNFORMATTED? means write no font or formatting info.") - - (PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (*READTABLE* *TEDIT-FILE-READTABLE*) - (*PRINT-BASE* 10) - OLDCH# CURCH# PREVPC FONTFILE (PCCOUNT 0) - TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL) - (EDITSTENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) - (PARALOOKSSEEN NIL) - (FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ)) - (CACHE (TEXTPROP TEXTOBJ 'CACHE)) - CH#S PREVFATP PARAHASH LOOKSHASH PREVPREVPC) - (replace (STREAM LINELENGTH) of OFILE with MAX.SMALLP) - (* ; - "Prevent spurious carriage-returns in the piece descriptions.") - - (* ;; "(SETQ PC (\EDITELT (fetch PCTB of TEXTOBJ) (ADD1 \FirstPieceOffset)))") - - (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - 0)) (* ; "First piece in the document") - (SETQ OLDLOOKS (OR (AND (type? PIECE PC) - (fetch (PIECE PLOOKS) of PC)) - (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks") - - (* ;; "RMK: CHANGED DEFAULT FROM CR TO LF") - - (COND - ((NEQ (fetch (STREAM EOLCONVENTION) of OFILE) - LF.EOLC) (* ; - "This file is on a non-LF host; make a note to cache it") - (SETQ TRUEFILE OFILE) (* ; - "Remember where the file should wind up.") - [SETQ OFILE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; - "And open a temp file to write it to.") - (replace (STREAM LINELENGTH) of OFILE with MAX.SMALLP) - (* ; - "Prevent spurious carriage-returns in the piece descriptions.") - )) - [SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE] - (COND - ((fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) - (* ; - "There is layout info for this file. Save it") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (TEDIT.PUT.PAGEFRAMES FONTFILE (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ)) - (add PCCOUNT 1))) - (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* ; - "Run thru the lists of char & para looks and remove any that aren't in use") - (COND - ([AND (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - (OR (IGREATERP (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - 1) - (NOT (EQFMTSPEC (CAR (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - TEDIT.DEFAULT.FMTSPEC] - - (* ;; "There are paragraph looks in this document that don't match the default -- save the list of them for later retrieval.") - - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST FONTFILE (fetch (TEXTOBJ - TXTPARALOOKSLIST - ) of - TEXTOBJ))) - (SETQ PARALOOKSSEEN T))) - [COND - ((OR PARALOOKSSEEN FORMATTINGLEVEL) - - (* ;; "There are character looks in this document that don't match the default (or paragraph formatting, which forces looks to be saved) -- save the list for later retrieval.") - - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE (fetch (TEXTOBJ - TXTCHARLOOKSLIST - ) - of TEXTOBJ] - [while PC - do (COND - ([AND (NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) - of PC) - (fetch (TEXTOBJ FMTSPEC) of - TEXTOBJ - ] - (* ; - "The last piece ended a paragraph, so send out new para looks") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (COND - ((NEQ CURCH# OLDCH#) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) - (\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH) - (SETQ PARALOOKSSEEN T) (* ; - "Remember that we've seen a foreign paralooks, and must henceforth note para boundaries") - (add PCCOUNT 1))) - (COND - [(fetch (PIECE POBJ) of PC) (* ; - "It's an object -- go use its PUTFN") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (COND - ((AND (NEQ CURCH# OLDCH#) - PREVPC) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) (* ; - "If the prior thing was text, send along its descriptor.") - (* ; "Send out the object") - (IF UNFORMATTED? - THEN (CL:WHEN (AND PREVPC (fetch (PIECE PFATP) of PREVPC)) - - (* ;; "Last piece was FAT, but object doesn't know that. Start it out thin. The stream must also be thin after the PRIN1 of the object's preprint string. Setting PREVPC to NIL means that no comparisons will be done (which asserts THIN among other things), but that's OK because we aren't doing formatting anyway.") - - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 2) - (SETQ PREVPC NIL)) - (LET [(FN (IMAGEOBJPROP (fetch (PIECE POBJ) of PC) - 'PREPRINTFN] - (PRIN1 (IF FN - THEN (PROG1 (APPLY* FN (fetch (PIECE POBJ) - of PC)) - - (* ;; "Insure thin") - - (CHARSET OFILE 0)) - ELSE "[UNPRINTABLE OBJECT]") - OFILE) - (add CURCH# 1 (IDIFFERENCE (GETEOFPTR OFILE) - CURCH#))) - ELSE (add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#))) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) - (COND - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (NEQ (fetch (PIECE PFATP) of PC) - (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) - (AND PREVPC (fetch (PIECE PNEW) - of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; - "The OBJECT has different ooks from before") - (\BOUT FONTFILE 1) - (\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch (PIECE PLOOKS) - of PC)) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (T (* ; - "No differences. Don't write any charlooks, and mark that fact") - (\BOUT FONTFILE 0) (* ; - "MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS GETS ITS OWN LOOKS") - ] - ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (* ; "It's not an object.") - - (* ;; "For 0-length pieces, don't even acknowledge their existence!!") - - (* ;; "So only do this processing if there's text in the piece.") - - [COND - ([OR [NEQ (fetch (PIECE PFATP) of PC) - (SETQ PREVFATP (AND PREVPC (fetch (PIECE PFATP) of PREVPC - ] - (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) - (AND PREVPC (fetch (PIECE PNEW) - of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; "We have a piece with new looks.") - (* ; - "The PREVFATP clause needs to come first, so that PREVFATP gets set for later use.") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (COND - ((NOT (IEQP OLDCH# CURCH#)) (* ; - "If there were looks past, and if the run was not empty, save a piece for its looks") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1))) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC)) - (SETQ OLDCH# CURCH#) - (COND - [PREVFATP (COND - ((fetch (PIECE PFATP) of PC)) - (T (* ; "Switching from FAT to thin") - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 2] - ((fetch (PIECE PFATP) of PC) - (* ; "Switching from thin to fat") - (BOUT OFILE 255) - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 3] (* ; - "Now dump out the non-object contents of the piece.") - [COND - [(SETQ PFILE (fetch (PIECE PFILE) of PC)) - (* ; "It's on a file. Copy it.") - [OR (OPENP PFILE) - (replace (PIECE PFILE) of PC with (SETQ PFILE - (\TEDIT.REOPEN.STREAM - TEXTOBJ PFILE] - (* ; "Make sure the file is open.") - (COPYBYTES PFILE OFILE (fetch (PIECE PFPOS) of PC) - (IPLUS (fetch (PIECE PFPOS) of PC) - (COND - ((fetch (PIECE PFATP) of PC) - (* ; - "For fat file pieces, copy twice as many bytes as characters.") - (UNFOLD (fetch (PIECE PLEN) of PC) - 2)) - (T (fetch (PIECE PLEN) of PC] - ((SETQ PSTR (fetch (PIECE PSTR) of PC)) - (* ; - "It's in a string. Just print it.") - - (* ;; - "RMK: BOUT ptimizations would miss external formats and EOL conventions") - - (for I from 1 to (fetch (PIECE PLEN) of PC) - as CH instring PSTR do (\OUTCHAR OFILE CH)) - (* (COND ((fetch (PIECE PFATP) of PC) - (* ; - "The string is fat: Copy twice as many bytes as chars.") - (for I from 1 to (fetch - (PIECE PLEN) of PC) as CH instring - PSTR do (\BOUT OFILE - (\CHARSET CH)) (\BOUT OFILE - (\CHAR8CODE CH)))) - (T (* ; - "The string is thin. Just copy it to the file.") - (for I from 1 to (fetch - (PIECE PLEN) of PC) as CH instring - PSTR do (\BOUT OFILE CH))))) - ] - [COND - ((AND (NOT CACHE) - (RANDACCESSP OFILE)) (* ; -"CSLI leave the pieces and the pctb alone and just write the file if its cached or not randomaccess") - (push CH#S (SUB1 CURCH#] - [COND - ((fetch (PIECE PFATP) of PC) - (add CURCH# (UNFOLD (fetch (PIECE PLEN) of PC) - 2))) - (T (add CURCH# (fetch (PIECE PLEN) of PC] - (* ; - "Keep running track of where in the file we are.") - )) - (COND - ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) - - (* ;; "Only remember this piece if it's not zero-length!") - - (SETQ PREVPREVPC PREVPC) - (SETQ PREVPC PC))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally (* ; - "Put out a piece describing the last characters in the file.") - (COND - ((AND FONTFILE (NEQ OLDCH# CURCH#)) (* ; - "Only if there WERE characters, and only if there's a need for font information") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE - LOOKSHASH PREVPREVPC) (* ; - "Put out a description of the characters") - (add PCCOUNT 1))) - (COND - ((AND PARALOOKSSEEN (fetch (PIECE PPARALAST) of PREVPC)) - (* ; - "The last piece contained the end of a paragraph. Make sure it gets noted.") - (\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH) - - (* ;; "Write out a dummy paragraph-looks piece, so that we protect the PPARALAST of the final piece in the document.") - - (\DWOUT FONTFILE 0) - (\SMALLPOUT FONTFILE \PieceDescriptorPARA) - (\SMALLPOUT FONTFILE 1) - - (* ;; "This adds a total of 2 pieces to the file:") - - (add PCCOUNT 2] - (for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM)) - (* ; "Do any user-specific cleanup") - (COND - (TRUEFILE (* ; - "This file needs to be converted to the right convention") - (COND - ((AND FONTFILE (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) (* ; - "Formatted file: Copy without converting.") - (COPYBYTES OFILE TRUEFILE 0 -1)) - (T (* ; - "Go ahead and convert the EOLCONVENTION, this is a plain-text file") - (COPYCHARS OFILE TRUEFILE 0 -1))) - (SETQ OFILE TRUEFILE))) - [COND - ((AND (OPENP OFILE) - FONTFILE) (* ; "We need to write format info.") - (\DWOUT FONTFILE (GETFILEPTR OFILE)) (* ; - "So remember the end of the plain-text part of the file") - (\SMALLPOUT FONTFILE PCCOUNT) (* ; - "# OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE") - (\SMALLPOUT FONTFILE 31418) (* ; - "Now the password for NEW format files: 31416") - (COND - ((AND (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) - - (* ;; "Only write fmtg info at the end if we want it there--not if we want plain text or want it kept separate.") - - (COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE)) - (* ; - "Copy the font information to the file trailer") - ) - (T)) - (CLOSEF FONTFILE) - (COND - ((NOT SEPARATEFORMAT) (* ; - "Unless we want the formatting info separately, delete the file") - (* ; - "(since FONTFILE is a stream, we should not need to delete it at all) (DELFILE FONTFILE)") - ] - (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ) - TEXTOBJ)) - (* ; - "Re-add the default and caret looks's to the lists, since they may not have been really saved.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ CARETLOOKS) - of TEXTOBJ) - TEXTOBJ)) - (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ) - TEXTOBJ)) - (RETURN (CONS (COND - (UNFORMATTED? NIL) - (T FONTFILE)) - CH#S]) - -(\TEDIT.PUTRESET - [LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38") - (CONS (CAR PROC&VALUE) - (PROCESSPROP (CAR PROC&VALUE) - 'BEFOREEXIT - (CDR PROC&VALUE]) - -(TEDIT.PUT.PIECE.DESCRIPTOR - [LAMBDA (FILE CH1 CHLIM LOOKS) (* ; "Edited 30-May-91 20:25 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (* (PROG ((FONT (fetch - (CHARLOOKS CLFONT) of LOOKS)) STR) - (SETQ STR (CONCAT "(FONTCREATE " - (KWOTE (FONTPROP FONT - (QUOTE FAMILY))) " " - (FONTPROP FONT (QUOTE SIZE)) " " - (KWOTE (FONTPROP FONT - (QUOTE FACE))) " )")) - (\DWOUT FILE (IDIFFERENCE CHLIM CH1)) - (* The length of this run of looks) - (\SMALLPOUT FILE (NCHARS STR)) - (* The length of the description - which follows) (PRIN1 STR FILE) - (* Print the form which can EVAL to - re-create the font information) - (\BOUT FILE (LOGOR - (COND ((fetch (CHARLOOKS CLPROTECTED) - of LOOKS) 8) (T 0)) (COND ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) NIL 4) (T 0)) - (COND ((fetch (CHARLOOKS CLSELHERE) - of LOOKS) 2) (T 0)) - (COND ((fetch (CHARLOOKS CLCANCOPY) - of LOOKS) 1) (T 0)))))) - (HELP]) - -(\ARBOUT - [LAMBDA (STREAM ITEM) (* ; "Edited 20-Apr-88 19:55 by jds") - (* ; - "Write an arbitrary MKSTRING-able thing in length-contents form.") - (LET ((SIZE (AND ITEM (NCHARS ITEM T *TEDIT-FILE-READTABLE*))) - (FPTR) - (END-FPTR)) - (\SMALLPOUT STREAM (OR SIZE 0)) - (SETQ FPTR (GETFILEPTR STREAM)) - (OR (NOT ITEM) - (ZEROP SIZE) - (PRIN2 ITEM STREAM *TEDIT-FILE-READTABLE*)) - (* ;; "Because of NS chars, you gotta back up and really count bytes.") - (* (SETQ END-FPTR (GETFILEPTR STREAM)) - (SETFILEPTR STREAM FPTR) - (\SMALLPOUT STREAM - (- - END-FPTR FPTR)) (SETFILEPTR STREAM - END-FPTR)) - NIL]) - -(\ATMOUT - [LAMBDA (STREAM ATOM) (* jds "30-Jan-85 14:46") - (* Write an atom's characters in - length-contents form.) - (\SMALLPOUT STREAM (COND - (ATOM (NCHARS ATOM)) - (T 0))) - (OR (NOT ATOM) - (ZEROP (NCHARS ATOM)) - (for CH inatom ATOM do (\BOUT STREAM CH]) - -(\DWOUT - [LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30") - (\BOUT FILE (LOGAND 255 (LRSH NUMBER 24))) - (\BOUT FILE (LOGAND 255 (LRSH NUMBER 16))) - (\BOUT FILE (LOGAND 255 (LRSH NUMBER 8))) - (\BOUT FILE (LOGAND 255 NUMBER]) - -(\STRINGOUT - [LAMBDA (STREAM STRING LEN) (* jds " 1-May-84 11:58") - - (* Write a string on a file in length-contents form; - one word for the length, and one byte per character contained.) - - (SETQ LEN (OR LEN (NCHARS STRING))) - (\SMALLPOUT STREAM LEN) - (OR (ZEROP LEN) - (for CH instring STRING as I from 1 to LEN do (\BOUT STREAM CH]) - -(\TEDIT-OPEN-FONT-FILE - [LAMBDA (EXISTING-FONTFILE-IF-ANY) (* ; "Edited 23-Sep-87 12:31 by jds") - - (* ;; " Open a font-information file for TEDIT PUT operation, if one doesn't exist already. Also set its linelength to effective infinity, so that we don't get spurious CRs in the middle of formatting info.") - - (* ;; - "The calling form must be (SETQ FOO (\TEDIT-OPEN-FONT-FILE FOO)), to preserve information.") - - (COND - ((NOT EXISTING-FONTFILE-IF-ANY) (* ; - "Create the font-info file if it doesn't exist yet") - - (SETQ EXISTING-FONTFILE-IF-ANY (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) - (replace (STREAM LINELENGTH) of EXISTING-FONTFILE-IF-ANY with MAX.SMALLP) - (* ; - "Prevent spurious carriage-returns in the piece descriptions.") - - )) - EXISTING-FONTFILE-IF-ANY]) -) -(DEFINEQ - -(\TEDIT.GET.CHARLOOKS.LIST - [LAMBDA (FILE) (* jds "28-Jan-85 17:50") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE]) - -(\TEDIT.GET.SINGLE.CHARLOOKS - [LAMBDA (FILE) (* ; "Edited 20-Feb-2022 12:42 by larry") - (* ; "Edited 30-May-91 20:25 by jds") - (* Read a set of CHARLOOKS from FILE) - (PROG* ((LOOKS (create CHARLOOKS)) - (FILEPOS (GETFILEPTR FILE)) - (LOOKSLEN (\SMALLPIN FILE)) - FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) - (SETQ NAME (\ARBIN FILE)) (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) - 0)) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] - [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] - [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - [replace (CHARLOOKS CLFONT) of LOOKS with (COND - ((LISTP NAME) - (* This was a font class. - Restore it.) - (FONTCLASS (pop NAME) - NAME)) - ((AND NAME (NOT (ZEROP SIZE))) - (FONTCREATE NAME SIZE - (COND - ((AND (fetch (CHARLOOKS CLBOLD) - of LOOKS) - (fetch (CHARLOOKS CLITAL) - of LOOKS)) - 'BOLDITALIC) - ((fetch (CHARLOOKS CLBOLD) - of LOOKS) - 'BOLD) - ((fetch (CHARLOOKS CLITAL) - of LOOKS) - 'ITALIC)) - NIL NIL T NIL] - (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)) - (RETURN LOOKS]) - -(\TEDIT.PUT.CHARLOOKS.LIST - [LAMBDA (FILE LOOKSLIST) (* jds " 5-Mar-85 15:58") - (* Write the list of CHARLOOKSs into - the font file.) - - (* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' - position in the list we wrote on the file. - Those position numbers are then written in the individual looks descriptions, - and are used to reconstruct the piece looks when the file is read back in.) - - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) (* No characters are described by this - pseudo-piece entry.) - (\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of - CHARLOOKSs) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in - the list) - (for I from 1 as LOOKS in LOOKSLIST do - - (* Write each charlooks, in the order they appear in the list.) - - (\TEDIT.PUT.SINGLE.CHARLOOKS FILE LOOKS) - (* Write out the description) - (PUTHASH LOOKS I LOOKSHASH) - - (* And save it in the hash table so people can find its index.) -) - (RETURN LOOKSHASH]) - -(\TEDIT.PUT.SINGLE.CHARLOOKS - [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:26 by jds") - (* Put out a single CHARLOOKS - description.) - (PROG ((FILEPOS (GETFILEPTR FILE)) - (FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) - STR LEN) - (\SMALLPOUT FILE 0) (* Reserve space for the length of - this looks) - [COND - ((type? FONTCLASS FONT) (* For font classes, we need to save - a list of device-FD sets) - (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) - (T (* For FONTDESCRIPTORs, do it the - easy way) - (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* The font family) - (\SMALLPOUT FILE (OR (FONTPROP FONT 'SIZE) - 0)) (* Size of the type, in points) - (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0)) (* Super/subscripting distance) - (COND - ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) - (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] - (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - (COND - ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) - (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - [\SMALLPOUT FILE (LOGOR (COND - ((fetch (CHARLOOKS CLLEADER) of LOOKS) - (* Dotted-leader; relevant only to - TABs) - 2048) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVERTED) of LOOKS) - (* Inverse-video) - 1024) - (T 0)) - (COND - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 512) - (T 0)) - (COND - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 256) - (T 0)) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) - 128) - (T 0)) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) - 64) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) - 32) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) - 16) - (T 0)) - (COND - ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) - 8) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) - NIL 4) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSELHERE) of LOOKS) - 2) - (T 0)) - (COND - ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) - 1) - (T 0] - - (* * Now go fill in the length field at the front of the LOOKS. - (ALL looks info should be written out BEFORE this comment.)) - - (SETQ LEN (IDIFFERENCE (GETFILEPTR FILE) - FILEPOS)) (* The length of this set of looks) - (SETFILEPTR FILE FILEPOS) (* Go write the length field) - (\SMALLPOUT FILE LEN) - (SETFILEPTR FILE -1) (* And back to the end of the file) - ]) -) -(DEFINEQ - -(\TEDIT.GET.PARALOOKS.LIST - [LAMBDA (FILE TEXTOBJ) (* jds "13-Jun-85 11:14") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ]) - -(\TEDIT.GET.SINGLE.PARALOOKS - [LAMBDA (FILE TEXTOBJ) (* ; - "Edited 2-Jul-93 21:31 by sybalskY:MV:ENVOS") - (* ; - "Read a paragraph format spec from the FILE, and return it for later use.") - (PROG ((LOOKS (create FMTSPEC)) - (FILEPOS (GETFILEPTR FILE)) - (LOOKSLEN (\SMALLPIN FILE)) - TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC TABTYPE QUAD) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; - "Left margin for the first line of the paragraph") - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; - "Left margin for the rest of the paragraph") - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; "Right margin for the paragraph") - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* ; "Leading before the paragraph") - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* ; "Lead after the paragraph") - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* ; "inter-line leading") - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) - (* ; "Will be tab specs") - (SETQ TABFLG (\BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (SETQ QUAD (\BIN FILE)) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (COND - ((NOT (ZEROP (LOGAND TABFLG 1))) (* ; "There are tabs to read") - (SETQ DEFAULTTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (\BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT - collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ (SELECTQ (SETQ TABTYPE (\BIN FILE)) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (4 'DOTTEDLEFT) - (5 'DOTTEDRIGHT) - (6 'DOTTEDCENTERED) - (7 'DOTTEDDECIMAL) - (SHOULDNT] - (OR (ZEROP DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* ; - "There are other paragraph parameters to be read.") - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) - (* ; - "Special X location on page for this paragraph") - (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) - (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTHEADINGKEEP) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTKEEP) of LOOKS with (\ARBIN FILE)) - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTBASETOBASE) of LOOKS with (\ARBIN FILE] - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTREVISED) of LOOKS with (\ARBIN FILE] - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTCOLUMN) of LOOKS with (\ARBIN FILE] - (COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE] - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) (* ; - "There is more PARALOOKS info in this piece -- we probably lost data.") - (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T) - (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN] - (RETURN LOOKS]) - -(\TEDIT.PUT.PARALOOKS.LIST - [LAMBDA (FILE LOOKSLIST) (* ; "Edited 1-Sep-87 20:34 by jds") - (* ; - "Write the list of FMTSPECs into the font file.") - - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) - (\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) - (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS FILE LOOKS) - (* ; "Write out the description") - - (PUTHASH LOOKS I LOOKSHASH) - (* ; - "And save it in the hash table so people can find its index.") -) - (RETURN LOOKSHASH]) - -(\TEDIT.PUT.SINGLE.PARALOOKS - [LAMBDA (FILE LOOKS) (* ; - "Edited 2-Jul-93 21:30 by sybalskY:MV:ENVOS") - - (* ;; "Put a description of LOOKS into FILE.") - - (PROG ((FILEPOS (GETFILEPTR FILE)) - DEFAULTTAB TABSPECS OUTPUTFORMAT LEN) - (\SMALLPOUT FILE 0) (* ; - "Reserve space for the length of this looks") - (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) - (* ; - "Left margin for the first line of the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) - (* ; - "Left margin for the rest of the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) - (* ; "Right margin for the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) - (* ; "Leading before the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) - (* ; "Lead after the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS)) - (* ; "inter-line leading") - (SETQ DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (COND - ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) - (OR DEFAULTTAB TABSPECS)) (* ; - "There are tab specs to save, or there is a default tab setting to save") - (\BOUT FILE 3)) - (T (* ; - "There are no tab looks. Just let him go.") - (\BOUT FILE 2))) - (\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) - (LEFT 1) - (RIGHT 2) - ((CENTER CENTERED) - 3) - ((JUST JUSTIFIED) - 4) - (SHOULDNT))) - [COND - ((OR TABSPECS DEFAULTTAB) (* ; "There are tab specs to save.") - (COND - (DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB)) - (T (\SMALLPOUT FILE 0))) - (COND - ((IGREATERP (LENGTH TABSPECS) - 255) - (SHOULDNT "Paragraph has more than 255 TABs set--can't be saved."))) - (\BOUT FILE (LENGTH TABSPECS)) - (COND - (TABSPECS (* ; "# of tab settings <256!") - (for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX - of TAB)) - (* ; "And setting.") - (\BOUT FILE (SELECTQ (fetch TABKIND - of TAB) - (LEFT 0) - (RIGHT 1) - (CENTERED 2) - (DECIMAL 3) - (DOTTEDLEFT 4) - (DOTTEDRIGHT 5) - (DOTTEDCENTERED - 6) - (DOTTEDDECIMAL 7) - (SHOULDNT))) - (* ; "Tab type")] - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) - 0)) - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) - 0)) - (\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS)) - (\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS)) - (\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTHEADINGKEEP) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTKEEP) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTBASETOBASE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTREVISED) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCOLUMN) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) - -(* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)") - - (SETQ LEN (IDIFFERENCE (GETFILEPTR FILE) - FILEPOS)) (* ; "The length of this set of looks") - (SETFILEPTR FILE FILEPOS) (* ; "Go write the length field") - (\SMALLPOUT FILE LEN) - (SETFILEPTR FILE -1) (* ; "And back to the end of the file") - ]) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) -) - -(RPAQ? TEDIT.INPUT.FORMATS NIL) - -(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) - - - -(* ;; "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") - -(DEFINEQ - -(TEDIT.BUILD.PCTB2 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS) (* ; "Edited 4-May-93 16:27 by jds") - - (* ;; "READ OBSOLETE FORMATS OF TEDIT FILE") - - (* ;; "START = 1st char of file to read from, if specified") - - (* ;; "END = use this as eofptr of file. For use in reading files within files.") - - (PROG (SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE - CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP EXISTINGCHARLOOKS EXLOOK - EXISTINGFMTSPECS (CURFILECH# (OR START 0)) - (CURCH# 1) - (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) - LOOKSHASH PARAHASH) (* ; - "Get the number of pieces needed (if AN formatted file), otherwise PCCOUNT will be NIL") - [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (T (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ] - (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) - (* ; - "Start by assuming no page formatting") - (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) - (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN - from \FirstPieceOffset by \EltsPerPiece - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - (SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ - with (TEDIT.GET.PAGEFRAMES TEXT))) - (add PCN (IMINUS \EltsPerPiece)) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorCHARLOOKSLIST (* ; - "This is the list of CHARLOOKSs used in this document.") - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ - with (\TEDIT.GET.CHARLOOKS.LIST2 TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ - TXTCHARLOOKSLIST - ) - of TEXTOBJ) - do (SETA LOOKSHASH I LOOKS)) - (add PCN (IMINUS \EltsPerPiece)) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARALOOKSLIST (* ; - "This is the list of PARALOOKSs used in this document.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ - with (\TEDIT.GET.PARALOOKS.LIST2 TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ - TXTPARALOOKSLIST - ) - of TEXTOBJ) - do (SETA PARAHASH I LOOKS)) - (add PCN (IMINUS \EltsPerPiece)) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) - (* ; - "Get the new set of looks, for use by later pieces.") - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ - with T)) (* ; - "Mark the document as containing paragraph formatting info") - (add PCN (IMINUS \EltsPerPiece)) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (* ; "Build the new piece") - (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) - (* ; - "Read the character looks for this guy.") - (COND - [OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC) - (COND - ((AND (fetch (PIECE PFATP) of PC) - (NOT (fetch (PIECE PFATP) of OLDPC))) - (* ; - "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") - (add (fetch (PIECE PFPOS) of PC) - 3) - (add CURFILECH# -3)) - ((AND (fetch (PIECE PFATP) of OLDPC) - (NOT (fetch (PIECE PFATP) of PC))) - (* ; - "Switching from fat to not-fat. Add 3 bytes for the 255-0") - (add (fetch (PIECE PFPOS) of PC) - 2] - ((fetch (PIECE PFATP) of PC) - (* ; - "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") - (add (fetch (PIECE PFPOS) of PC) - 3) - (add CURFILECH# -3))) - (add CURFILECH# PCLEN) (* ; - "And note the passing of characters.") - ) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC))) - (TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) (* ; - "There are new character looks for this object. Read them in.") - (replace (PIECE PLOOKS) of PC with ( - \TEDIT.GET.SINGLE.CHARLOOKS2 - TEXT))) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC - with (OR (AND OLDPC (fetch (PIECE PLOOKS) of OLDPC)) - DEFAULTLOOKS] - (replace (PIECE PLEN) of PC with 1) - (* ; - "OBJECTs are officially one character long.") - ) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) - (COND - (PC (* ; - "If we created a piece, save it in the table.") - (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) - (add CURCH# (fetch (PIECE PLEN) of PC)) - (SETQ OLDPC PC))) finally (* INSERT-BRT (CREATEPCNODE CURCH# - (QUOTE LASTPIECE)) PCTB)) - (RETURN PCTB]) - -(\TEDIT.GET.CHARLOOKS.LIST2 - [LAMBDA (FILE) (* jds "22-May-85 14:28") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE]) - -(\TEDIT.GET.SINGLE.CHARLOOKS2 - [LAMBDA (FILE) (* ; "Edited 30-May-91 20:26 by jds") - (* Read a set of CHARLOOKS from FILE) - (PROG* ((LOOKS (create CHARLOOKS)) - FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) - (SETQ NAME (\ARBIN FILE)) (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) - 0)) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] - [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] - [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - [replace (CHARLOOKS CLFONT) of LOOKS - with (COND - ((LISTP NAME) (* This was a font class. - Restore it.) - (FONTCLASS (pop NAME) - NAME)) - ((AND NAME (NOT (ZEROP SIZE))) - (FONTCREATE NAME SIZE (COND - ((AND (fetch (CHARLOOKS CLBOLD) of LOOKS) - (fetch (CHARLOOKS CLITAL) of LOOKS) - ) - 'BOLDITALIC) - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 'BOLD) - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 'ITALIC] - (RETURN LOOKS]) - -(\TEDIT.PUT.SINGLE.PARALOOKS2 - [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:33 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (PROG (DEFAULTTAB TABSPECS OUTPUTFORMAT LEN) - (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) - (* Left margin for the first line of - the paragraph) - (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) - (* Left margin for the rest of the - paragraph) - (\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) - (* Right margin for the paragraph) - (\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) - (* Leading before the paragraph) - (\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) - (* Lead after the paragraph) - (\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS)) - (* inter-line leading) - (SETQ DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (COND - ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) - (OR DEFAULTTAB TABSPECS)) - - (* There are tab specs to save, or there is a default tab setting to save) - - (\BOUT FILE 3)) - (T (* There are no tab looks. - Just let him go.) - (\BOUT FILE 2))) - (\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) - (LEFT 1) - (RIGHT 2) - ((CENTER CENTERED) - 3) - ((JUST JUSTIFIED) - 4) - (SHOULDNT))) - [COND - ((OR TABSPECS DEFAULTTAB) (* There are tab specs to save.) - (COND - (DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB)) - (T (\SMALLPOUT FILE 0))) - (\BOUT FILE (LENGTH TABSPECS)) - (COND - (TABSPECS (* %# of tab settings <256!) - (for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX - of TAB)) - (* And setting.) - (\BOUT FILE (SELECTQ (fetch TABKIND - of TAB) - (LEFT 0) - (RIGHT 1) - (CENTERED 2) - (DECIMAL 3) - (SHOULDNT))) - (* Tab type)] - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) - 0)) - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) - 0)) - (\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS)) - (\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS)) - (\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS]) - -(\TEDIT.PUT.SINGLE.CHARLOOKS2 - [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:26 by jds") - (* Put out a single CHARLOOKS - description.) - (PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) - STR LEN) - [COND - ((type? FONTCLASS FONT) (* For font classes, we need to save - a list of device-FD sets) - (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) - (T (* For FONTDESCRIPTORs, do it the - easy way) - (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* The font family) - (\SMALLPOUT FILE (OR (FONTPROP FONT 'SIZE) - 0)) (* Size of the type, in points) - (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0)) (* Super/subscripting distance) - (COND - ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) - (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] - (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - (COND - ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) - (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - (\SMALLPOUT FILE (LOGOR (COND - ((fetch (CHARLOOKS CLLEADER) of LOOKS) - (* Dotted-leader; relevant only to - TABs) - 2048) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVERTED) of LOOKS) - (* Inverse-video) - 1024) - (T 0)) - (COND - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 512) - (T 0)) - (COND - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 256) - (T 0)) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) - 128) - (T 0)) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) - 64) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) - 32) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) - 16) - (T 0)) - (COND - ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) - 8) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) - NIL 4) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSELHERE) of LOOKS) - 2) - (T 0)) - (COND - ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) - 1) - (T 0]) - -(\TEDIT.GET.PARALOOKS.LIST2 - [LAMBDA (FILE) (* jds "22-May-85 14:28") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE]) - -(\TEDIT.GET.SINGLE.PARALOOKS2 - [LAMBDA (FILE) (* ; "Edited 30-May-91 20:33 by jds") - (* Read a paragraph format spec from - the FILE, and return it for later - use.) - (PROG ((LOOKS (create FMTSPEC)) - TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the first line of - the paragraph) - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the rest of the - paragraph) - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Right margin for the paragraph) - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* Leading before the paragraph) - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* Lead after the paragraph) - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* inter-line leading) - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) - (* Will be tab specs) - (SETQ TABFLG (\BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (\BIN FILE) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (COND - ((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read) - (SETQ DEFAULTTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (\BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT - collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ (SELECTQ (\BIN FILE) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (SHOULDNT] - (OR (ZEROP DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph - parameters to be read.) - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) - (* Special X location on page for - this paragraph) - (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) - (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE] - (RETURN LOOKS]) - -(TEDIT.PUT.PCTB2 - [LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 11-Jun-99 15:03 by rmk:") - (* ; "Edited 11-Jun-99 15:03 by rmk:") - (* ; "Edited 11-Jun-99 14:31 by rmk:") - (* ; "Edited 11-Jun-99 14:29 by rmk:") - (* ; "Edited 30-May-91 20:24 by jds") - - (* ;; "Put a representation of the piece table onto OFILE, preserving font changes and paragraph looks. UNFORMATTED? means write no font or formatting info.") - - (PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - OLDCH# CURCH# PREVPC (FONTFILE NIL) - (PCCOUNT 0) - TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL) - (EDITSTENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) - (PARALOOKSSEEN NIL) - (FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ)) - (CACHE (TEXTPROP TEXTOBJ 'CACHE)) - CH#S PREVFATP PREVPREVPC LOOKSHASH PARAHASH) - (SETQ PC (\EDITELT (fetch (TEXTOBJ PCTB) of TEXTOBJ) - (ADD1 \FirstPieceOffset))) (* ; "First piece in the document") - (SETQ OLDLOOKS (OR (AND (type? PIECE PC) - (fetch (PIECE PLOOKS) of PC)) - (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks") - (COND - ((NEQ (fetch (STREAM EOLCONVENTION) of OFILE) - CR.EOLC) (* ; - "This file is on a non-CR host; make a note to cache it") - (SETQ TRUEFILE OFILE) (* ; - "Remember where the file should wind up.") - [SETQ OFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; - "And open a temp file to write it to.") - )) - [SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE] - (COND - ((fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) - (* ; - "There is layout info for this file. Save it") - [SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (TEDIT.PUT.PAGEFRAMES FONTFILE (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ)) - (add PCCOUNT 1))) - (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* ; - "Run thru the lists of char & para looks and remove any that aren't in use") - (COND - ([AND (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - (OR (IGREATERP (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - 1) - (NOT (EQFMTSPEC (CAR (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - TEDIT.DEFAULT.FMTSPEC] - - (* ;; "There are paragraph looks in this document that don't match the default -- save the list of them for later retrieval.") - - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; - "Create the font-info file if it doesn't exist yet") - (SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST2 FONTFILE (fetch (TEXTOBJ - TXTPARALOOKSLIST - ) - of TEXTOBJ))) - (SETQ PARALOOKSSEEN T))) - [COND - ((OR PARALOOKSSEEN FORMATTINGLEVEL) - - (* ;; "There are character looks in this document that don't match the default (or paragraph formatting, which forces looks to be saved) -- save the list for later retrieval.") - - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST2 FONTFILE (fetch (TEXTOBJ - TXTCHARLOOKSLIST - ) - of TEXTOBJ] - [while PC do (COND - ([AND (NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch (PIECE - PPARALOOKS - ) - of PC) - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ] - (* ; - "The last piece ended a paragraph, so send out new para looks") - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH - 'NEW - '((TYPE TEXT] - (* ; - "Create the formatting-info file, if it didn't exist before.") - (COND - ((NEQ CURCH# OLDCH#) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ - TXTCHARLOOKSLIST - ) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) - (\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH) - (SETQ PARALOOKSSEEN T) (* ; - "Remember that we've seen a foreign paralooks, and must henceforth note para boundaries") - (add PCCOUNT 1))) - (COND - [(fetch (PIECE POBJ) of PC) - (* ; - "It's an object -- go use its PUTFN") - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH - 'NEW - '((TYPE TEXT] - (* ; - "Create the font-info file, if need be.") - (COND - ((AND (NEQ CURCH# OLDCH#) - PREVPC) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ - TXTCHARLOOKSLIST - ) of - TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) (* ; - "If the prior thing was text, send along its descriptor.") - (add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#)) - (* ; "Send out the object") - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) - (COND - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) - of PC))) - (NEQ (fetch (PIECE PFATP) of PC) - (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) - of PC) - (AND PREVPC (fetch - (PIECE PNEW) - of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) - of PC) - (fetch (TEXTOBJ FMTSPEC) of - TEXTOBJ - ] - (* ; - "The OBJECT has different ooks from before") - (\BOUT FONTFILE 1) - (\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch - (PIECE PLOOKS) - of PC)) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (T (* ; - "No differences. Don't write any charlooks, and mark that fact") - (\BOUT FONTFILE 0) (* ; - "MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS GETS ITS OWN LOOKS") - ] - (T (* ; "It's not an object.") - [COND - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) - of PC))) - (NEQ (fetch (PIECE PFATP) of PC) - (AND PREVPC (fetch (PIECE PFATP) of PREVPC)) - ) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) - of PC) - (AND PREVPC (fetch - (PIECE PNEW) - of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) - of PC) - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ] - (* ; "We have a piece with new looks.") - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} - 'BOTH - 'NEW - '((TYPE TEXT] - (COND - ((NOT (IEQP OLDCH# CURCH#)) - (* ; - "If there were looks past, and if the run was not empty, save a piece for its looks") - [OR LOOKSHASH (SETQ LOOKSHASH ( - \TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ - TXTCHARLOOKSLIST - ) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS - PREVPC EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1))) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC)) - (SETQ OLDCH# CURCH#) - (COND - [PREVFATP (COND - ((fetch (PIECE PFATP) of PC)) - (T (* ; "Switching from FAT to thin") - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 2] - ((fetch (PIECE PFATP) of PC) - (* ; "Switching from thin to fat") - (BOUT OFILE 255) - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 3))) - (SETQ PREVFATP (fetch (PIECE PFATP) of PC] - (* ; - "Now dump out the non-object contents of the piece.") - [COND - [(SETQ PFILE (fetch (PIECE PFILE) of PC)) - (* ; "It's on a file. Copy it.") - [OR (OPENP PFILE) - (replace (PIECE PFILE) of PC - with (SETQ PFILE (OPENSTREAM (fetch - (STREAM FULLNAME) - of PFILE) - 'INPUT NIL - '((TYPE TEXT] - (* ; "Make sure the file is open.") - (COPYBYTES PFILE OFILE (fetch (PIECE PFPOS) of PC) - (IPLUS (fetch (PIECE PFPOS) of PC) - (COND - ((fetch (PIECE PFATP) of PC) - (* ; - "For fat file pieces, copy twice as many bytes as characters.") - (UNFOLD (fetch (PIECE PLEN) - of PC) - 2)) - (T (fetch (PIECE PLEN) of PC] - ((SETQ PSTR (fetch (PIECE PSTR) of PC)) - (* ; - "It's in a string. Just print it.") - (COND - [(fetch (PIECE PFATP) of PC) - (* ; - "The string is fat: Copy twice as many bytes as chars.") - (for I from 1 to (fetch (PIECE PLEN) - of PC) - as CH instring PSTR - do (\BOUT OFILE (\CHARSET CH)) - (\BOUT OFILE (\CHAR8CODE CH] - (T (* ; - "The string is thin. Just copy it to the file.") - (for I from 1 to (fetch (PIECE PLEN) - of PC) - as CH instring PSTR - do (\BOUT OFILE CH] - [COND - ((AND (NOT CACHE) - (RANDACCESSP OFILE)) - (* ; -"CSLI leave the pieces and the pctb alone and just write the file if its cached or not randomaccess") - (push CH#S (SUB1 CURCH#] - [COND - ((fetch (PIECE PFATP) of PC) - (add CURCH# (UNFOLD (fetch (PIECE PLEN) of PC) - 2))) - (T (add CURCH# (fetch (PIECE PLEN) of PC] - (* ; - "Keep running track of where in the file we are.") - )) - (SETQ PREVPREVPC PREVPC) - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally (* ; - "Put out a piece describing the last characters in the file.") - (COND - ((AND FONTFILE (NEQ OLDCH# CURCH#)) (* ; - "Only if there WERE characters, and only if there's a need for font information") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE - LOOKSHASH PREVPREVPC) (* ; - "Put out a description of the characters") - (add PCCOUNT 1))) - (COND - ((AND PARALOOKSSEEN (fetch (PIECE PPARALAST) of PREVPC)) - (* ; - "The last piece contained the end of a paragraph. Make sure it gets noted.") - (\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH) - (add PCCOUNT 1] - (for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM)) - (* ; "Do any user-specific cleanup") - (COND - (TRUEFILE (* ; - "This file needs to be converted to the right convention") - (COND - ((AND FONTFILE (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) (* ; - "Formatted file: Copy without converting.") - (COPYBYTES OFILE TRUEFILE 0 -1)) - (T (* ; - "Go ahead and convert the EOLCONVENTION, this is a plain-text file") - (COPYCHARS OFILE TRUEFILE 0 -1))) - (SETQ OFILE TRUEFILE))) - [COND - ((AND (OPENP OFILE) - FONTFILE) (* ; "We need to write format info.") - (\DWOUT FONTFILE (GETEOFPTR OFILE)) (* ; - "So remember the end of the plain-text part of the file") - (\SMALLPOUT FONTFILE PCCOUNT) (* ; - "# OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE") - (\SMALLPOUT FONTFILE 31417) (* ; - "Now the password for NEW format files: 31416") - (COND - ((AND (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) - - (* ;; "Only write fmtg info at the end if we want it there--not if we want plain text or want it kept separate.") - - (COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE)) - (* ; - "Copy the font information to the file trailer") - ) - (T)) - (CLOSEF FONTFILE) - (COND - ((NOT SEPARATEFORMAT) (* ; - "Unless we want the formatting info separately, delete the file") - (* ; - "(since FONTFILE is a stream, we should not need to delete it at all) (DELFILE FONTFILE)") - ] - (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ) - TEXTOBJ)) - (* ; - "Re-add the default and caret looks's to the lists, since they may not have been really saved.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ CARETLOOKS) - of TEXTOBJ) - TEXTOBJ)) - (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ) - TEXTOBJ)) - (RETURN (CONS (COND - (UNFORMATTED? NIL) - (T FONTFILE)) - CH#S]) - -(\TEDIT.PUT.CHARLOOKS.LIST2 - [LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:12") - (* Write the list of CHARLOOKSs into - the font file.) - - (* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' - position in the list we wrote on the file. - Those position numbers are then written in the individual looks descriptions, - and are used to reconstruct the piece looks when the file is read back in.) - - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) (* No characters are described by this - pseudo-piece entry.) - (\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of - CHARLOOKSs) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in - the list) - (for I from 1 as LOOKS in LOOKSLIST do - - (* Write each charlooks, in the order they appear in the list.) - - (\TEDIT.PUT.SINGLE.CHARLOOKS2 FILE LOOKS) - (* Write out the description) - (PUTHASH LOOKS I LOOKSHASH) - - (* And save it in the hash table so people can find its index.) -) - (RETURN LOOKSHASH]) - -(\TEDIT.PUT.PARALOOKS.LIST2 - [LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:09") - (* Write the list of FMTSPECs into the - font file.) - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) - (\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) - (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS2 FILE LOOKS) - (* Write out the description) - (PUTHASH LOOKS I LOOKSHASH) - - (* And save it in the hash table so people can find its index.) -) - (RETURN LOOKSHASH]) -) - - - -(* ;; "For converting incoming old-format files (1/27/85 cutover)") - -(DEFINEQ - -(TEDIT.BUILD.PCTB1 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS) (* ; "Edited 22-May-92 18:00 by jds") - -(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") - - (* ;; "START = 1st char of file to read from, if specified") - - (* ;; "END = use this as eofptr of file. For use in reading files within files.") - - (PROG [SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE - CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP EXISTINGCHARLOOKS EXLOOK - EXISTINGFMTSPECS (CURFILECH# (OR START 0)) - (CURCH# 1) - (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] - - (* ;; "Get the number of pieces needed (if AN formatted file), otherwise PCCOUNT will be NIL") - - [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (T (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ] - (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) - (* ; - "Start by assuming no page formatting") - (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN - from \FirstPieceOffset by \EltsPerPiece - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - (SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ - with (TEDIT.GET.PAGEFRAMES1 TEXT))) - (add PCN (IMINUS \EltsPerPiece)) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS1 TEXT)) - (* ; - "Get the new set of looks, for use by later pieces.") - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ - with T)) (* ; - "Mark the document as containing paragraph formatting info") - (add PCN (IMINUS \EltsPerPiece)) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (* ; "Build the new piece") - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC))) - (\TEDIT.GET.CHARLOOKS1 PC TEXT) - (* ; - "Read the character looks for this guy.") - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - (* ; - "And note the passing of characters.") - ) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC))) - (TEDIT.GET.OBJECT1 TEXTSTREAM PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) (* ; - "There are new character looks for this object. Read them in.") - (\DWIN TEXT) - (\WIN TEXT) (* ; - "Skip over the piece-type code we know has to be here.") - (\TEDIT.GET.CHARLOOKS1 PC TEXT)) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC - with (OR (AND OLDPC (fetch (PIECE PLOOKS) of OLDPC)) - DEFAULTLOOKS] - (replace (PIECE PLEN) of PC with 1) - (* ; - "OBJECTs are officially one character long.") - ) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) - (COND - (PC (* ; - "If we created a piece, save it in the table.") - [COND - ((SETQ EXLOOK (for LOOK in EXISTINGCHARLOOKS - thereis (EQCLOOKS (fetch (PIECE PLOOKS) - of PC) - LOOK))) - (* ; - "These charlooks are a duplicate of pre-existing ones. Re-use the old one.") - (replace (PIECE PLOOKS) of PC with EXLOOK)) - (T (push EXISTINGCHARLOOKS (fetch (PIECE PLOOKS) of PC] - [COND - ((SETQ EXLOOK (for LOOK in EXISTINGFMTSPECS - thereis (EQFMTSPEC (fetch (PIECE PPARALOOKS) - of PC) - LOOK))) - (* ; - "These paralooks are a duplicate of pre-existing ones. Re-use the old one.") - (replace (PIECE PPARALOOKS) of PC with EXLOOK)) - (T (push EXISTINGFMTSPECS (fetch (PIECE PPARALOOKS) of - PC] - (INSERT-BRT (CREATEPCNODE CURCH# PC) - PCTB) - (add CURCH# (fetch (PIECE PLEN) of PC)) - (SETQ OLDPC PC))) finally (INSERT-BRT (CREATEPCNODE CURCH# 'LASTPIECE) - PCTB)) - (RETURN PCTB]) - -(TEDIT.GET.PAGEFRAMES1 - [LAMBDA (FILE) (* jds " 1-Feb-85 14:55") - - (* Read a bunch of page frames from the file, and return it.) - - (TEDIT.PARSE.PAGEFRAMES1 (READ FILE]) - -(\TEDIT.GET.CHARLOOKS1 - [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:26 by jds") - (* Read a description of PC's - CHARLOOKS from FILE.) - (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)) - ) - (replace (PIECE PLOOKS) of PC with LOOKS) - (SETQ NAME (\ARBIN FILE)) (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance) - (OR (ZEROP SUB) - (SETQ SUPER (IMINUS SUB))) - - (* If this is an old file, it'll have a subscript value not zero. - Let those past and do the right thing.) - - (COND - ((NOT (ZEROP (\BIN FILE))) (* This text is NEW. - Mark it so.) - (replace (PIECE PNEW) of PC with T))) - [COND - ((NOT (ZEROP (\BIN FILE))) (* There is style or user - information to be read) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) - 0)) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE] - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - (replace (CHARLOOKS CLFONT) of LOOKS - with (COND - ((LISTP NAME) (* This was a font class. - Restore it.) - (FONTCLASS (pop NAME) - NAME)) - ((AND NAME (NOT (ZEROP SIZE))) - (FONTCREATE NAME SIZE (COND - ((AND (fetch (CHARLOOKS CLBOLD) of LOOKS) - (fetch (CHARLOOKS CLITAL) of LOOKS)) - 'BOLDITALIC) - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 'BOLD) - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 'ITALIC]) - -(\TEDIT.GET.PARALOOKS1 - [LAMBDA (FILE) (* ; "Edited 30-May-91 20:34 by jds") - (* Read a paragraph format spec from - the FILE, and return it for later - use.) - (PROG ((LOOKS (create FMTSPEC)) - TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the first line of - the paragraph) - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the rest of the - paragraph) - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Right margin for the paragraph) - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* Leading before the paragraph) - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* Lead after the paragraph) - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* inter-line leading) - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) - (* Will be tab specs) - (SETQ TABFLG (\BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (\BIN FILE) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (COND - ((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read) - (SETQ DEFAULTTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (\BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT - collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ (SELECTQ (\BIN FILE) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (SHOULDNT] - (OR (ZEROP DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph - parameters to be read.) - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) - (* Special X location on page for - this paragraph) - (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) - (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE] - (RETURN LOOKS]) - -(TEDIT.GET.OBJECT1 - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 18:17 by mitani") - (* Get an object from the file) - - (* CURCH# = fileptr within the text section of the file where the object's text - starts.) - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - FILEPTRSAVE NAMELEN GETFN OBJ) - (SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of - IMAGEOBJ) - (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the - building of the object) - (SETFILEPTR FILE CURCH#) - (SETQ OBJ (READIMAGEOBJ FILE GETFN)) - (SETFILEPTR FILE FILEPTRSAVE) - (replace (PIECE POBJ) of PIECE with OBJ) - (replace (PIECE PFILE) of PIECE with NIL) - (replace (PIECE PSTR) of PIECE with NIL) - [replace (PIECE PLOOKS) of PIECE with (COND - ((fetch (PIECE PREVPIECE) - of PIECE) - (fetch (PIECE PLOOKS) - of (fetch (PIECE PREVPIECE - ) - of PIECE))) - (T (OR (fetch (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS - (CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ] - (RETURN (fetch (PIECE POBJ) of PIECE]) -) - - - -(* ;; "VERSION 0 Compatibility reading functions") - -(DEFINEQ - -(TEDIT.BUILD.PCTB0 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 22-May-92 18:01 by jds") - -(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") - - (PROG [SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE - TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0)) - (CURCH# 1) - (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] - (* ; - "Get the number of pieces needed (if AN formatted file), otherwise PCCOUNT will be NIL") - [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (T (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ] - (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind (OLDPC _ NIL) for I from 1 to PCCOUNT as PCN from - \FirstPieceOffset - by \EltsPerPiece do (SETQ PC (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ (SETQ PCLEN (\DWIN TEXT)) - PREVPIECE _ OLDPC - PPARALOOKS _ DEFAULTPARALOOKS)) - [COND - (OLDPC (replace (PIECE NEXTPIECE) of OLDPC - with PC) - (replace (PIECE PPARALOOKS) of PC - with (fetch (PIECE PPARALOOKS) - of OLDPC] - (SETQ TYPECODE (\SMALLPIN TEXT)) - (SELECTC TYPECODE - (\PieceDescriptorLOOKS - (TEDIT.GET.CHARLOOKS0 PC TEXT) - (add CURFILECH# (fetch (PIECE PLEN) - of PC))) - (\PieceDescriptorOBJECT - (TEDIT.GET.OBJECT0 TEXTSTREAM PC TEXT CURFILECH# - ) - (add CURFILECH# (fetch (PIECE PLEN) - of PC)) - (replace (PIECE PLEN) of PC with 1) - (* ; - "Only object--can't be followed by either ot the others.") - ) - (\PieceDescriptorPARA - (AND OLDPC (replace (PIECE PPARALAST) - of OLDPC with T)) - (TEDIT.GET.PARALOOKS0 PC TEXT) - (replace (PIECE PLEN) of PC - with (\DWIN TEXT)) - (* ; - "Set this piece's length from the character looks.") - (\SMALLPIN TEXT) - (* ; - "Skip the piece-type code, since we know what's next") - (TEDIT.GET.CHARLOOKS0 PC TEXT) - (* ; "This document is 'formatted' .") - (add CURFILECH# (fetch (PIECE PLEN) - of PC)) - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) - of TEXTOBJ with T))) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) - (SETQ OLDPC PC) - (INSERT-BRT (CREATEPCNODE CURCH# PC) - PCTB) - (add CURCH# (fetch (PIECE PLEN) of PC)) - finally (INSERT-BRT (CREATEPCNODE CURCH# 'LASTPIECE) - PCTB)) - (RETURN PCTB]) - -(TEDIT.GET.CHARLOOKS0 - [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:26 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)) - ) - (replace (PIECE PLOOKS) of PC with LOOKS) - (SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description - which follows) - [SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE] - (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance) - (OR (ZEROP SUB) - (SETQ SUPER (IMINUS SUB))) - - (* If this is an old file, it'll have a subscript value not zero. - Let those past and do the right thing.) - - (COND - ((NOT (ZEROP (\BIN FILE))) (* This text is NEW. - Mark it so.) - (replace (PIECE PNEW) of PC with T))) - [COND - ((NOT (ZEROP (\BIN FILE))) (* There is style or user - information to be read) - (SETQ STYLESTR (\STRINGIN FILE)) - (SETQ USERSTR (\STRINGIN FILE)) - (COND - ((NOT (ZEROP (NCHARS STYLESTR))) (* There IS style info) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR))) - (T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0))) - (COND - ((NOT (ZEROP (NCHARS USERSTR))) (* There IS user info) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR] - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - (replace (CHARLOOKS CLFONT) of LOOKS - with (AND NAME (NOT (ZEROP SIZE)) - (FONTCREATE NAME SIZE (COND - ((AND (fetch (CHARLOOKS CLBOLD) of LOOKS) - (fetch (CHARLOOKS CLITAL) of LOOKS) - ) - 'BOLDITALIC) - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 'BOLD) - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 'ITALIC]) - -(TEDIT.GET.OBJECT0 - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 18:17 by mitani") - (* Get an object from the file) - - (* CURCH# = fileptr within the text section of the file where the object's text - starts.) - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - FILEPTRSAVE NAMELEN GETFN OBJ) - (SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of - IMAGEOBJ) - (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the - building of the object) - (SETFILEPTR FILE CURCH#) - (SETQ OBJ (READIMAGEOBJ FILE GETFN)) - (SETFILEPTR FILE FILEPTRSAVE) - (replace (PIECE POBJ) of PIECE with OBJ) - (replace (PIECE PFILE) of PIECE with NIL) - (replace (PIECE PSTR) of PIECE with NIL) - [replace (PIECE PLOOKS) of PIECE with (COND - ((fetch (PIECE PREVPIECE) - of PIECE) - (fetch (PIECE PLOOKS) - of (fetch (PIECE PREVPIECE - ) - of PIECE))) - (T (OR (fetch (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS - (CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ] - (RETURN (fetch (PIECE POBJ) of PIECE]) - -(TEDIT.GET.PARALOOKS0 - [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:34 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (PROG ((LOOKS (create FMTSPEC)) - TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) - (replace (PIECE PPARALOOKS) of PC with LOOKS) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the first line of - the paragraph) - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the rest of the - paragraph) - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Right margin for the paragraph) - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* Leading before the paragraph) - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* Lead after the paragraph) - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* inter-line leading) - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) - (* Will be tab specs) - (SETQ TABFLG (\BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (\BIN FILE) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (COND - ((NOT (ZEROP TABFLG)) (* There are tabs to read) - (SETQ DEFAULTTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (\BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT - collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ (SELECTQ (\BIN FILE) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (SHOULDNT] - (OR (ZEROP DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS]) -) -(PUTPROPS TEDITFILE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1992 1993 1994 1999 2000 2001 2021 2022)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (3129 59007 (TEDIT.BUILD.PCTB 3139 . 37592) (\TEDIT.CONVERT.FOREIGN.FORMAT 37594 . 39035 -) (TEDIT.FORMATTEDFILEP 39037 . 42901) (TEDIT.GET 42903 . 51719) (TEDIT.PARSE.PAGEFRAMES1 51721 . -53427) (\ARBIN 53429 . 54050) (\ATMIN 54052 . 54381) (\DWIN 54383 . 54661) (\STRINGIN 54663 . 55260) ( -\TEDIT.FORMATTEDP1 55262 . 57526) (\TEDIT.SET.WINDOW 57528 . 58033) (TEDIT.GET.PASSWORD 58035 . 59005) -) (59043 79571 (TEDIT.INCLUDE 59053 . 70440) (TEDIT.RAW.INCLUDE 70442 . 79569)) (79605 123845 ( -TEDIT.PUT 79615 . 89988) (TEDIT.PUT.PCTB 89990 . 117581) (\TEDIT.PUTRESET 117583 . 117829) ( -TEDIT.PUT.PIECE.DESCRIPTOR 117831 . 120294) (\ARBOUT 120296 . 121496) (\ATMOUT 121498 . 122013) ( -\DWOUT 122015 . 122298) (\STRINGOUT 122300 . 122752) (\TEDIT-OPEN-FONT-FILE 122754 . 123843)) (123846 -135112 (\TEDIT.GET.CHARLOOKS.LIST 123856 . 124261) (\TEDIT.GET.SINGLE.CHARLOOKS 124263 . 128062) ( -\TEDIT.PUT.CHARLOOKS.LIST 128064 . 129859) (\TEDIT.PUT.SINGLE.CHARLOOKS 129861 . 135110)) (135113 -149392 (\TEDIT.GET.PARALOOKS.LIST 135123 . 135536) (\TEDIT.GET.SINGLE.PARALOOKS 135538 . 141932) ( -\TEDIT.PUT.PARALOOKS.LIST 141934 . 142928) (\TEDIT.PUT.SINGLE.PARALOOKS 142930 . 149390)) (149700 -210961 (TEDIT.BUILD.PCTB2 149710 . 163066) (\TEDIT.GET.CHARLOOKS.LIST2 163068 . 163475) ( -\TEDIT.GET.SINGLE.CHARLOOKS2 163477 . 166389) (\TEDIT.PUT.SINGLE.PARALOOKS2 166391 . 171105) ( -\TEDIT.PUT.SINGLE.CHARLOOKS2 171107 . 175603) (\TEDIT.GET.PARALOOKS.LIST2 175605 . 176012) ( -\TEDIT.GET.SINGLE.PARALOOKS2 176014 . 180602) (TEDIT.PUT.PCTB2 180604 . 208265) ( -\TEDIT.PUT.CHARLOOKS.LIST2 208267 . 210064) (\TEDIT.PUT.PARALOOKS.LIST2 210066 . 210959)) (211038 -232162 (TEDIT.BUILD.PCTB1 211048 . 221238) (TEDIT.GET.PAGEFRAMES1 221240 . 221495) ( -\TEDIT.GET.CHARLOOKS1 221497 . 225047) (\TEDIT.GET.PARALOOKS1 225049 . 229630) (TEDIT.GET.OBJECT1 -229632 . 232160)) (232222 247928 (TEDIT.BUILD.PCTB0 232232 . 237939) (TEDIT.GET.CHARLOOKS0 237941 . -241960) (TEDIT.GET.OBJECT0 241962 . 244490) (TEDIT.GET.PARALOOKS0 244492 . 247926))))) -STOP diff --git a/library/TEDITSCREEN b/library/TEDITSCREEN deleted file mode 100644 index 020367ec..00000000 --- a/library/TEDITSCREEN +++ /dev/null @@ -1,3007 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "12-Jan-2022 18:56:46"  -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITSCREEN.;11 214540 - - :CHANGES-TO (FNS \SHOWTEXT) - - :PREVIOUS-DATE "12-Jan-2022 18:27:35" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITSCREEN.;10) - - -(* ; " -Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. -") - -(PRETTYCOMPRINT TEDITSCREENCOMS) - -(RPAQQ TEDITSCREENCOMS - [(FILES TEDITDCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDITDCL)) - (FNS \FORMATLINE \TEDIT.NSCHAR.RUN \TEDIT.PURGE.SPACES \DOFORMATTING) - (FNS \DISPLAYLINE \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE \TEDIT.BLTCHAR) - (DECLARE%: EVAL@COMPILE DONTCOPY - - (* ;; "Machine independent version of \TEDIT.BLTCHAR") - - (MACROS MI-TEDIT.BLTCHAR)) - (FNS TEDIT.CR.UPDATESCREEN TEDIT.DELETELINE TEDIT.INSERT.DISPLAYTEXT - TEDIT.INSERT.UPDATESCREEN TEDIT.UPDATE.SCREEN \BACKFORMAT \FILLWINDOW \FIXDLINES - \FIXILINES \SHOWTEXT \TEDIT.ADJUST.LINES \TEDIT.CLEAR.SCREEN.BELOW.LINE - \TEDIT.CLOSEUPLINES \TEDIT.COPY.LINEDESCRIPTOR \TEDIT.FIXCHANGEDLINE - \TEDIT.FIXCHANGEDPART \TEDIT.INSERTLINE \TEDIT.LINE.LIST \TEDIT.MARK.LINES.DIRTY - \TEDIT.NEXT.LINE.BOTTOM) - (COMS (* RMK%: These duplicate what appears on TEDITHCPY, GLOBALVARS moved to TEDITDCL) - (* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" - "41,115" "41,133" "41,131" "41,127" - "Hira,41" "Hira,43" "Hira,45" - "Hira,47" "Hira,51" "Hira,103" - "Hira,143" "Hira,145" "Hira,147" - "Hira,156" "Kata,41" "Kata,43" - "Kata,45" "Kata,47" "Kata,51" - "Kata,103" "Kata,143" "Kata,145" - "Kata,147" "Kata,156"))) - (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126"))) - (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS]) - -(FILESLOAD TEDITDCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDITDCL) -) -(DEFINEQ - -(\FORMATLINE - [LAMBDA (TEXTOBJ FMTSPEC CH#1 OLINE 1STLN) (* ; "Edited 30-Apr-2021 14:38 by rmk:") - - (* ;; "Given a starting place, format the next line of text. Return the LINEDESCRIPTOR; reusing OLINE if it's given.") - - (* ;; "If CH#1 is past end of document, \FORMATLINE returns an empty line descriptor that is set up right wrt leading and font. This is used by \FILLWINDOW to create the dummy line at end of document when you hit a CR there.") - - (DECLARE (SPECVARS LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT - INVISIBLERUNS DEVICE SCALE NEWASCENT NEWDESCENT TLEN)) - (PROG ([LINE (OR OLINE (create LINEDESCRIPTOR - RIGHTMARGIN _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - YBOT _ (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (CH#B (IMAX CH#1 1)) - (GATHERBLANK T) - (TLEN 0) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (THISLINE (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (CHNO (IMAX CH#1 1)) - (LOOKNO 0) - (INVISIBLERUNS 0) - (ASCENT 0) - (DESCENT 0) - (PREVSP 0) - (%#BLANKS 0) - (DEFAULTTAB 36) - (DS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - 'DSP)) - LEFTEDGE TX DX TXB CH FORCEEND T1SPACE TXB1 DXB WIDTH LOOK#B FONT FONTWIDTHS TERMSA CLOOKS - TEXTSTREAM CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO - DEVICE SCALE NEWASCENT NEWDESCENT TABSPEC HARDCOPYMODE ORIGFMTSPEC PREVHYPH PREVDHYPH - ORIGCHLIST ORIGWLIST) - - (* ;; "Variables (TLEN = Current character count on the line)") - - (* ;; "(CHNO = Current character # in the text)") - - (* ;; "(DX = width of current char/object)") - - (* ;; "(TX = current right margin) ") - - (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ") - - (* ;; "(CH#B = The CHNO of most recent space/tab)") - - (* ;; "(TXB = right margin of most recent space/tab)") - - (* ;; "(DXB = width of most recent space/tab)") - - (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)") - - (* ;; "(T1SPACE = a space/CR/TAB has been seen)") - - (* ;; "(#BLANKS = # of spaces/tabs seen) ") - - (* ;; " (LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)") - - (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)") - - (* ;; "(ASCENTB = Ascent at most recent potential line break point)") - - (* ;; "(DESCENTB = Descent at most recent potential line break point)") - - (SETQ CH#1 (IMAX CH#1 1)) - [SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch (THISLINE CHARS) - of THISLINE] - [SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS) - of THISLINE] - (SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE)) - (SETQ TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (SETQ TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) - (replace (TEXTSTREAM LOOKSUPDATEFN) of TEXTSTREAM with (FUNCTION - \TEDIT.LOOKS.UPDATE)) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with TEXTLEN) - (* ; - "Force each new line to find its true CHARLIM.") - (freplace (LINEDESCRIPTOR DIRTY) of LINE with NIL) - (* ; - "And as unchanged since the last formatting.") - (freplace (LINEDESCRIPTOR CHAR1) of LINE with CH#1) - (freplace (LINEDESCRIPTOR CR\END) of LINE with NIL) - (* ; "Assume we won't see a CR.") - (freplace (LINEDESCRIPTOR LHASTABS) of LINE with NIL) - (* ; "And has no TABs.") - (COND - [(COND - ((AND (ILEQ CH#1 TEXTLEN) - (NOT (ZEROP TEXTLEN))) (* ; - "Only continue if there's really text we can format.") - (\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place") - (* ; "And starting character looks") - (SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM)) - (COND - ((fetch CLINVISIBLE of CLOOKS) (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) - (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN) - of PC))) - (\RPLPTR CHLIST 0 LMInvisibleRun) - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ))) - [while (AND PC (fetch CLINVISIBLE of CLOOKS)) - do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch - (PIECE PLEN) - of PC))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ] - (add CHNO (\EDITELT LOOKS LOOKNO)) - (\SETUPGETCH (create EDITMARK - PC _ (OR PC 'LASTPIECE) - PCOFF _ 0 - PCNO _ NIL) - TEXTOBJ))) - (ILEQ CHNO TEXTLEN))) - (replace (LINEDESCRIPTOR LHASPROT) of LINE with (fetch CLPROTECTED - of CLOOKS)) - (* ; - "Remember if the first character on the line is protected.") - (SETQ ORIGFMTSPEC (SETQ FMTSPEC - (\TEDIT.APPLY.PARASTYLES - [OR FMTSPEC (SETQ FMTSPEC (OR (AND (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM) - (fetch (PIECE PPARALOOKS) - of (fetch - (TEXTSTREAM PIECE) - of TEXTSTREAM)) - ) - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ] - PC TEXTOBJ))) (* ; "Get the paragraph looks") - (COND - ((NEQ ORIGFMTSPEC *TEDIT-CACHED-FMTSPEC*) - - (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.") - - (SETQ *TEDIT-CURRENTPARA-CACHE* NIL) - (SETQ *TEDIT-CACHED-FMTSPEC* ORIGFMTSPEC))) - (COND - [(SETQ HARDCOPYMODE (fetch FMTHARDCOPY of FMTSPEC)) - (* ; - "This line is a hardcopy line. Scale things for it.") - [SETQ DEVICE (OR (fetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ) - (replace (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ - with (OPENIMAGESTREAM '{NODIRCORE} 'INTERPRESS] - (SETQ SCALE (DSPSCALE NIL DEVICE)) - (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC FMTSPEC DEVICE)) - (SETQ DEFAULTTAB (FIXR (FTIMES 36 SCALE))) - (SETQ LEFTEDGE (FIXR (FTIMES 8 SCALE] - (T (* ; - "Regular line. Format at display resolutions") - (SETQ DEVICE (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) - (SETQ SCALE 1) - (SETQ LEFTEDGE 8))) - (SETQ TABSPEC (fetch TABSPEC of FMTSPEC)) - [COND - ((type? FONTCLASS (SETQ FONT (fetch CLFONT of CLOOKS))) - (SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS) - 'DEVICE - 'DISPLAY] (* ; - "Grab the initial font for this line") - [SETQ ASCENTB (SETQ NEWASCENT (IPLUS (fetch \SFAscent of FONT) - (OR (fetch CLOFFSET of CLOOKS) - 0] (* ; - "The initial ascent, per the initial font") - [SETQ DESCENTB (SETQ NEWDESCENT (IDIFFERENCE (fetch \SFDescent of FONT) - (OR (fetch CLOFFSET of CLOOKS) - 0] (* ; - "Initial descent, per the initial font.") - [COND - (HARDCOPYMODE (* ; - "If this is a hardcopy line, fetch the hardcopy version of the font") - (SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS) - 'DEVICE DEVICE] - (\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache") - [SETQ 1STLN (OR (IEQP CH#1 1) - (AND (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) - (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM)) - (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) - of (fetch - (TEXTSTREAM PIECE) - of TEXTSTREAM - ))) - (IEQP (fetch (TEXTSTREAM PCSTARTCH) of TEXTSTREAM) - (fetch (STREAM COFFSET) of TEXTSTREAM)) - (IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM) - (fetch (STREAM CPAGE) of TEXTSTREAM] - (* ; - "If this is the start of a paragraph, mark it so.") - (replace (LINEDESCRIPTOR LMARK) of LINE with NIL) - (* ; - "Start by assuming that we don't want a margin marker for this line.") - (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) - (* ; - "Are we on the first line of a paragraph?") - [COND - (1STLN - (* ;; "This is the first line of a paragraph. Check for special paragraph types, like headings, that get marked in the margin.") - - (COND - ((EQ (fetch FMTPARATYPE of FMTSPEC) - 'PAGEHEADING) - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) - ((OR (fetch FMTNEWPAGEBEFORE of FMTSPEC) - (fetch FMTNEWPAGEAFTER of FMTSPEC)) - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) - ([AND (fetch FMTSPECIALX of FMTSPEC) - (NOT (ZEROP (fetch FMTSPECIALX of FMTSPEC] - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) - ([AND (fetch FMTSPECIALY of FMTSPEC) - (NOT (ZEROP (fetch FMTSPECIALY of FMTSPEC] - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY] - [SETQ TX (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS [FIXR (FTIMES SCALE (IPLUS 8 (fetch (TEXTOBJ WLEFT) - of TEXTOBJ] - (COND - (1STLN (fetch 1STLEFTMAR of FMTSPEC)) - (T (fetch LEFTMAR of FMTSPEC] - (* ; "Set the left margin accordingly") - [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE - with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC))) - (IPLUS LEFTEDGE (fetch RIGHTMAR of FMTSPEC))) - (T (FIXR (FTIMES SCALE (IDIFFERENCE (fetch (TEXTOBJ - WRIGHT) - of TEXTOBJ) - 8] - (* ; - "RIGHTMAR = 0 => follow the window's width.") - (SETQ TXB1 WIDTH) - (for old TLEN from TLEN to 254 as old CHNO from CHNO - while (ILEQ CHNO TEXTLEN) when (SETQ CH (\BIN TEXTSTREAM)) - do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)") - - (* ;; "The character loop") - - (* ;; "Get the next character for the line.") - - [SETQ DX (COND - [(SMALLP CH) (* ; "CH is really a character") - (COND - ((AND (IGEQ CH 192) - (ILEQ CH 207)) (* ; - "This is an NS accent character. Space it 0.") - (SETQ DX 0)) - (T (* ; - "Regular character. Get it's width.") - (\FGETCHARWIDTH FONT CH] - (T (* ; "CH is an object") - (SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN) - CH DS TX WIDTH)) - (* ; "Get its size") - (SETQ NEWASCENT (IDIFFERENCE (fetch YSIZE of BOX) - (fetch YDESC of BOX))) - (SETQ NEWDESCENT (fetch YDESC of BOX)) - (IMAGEOBJPROP CH 'BOUNDBOX BOX) - (COND - ([NEQ 1 (fetch (PIECE PLEN) of (SETQ PC - (fetch - (TEXTSTREAM PIECE) - of TEXTSTREAM - ] - - (* ;; "The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from. Build an invisible run to fill the space.") - - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO (SUB1 (fetch (PIECE PLEN) - of PC))) - (\RPLPTR CHLIST 0 LMInvisibleRun) - (* ; - "Note the existence of an invisible run of characters here.") - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (add CHNO (SUB1 (fetch (PIECE PLEN) of PC))) - (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) - (* ; - "Keep track of how much invisible text we cross over") - )) - (COND - [HARDCOPYMODE (FIXR (FTIMES SCALE (fetch XSIZE - of BOX] - (T (fetch XSIZE of BOX] - (* ; "Get CH's X width.") - [SELCHARQ CH - (SPACE (* ; - "CH is a . Remember it, in case we need to break the line.") - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) (* ; - "put the location # of the previous space/tab in the character array instead of the space itself") - (\RPLPTR CHLIST 0 PREVSP) - (\RPLPTR WLIST 0 DX) - (SETQ PREVSP (ADD1 TLEN)) - (SETQ T1SPACE T) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (add TX DX) - (SETQ TXB TX) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (COND - (NEWASCENT (* ; - "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS) - (add %#BLANKS 1)) - ((CR LF) (* ; - "Ch is a . Force an end to the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) - (COND - ((AND NEWASCENT (ZEROP ASCENT) - (ZEROP DESCENT)) (* ; - "The ascent has changed; catch it") - (SETQ ASCENT NEWASCENT) - (SETQ DESCENT NEWDESCENT))) - (SETQ FORCEEND T) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (\RPLPTR CHLIST 0 (CHARCODE EOL)) - (\RPLPTR WLIST 0 (SETQ DX (IMAX DX 6))) - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ T1SPACE T) - (freplace (LINEDESCRIPTOR CR\END) of LINE with T) - (SETQ TX (IPLUS TX DX)) - (replace (LINEDESCRIPTOR LSTLN) of LINE with T) - (* ; - "This has to be done better when we get non-para breaking CRs.") - (RETURN)) - (TAB - (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") - - (replace (LINEDESCRIPTOR LHASTABS) of LINE with T) - (* ; "To disable smart screen update") - (COND - (NEWASCENT (* ; - "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (\RPLPTR CHLIST 0 CH) - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE CHLIST WLIST TX - DEFAULTTAB LEFTEDGE TABPENDING 0 NIL)) - (* ; - "Figure out which tab stop to use, and what we need to do to get there.") - [COND - ((FIXP TABPENDING) (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL)) - (TABPENDING (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX of TABPENDING] - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) - (SETQ DX (\GETBASEPTR WLIST 0)) - (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) of THISLINE - ) - PREVSP) (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) (* ; - "Also reset the count of spaces on this line, so we widen later spaces enough.") - (SETQ PREVSP 0) - (SETQ T1SPACE T) - (SETQ TX (IPLUS TX DX)) - (SETQ TXB TX) (* ; - "Remember the world in case this is the 'space' before the line breaks") - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - (PROGN (COND - ((AND (EQ CH (CHARCODE "0,377")) - (NOT (ffetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ))) - - (* ;; - "Character-set change character. This suggests undetected NS characters.") - - (\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM) - (* ; - "Leaves us ready to BIN again at the same place.") - - (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.") - - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add CHNO -1) - (add TLEN -1) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "Because moving to NS characters changes the TEXTLEN for the shorter.") - ) - (T - (* ;; "Not a formatting character, so gather") - - (SETQ GATHERBLANK T)(* ; "Blanks are interesting again.") - (COND - ((IGREATERP (SETQ TX (IPLUS TX DX)) - WIDTH) (* ; - "We're past the right margin; stop formatting at the last blank.") - (SETQ FORCEEND T) - [COND - (PREVDHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) - of LINE with CH#B) - (\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH) - 1) - (CHARCODE "-")) - (\RPLPTR ORIGWLIST (LLSH (SUB1 PREVDHYPH) - 1) - (\FGETCHARWIDTH FONT (CHARCODE "-"))) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (PREVHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) - of LINE with CH#B) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (T1SPACE (* ; - "There's a breaking point on this line. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) - of LINE with CH#B) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - ((IGREATERP TLEN 0) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with (IMAX (SUB1 CHNO) - CH#1)) - (SETQ TX (IDIFFERENCE TX DX)) - (* ; - "No spaces on this line; break it before this character.") - - (* ;; "Check line break character.") - - (while (OR (MEMBER (\GETBASEPTR CHLIST -2) - TEDIT.DONT.LAST.CHARS) - (MEMBER CH TEDIT.DONT.BREAK.CHARS)) - do - - (* ;; - "This character ch doesn't appear at first of lines. or") - - (* ;; - "Previous character doesn't appear at the end of lines.") - - (* ;; - "So,move previous character to next line.") - - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add TLEN -1) - (add CHNO -1) - (SETQ CH (\GETBASEPTR CHLIST 0))) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with (IMAX (SUB1 CHNO) - CH#1))) - (T (* ; - "Can't split BEFORE the first thing on the line!") - (freplace (LINEDESCRIPTOR CHARLIM) - of LINE with CHNO) - (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX) - (COND - (NEWASCENT - (* ; - "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL] - (RETURN)) - (T (* ; "Not past the rightmargin yet...") - (COND - (NEWASCENT (* ; - "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX) - (SELCHARQ CH - (%. (* ; "Check for decimal tabs") - (COND - ((AND TABPENDING (NOT (FIXP TABPENDING)) - (EQ (fetch PTTYPE of - TABPENDING - ) - 'DECIMAL)) - (* ; - "Figure out which tab stop to use, and what we need to do to get there.") - (add (fetch (PENDINGTAB PTTABX) - of TABPENDING) - DX) - (* ; - "Adjust the tab stop's X value so that the LEFT edge of the decimal point goes there.") - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ TABSPEC - THISLINE CHLIST WLIST TX - DEFAULTTAB LEFTEDGE TABPENDING 0 - T)) - (* ; - "Tab over to the LEFT side of the decimal point.") - [COND - ((FIXP TABPENDING) - (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL)) - (TABPENDING - (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX - of TABPENDING] - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) - (\TEDIT.PURGE.SPACES - (fetch (THISLINE CHARS) of - THISLINE) - PREVSP) - (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) - (* ; - "Also reset the count of spaces on this line, so we widen later spaces enough.") - (SETQ PREVSP 0) - (SETQ T1SPACE T) - (SETQ TXB TX) - (* ; - "Remember the world in case this is the 'space' before the line breaks") - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)))) - ((- "357,045") - (* ; "Hyphen, M-dash") - (SETQ PREVHYPH (ADD1 TLEN)) - (SETQ PREVDHYPH NIL) - (SETQ TXB1 (SETQ TXB TX)) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ CH#B CHNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,042" - (* ; "non-breaking hyphen") - (\RPLPTR CHLIST 0 (CHARCODE "-"))) - ("357,043" - (* ; "Discretionary hyphen") - (* ; "And isn't actually displayed.") - (SETQ PREVDHYPH (ADD1 TLEN)) - (SETQ PREVHYPH NIL) - (SETQ TXB1 (SETQ TXB TX)) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ CH#B CHNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (\RPLPTR WLIST 0 0) - (* ; - "Unless we use it, the prevhyph is 0 wide.") - (\RPLPTR CHLIST 0 NIL) - (add TX (IMINUS DX)) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,041" - (* ; "non-breaking space.")) - NIL] - (SETQ CHLIST (\ADDBASE CHLIST 2)) (* ; - "Move the pointers forward for the next character.") - (SETQ WLIST (\ADDBASE WLIST 2))) (* ; "End of char loop") - (COND - ((AND (IEQP TLEN 255) - (ILESSP CHNO TEXTLEN)) (* ; - "This line is too long for us to format??") - (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T))) - (COND - (TABPENDING (* ; - "There is a TAB outstanding. Go handle it.") - (add (fetch (PENDINGTAB PTTABX) of TABPENDING) - DX) (* ; - "Adjust the tab stop's X value so that the LEFT edge of the CR goes there.") - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE CHLIST WLIST TX DEFAULTTAB - LEFTEDGE TABPENDING 0 T)) - - (* ;; "Finish up processing the outstanding TAB. We get back the new X position, with that taken into account.") - - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL) - (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) of THISLINE) - PREVSP) (* ; - "Don't use the spaces before the TAB in justification.") - (SETQ PREVSP 0] - (T (* ; - "No text to go in this line; set Ascent/Descent to the default font from the window.") - [SETQ PC (AND (IGREATERP TEXTLEN 0) - (\CHTOPC TEXTLEN (fetch (TEXTOBJ PCTB) of TEXTOBJ] - (* ; - "Grab the last real part of the document, to get paragraph looks") - (\EDITSETA LOOKS 0 CLOOKS) (* ; - "Set up the initial looks so that \DISPLAYLINE doesn't complain") - (SETQ FONT (OR (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (fetch CLFONT of (fetch (TEXTOBJ CARETLOOKS) - of TEXTOBJ))) - (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch CLFONT of (fetch (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ))) - DEFAULTFONT)) - - (* ;; "The font we use is preferably the caret looks, else the default for this edit, else the system default") - - (SETQ ASCENT (FONTPROP FONT 'ASCENT)) - (SETQ DESCENT (FONTPROP FONT 'DESCENT)) - (SETQ FMTSPEC (OR FMTSPEC (AND PC (fetch (PIECE PPARALOOKS) of PC)) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) - (* ; - "Use the preceding paragraph's looks") - (SETQ 1STLN (OR (NOT PC) - (fetch (PIECE PPARALAST) of PC))) - (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) - [SETQ TX (COND - [1STLN (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS 8 (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch 1STLEFTMAR of FMTSPEC] - (T (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS 8 (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch LEFTMAR of FMTSPEC] - [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE - with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC))) - (fetch RIGHTMAR of FMTSPEC)) - (T (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ - ) - 8] - (SETQ TXB1 WIDTH))) - [COND - ((ZEROP (freplace (LINEDESCRIPTOR LHEIGHT) of LINE with (IPLUS ASCENT - DESCENT))) - (replace (LINEDESCRIPTOR LHEIGHT) of LINE - with (FONTPROP (OR (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch CLFONT of (fetch (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ))) - DEFAULTFONT) - 'HEIGHT] (* ; - "Line's height (or 12 for an empty line)") - (replace (LINEDESCRIPTOR ASCENT) of LINE with ASCENT) - (replace (LINEDESCRIPTOR DESCENT) of LINE with DESCENT) - (freplace (LINEDESCRIPTOR CHARTOP) of LINE with CHNO) - [COND - (FORCEEND NIL) - (T (SETQ CHNO (SUB1 CHNO)) - (SETQ TLEN (SUB1 TLEN] (* ; - "If we ran off the end of the text, then keep true space left on the line.") - (freplace (LINEDESCRIPTOR LXLIM) of LINE with TX) - [freplace (LINEDESCRIPTOR SPACELEFT) of LINE with (COND - (FORCEEND - (* ; - "The line was forced to end. Back up to start of last blank section") - (IDIFFERENCE WIDTH - TXB1)) - (GATHERBLANK - (* ; - "Otherwise, use the rightmost character on the line.") - (IDIFFERENCE WIDTH - TX)) - (T - - (* ;; "The line ended with a run of white space. Ignore it for purposes of deciding how much more we can fit on the line.") - - (IDIFFERENCE WIDTH TXB1 - ] - (freplace (THISLINE DESC) of THISLINE with LINE) - [freplace (THISLINE LEN) of THISLINE - with (IMIN 254 (COND - ((ILESSP TEXTLEN CH#1) - -1) - (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE) - TEXTLEN) - (IPLUS INVISIBLERUNS (fetch - (LINEDESCRIPTOR - CHAR1) of - LINE] - (\DOFORMATTING TEXTOBJ LINE (OR ORIGFMTSPEC FMTSPEC) - THISLINE %#BLANKS PREVSP 1STLN) - (replace (LINEDESCRIPTOR LFMTSPEC) of LINE with FMTSPEC) - (replace (TEXTSTREAM LOOKSUPDATEFN) of TEXTSTREAM with NIL) - (RETURN LINE]) - -(\TEDIT.NSCHAR.RUN - [LAMBDA (CHNO TEXTOBJ STREAM) (* ; "Edited 29-Apr-93 16:42 by jds") - - (* ;; "Given that we've just BIN'd from TEXTOBJ at character # CHNO and it was a 255, rearrange the piece table so that NS characters are available transparently %"as far ahead as makes sense%".") - - (* ;; "Leave TEXTOBJ ready to BIN at CHNO again, so the line formatter can carry on.") - - (LET* [(PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - PC START-OF-PIECE OFFSET PLEN CH NEXTCH PFPOS NEWPC NEWPLEN PF PS CHARSET TFILE - (OLDFILEPTR (SUB1 (GETFILEPTR STREAM] - (SETQ PC (\CHTOPC CHNO PCTB T)) - (SETQ OFFSET (- CHNO START-OF-PIECE)) - (SETQ PLEN (fetch (PIECE PLEN) of PC)) - (COND - ((fetch (PIECE PFATP) of PC) - (HELP "Hit charset change in a FAT piece"))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "This rearranges the piece table, so later insertions better use a fresh piece.") - (* ; "Back up over the 255") - (SETQ CH (BIN STREAM)) - [COND - [(IEQP CH 255) (* ; "A steady run of fat characters.") - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC)) - (* ; "This piece is in a string.") - (HELP "NS characters in a STRING??")) - ((SETQ PF (fetch (PIECE PFILE) of PC)) - (* ; "This piece is in a file.") - (SETQ PFPOS (fetch (PIECE PFPOS) of PC)) - (SETQ NEXTCH (FFILEPOS (MKSTRING (CHARACTER 255)) - PF - (IPLUS OFFSET PFPOS 3) - (IPLUS PFPOS PLEN))) (* ; - "Find the succeeding 255, or end of piece.") - [SETQ NEWPLEN (COND - (NEXTCH (IQUOTIENT (IDIFFERENCE NEXTCH (IPLUS PFPOS OFFSET 3)) - 2)) - (T (IQUOTIENT (IDIFFERENCE (IDIFFERENCE PLEN OFFSET) - 3) - 2] - (\DELETECH (IPLUS START-OF-PIECE OFFSET) - (IPLUS START-OF-PIECE OFFSET 5 (ITIMES NEWPLEN 2)) - (IPLUS 5 (ITIMES NEWPLEN 2)) - TEXTOBJ T) - (\TEDIT.INSERT.PIECES TEXTOBJ (IPLUS START-OF-PIECE OFFSET) - (create PIECE using PC PFILE _ PF PFPOS _ (IPLUS PFPOS OFFSET 3) - PFATP _ T PSTR _ NIL PLEN _ NEWPLEN) - NEWPLEN NIL NIL NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - NEWPLEN] - (T (* ; - "Changing to a new character set for succeeding characters.") - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC)) - (* ; "This piece is in a string.") - (HELP "NS characters in a STRING??")) - ((SETQ PF (fetch (PIECE PFILE) of PC)) - (* ; "This piece is in a file.") - (SETQ CHARSET CH) - (SETQ PFPOS (fetch (PIECE PFPOS) of PC)) - (SETQ NEXTCH (FFILEPOS (MKSTRING (CHARACTER 255)) - PF - (IPLUS OFFSET PFPOS 2) - (IPLUS PFPOS PLEN))) (* ; - "Find the succeeding 255, or end of piece.") - [SETQ NEWPLEN (COND - ((ZEROP CHARSET) (* ; "If we're moving back to charset 0, we just want to delete the charset change marker, so the newPlen is 0.") - 0) - (NEXTCH (IDIFFERENCE NEXTCH (IPLUS OFFSET PFPOS 2))) - (T (IDIFFERENCE (IDIFFERENCE PLEN OFFSET) - 2] - (\DELETECH (IPLUS START-OF-PIECE OFFSET) - (IPLUS START-OF-PIECE OFFSET 2 NEWPLEN) - (IPLUS NEWPLEN 2) - TEXTOBJ T) - (COND - ((ZEROP NEWPLEN) (* ; - "Do nothing if there weren't really any characters to be put in the new character set.") - ) - ((ZEROP CHARSET) (* ; - "Do nothing if we're switching back to normal character.") - ) - (T (* ; "There really are characters to be moved to the new character set. Create the temporary file for them.") - - (* ;; "Create the file") - - (SETQ TFILE (OPENSTREAM '{NODIRCORE} 'BOTH)) - (SETFILEPTR PF (IPLUS OFFSET PFPOS 2)) - (for I from 1 to NEWPLEN do - - (* ;; - "Copy the newly fattened characters into the temp file.") - - (BOUT TFILE CHARSET) - (BOUT TFILE (BIN PF))) - - (* ;; "Insert a new piece in the document holding the fat characters.") - - (\TEDIT.INSERT.PIECES TEXTOBJ (IPLUS START-OF-PIECE OFFSET) - (create PIECE - using PC PFILE _ TFILE PFPOS _ 0 PFATP _ T PSTR _ NIL PLEN _ - NEWPLEN) - 1 NIL NIL NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - NEWPLEN] - (\SETUPGETCH CHNO TEXTOBJ]) - -(\TEDIT.PURGE.SPACES - (LAMBDA (CHLIST PREVSP) (* jds " 9-NOV-83 17:12") - (bind OPREVSP while (IGREATERP PREVSP 0) do (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE)) - )))) - -(\DOFORMATTING - [LAMBDA (TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) - (* ; "Edited 29-Mar-94 12:36 by jds") - (* ; - "Do the formatting work for justified, centered, etc. lines") - (PROG ((QUAD (fetch QUAD of FMTSPEC)) - (SPACELEFT (LLSH (fetch (LINEDESCRIPTOR SPACELEFT) of LINE) - 5)) - (EXISTINGSPACE 0) - (CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (SPACEOFLOW 0) - EXTRASP OPREVSP LINELEAD) (* ; - "NB that SPACELEFT, OFLOW, etc. are kept in 32 x value form, for rounding ease.") - (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with (fetch (LINEDESCRIPTOR - DESCENT) - of LINE)) - (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with (fetch (LINEDESCRIPTOR - ASCENT) - of LINE)) - (* ; - "Save the true ascent value for display purposes") - (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1) - (* ; - "Start by assuming that we want a space factor of 1.0") - [COND - ((SETQ LINELEAD (fetch LINELEAD of FMTSPEC)) - (* ; - "If line leading was specified, set it") - (COND - (T (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LINELEAD of FMTSPEC)) - (* ; - "And adjust the line's descent accordingly") - (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LINELEAD of FMTSPEC] - [COND - ((AND 1STLN (fetch LEADBEFORE of FMTSPEC)) - (* ; - "If paragraph pre-leading was specified, set it") - (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADBEFORE of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") - (add (fetch (LINEDESCRIPTOR ASCENT) of LINE) - (fetch LEADBEFORE of FMTSPEC] - [COND - ((AND (fetch (LINEDESCRIPTOR LSTLN) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "If paragraph pre-leading was specified, set it") - (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") - (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LEADAFTER of FMTSPEC] - (SELECTQ QUAD - (LEFT (* ; - "Do nothing for left-justified lines except replace the character codes")) - (RIGHT (* ; "Just move the right margin over") - (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (fetch (LINEDESCRIPTOR SPACELEFT) of LINE))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch ( - LINEDESCRIPTOR - RIGHTMARGIN - ) - of LINE)) - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN)))) - (CENTERED (* ; - "Split the difference for centering") - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (LRSH SPACELEFT 6)) - (add (fetch (LINEDESCRIPTOR LXLIM) of LINE) - (LRSH SPACELEFT 6)) - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN)))) - (JUSTIFIED (* ; - "For justified lines, stretch each space so line reaches the right margin") - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN))) - (COND - ((OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; - "This is the last line in the paragraph; don't stretch it out.") - (SETQ EXTRASP 0)) - ((IEQP PREVSP (ADD1 (fetch (THISLINE LEN) of THISLINE))) - (* ; - "Only if the last character on the line is a space should we remove trailing spaces from the list") - (bind (OPREVSP _ (SUB1 PREVSP)) while (AND (IGREATERP PREVSP 0) - (ILEQ OPREVSP PREVSP) - ) - do - - (* ;; "Back up over all trailing white space on the line. So that those blanks don't get counted when computing the space to be added to each REAL space on the line, when it is justified.") - - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - (add %#BLANKS -1)) - (COND - ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks except at end-of-line, don't bother going further.") - (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE - with (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)) - (* ; - "Fix the right margin for showing selections &c") - (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) - (* ; - "Now apportion the extra space evenly among blanks.") - ) - (T - (* ;; - "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.") - - (COND - ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks, don't bother going further.") - (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE - with (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)) - (* ; - "Fix the right margin for showing selections &c") - (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) - (* ; - "Now apportion the extra space evenly among blanks.") - )) - [while (IGREATERP PREVSP 0) - do (* ; - "Fix up the widths of spaces in the line") - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (add EXISTINGSPACE (\EDITELT WLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - [OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (\EDITSETA WLIST OPREVSP (IPLUS (LRSH (IPLUS EXTRASP SPACEOFLOW - ) - 5) - (\EDITELT WLIST OPREVSP] - (SETQ SPACEOFLOW (LOGAND 31 (IPLUS EXTRASP SPACEOFLOW] - (COND - ([AND (NOT (ZEROP EXISTINGSPACE)) - (OR (NOT (ZEROP EXTRASP)) - (NOT (ZEROP (fetch (LINEDESCRIPTOR SPACELEFT) of LINE] - (* ; "Only if we really expanded the line -- and there are spaces to expand (or else EXISTINGSPACE is 0).") - (replace (THISLINE TLSPACEFACTOR) of THISLINE - with (FQUOTIENT (IPLUS EXISTINGSPACE (fetch (LINEDESCRIPTOR - SPACELEFT) - of LINE)) - EXISTINGSPACE)) - (* ; - "And set the space factor for display") - ) - (T (* ; "Pathological cases ") - (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1))) - (RETURN)) - NIL) - (\TEDIT.PURGE.SPACES CHLIST PREVSP) (* ; -"Change all the spaces--chained for justification--back into regular spaces, for the display code.") - ]) -) -(DEFINEQ - -(\DISPLAYLINE - [LAMBDA (TEXTOBJ LINE WINDOW) (* ; "Edited 28-Sep-2021 15:00 by rmk:") - - (* ;; "Display the line of text LINE in the edit window where it belongs.") - - (* ;; "Validate the incoming arguments so ffetch can be used consistently for all their field extractions.") - - (\DTEST TEXTOBJ 'TEXTOBJ) - (\DTEST LINE 'LINEDESCRIPTOR) - (LET ((LOOKS (ffetch (THISLINE LOOKS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ))) - (WINDOWDS (WINDOWPROP (OR WINDOW (CAR (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - 'DSP)) - (THISLINE (\DTEST (ffetch (TEXTOBJ THISLINE) of TEXTOBJ) - 'THISLINE)) - (OLDCACHE (fetch (LINECACHE LCBITMAP) of (ffetch (TEXTOBJ DISPLAYCACHE) - of TEXTOBJ))) - (DS (ffetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) - (HCPYDS (ffetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ)) - (HARDCOPYMODE (fetch (FMTSPEC FMTHARDCOPY) of (ffetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - CACHE OFONT OLOOKS XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT DDWIDTHCACHE - DDOFFSETCACHE CURY LHEIGHT SCALE) - [SETQ LHEIGHT (COND - ((ffetch (LINEDESCRIPTOR PREVLINE) of LINE) - (* ; - "So if theres a base-to-base measure, we clear everything right.") - (IMAX (IDIFFERENCE (ffetch (LINEDESCRIPTOR YBOT) - of (ffetch (LINEDESCRIPTOR PREVLINE) - of LINE)) - (ffetch (LINEDESCRIPTOR YBOT) of LINE)) - (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE))) - (T (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (SETQ SCALE (COND - (HARDCOPYMODE (* ; - "This is a hardcopy-mode line. Scale things.") - (DSPSCALE NIL HCPYDS)) - (T 1))) - (SETQ CACHE (\TEDIT.LINECACHE (ffetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ) - (COND - (HARDCOPYMODE (FIXR (FQUOTIENT (ffetch (LINEDESCRIPTOR RIGHTMARGIN - ) of LINE) - SCALE))) - (T (ffetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE))) - LHEIGHT)) - (COND - ((NEQ CACHE OLDCACHE) (* ; - "We changed the bitmaps because this line was bigger--update the displaystream, too") - (DSPDESTINATION CACHE DS) - (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch BITMAPWIDTH of CACHE) - HEIGHT _ (fetch BITMAPHEIGHT of CACHE)) - DS))) - (BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE) - (* ; "Clear the line cache") - [COND - ((AND (NOT (ZEROP (fetch (LINEDESCRIPTOR CHAR1) of LINE))) - (ILEQ (ffetch (LINEDESCRIPTOR CHAR1) of LINE) - (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (IGEQ (ffetch (LINEDESCRIPTOR YBOT) of LINE) - (ffetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - - (* ;; "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.") - - (COND - ((NEQ (fetch (THISLINE DESC) of THISLINE) - LINE) (* ; - "No image cache -- re-format and display") - (\FORMATLINE TEXTOBJ NIL (ffetch (LINEDESCRIPTOR CHAR1) of LINE) - LINE))) - (MOVETO (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (ffetch (LINEDESCRIPTOR DESCENT) of LINE) - DS) - (SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DS)) - (SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA)) - (SETQ XOFFSET (fetch DDXOFFSET of DISPLAYDATA)) - - (* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.") - - (SETQ CLIPLEFT (fetch DDClippingLeft of DISPLAYDATA)) - (* ; - "The left and right edges of the clipping region for the text display window.") - (SETQ CLIPRIGHT (fetch DDClippingRight of DISPLAYDATA)) - (SETQ OFONT (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS 0))) - DS)) (* ; "The starting font") - (SETQ DDWIDTHCACHE (ffetch DDWIDTHSCACHE of DISPLAYDATA)) - (* ; - "Cache the character-image widths") - (SETQ DDOFFSETCACHE (ffetch DDOFFSETSCACHE of DISPLAYDATA)) - (* ; - "And the offset-into-strike-bitmap array") - (* ; - "LOOKSTARTX: Starting X position for the current-looks text.") - (AND (fetch CLOFFSET of OLOOKS) - (RELMOVETO 0 (FIXR (FTIMES SCALE (fetch CLOFFSET of OLOOKS))) - DS)) (* ; - "Any sub- or superscripting at start of line") - (bind (LOOKNO _ 1) - DX CH (CHLIST _ (fetch (THISLINE CHARS) of (ffetch (TEXTOBJ THISLINE) - of TEXTOBJ))) - (WLIST _ (fetch (THISLINE WIDTHS) of (ffetch (TEXTOBJ THISLINE) - of TEXTOBJ))) - (TX _ (IPLUS XOFFSET (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))) - (TERMSA _ (ffetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) - (LOOKSTARTX _ (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) for - I - from 0 to (ffetch (THISLINE LEN) of THISLINE) - do - - (* ;; "Display the line character by character") - - (SETQ CH (\EDITELT CHLIST I)) (* ; - "Grab the character (or IMAGEOBJ) to display") - (SETQ DX (\EDITELT WLIST I)) (* ; "And its width") - [SELECTC CH - (LMInvisibleRun (* ; - "An INVISIBLE run -- skip it, and skip over the char count") - (add LOOKNO 1)) - (LMLooksChange (* ; "A LOOKS change") - (replace DDXPOSITION of DISPLAYDATA - with (IDIFFERENCE TX XOFFSET)) - (* ; - "Make the displaystream reflect our current X position") - (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS - (ffetch (LINEDESCRIPTOR DESCENT) of LINE)) - (* ; - "Make any necessary changes to the preceding characters (underline, strike-out &c)") - (DSPFONT (fetch CLFONT of (SETQ OLOOKS - (\EDITELT LOOKS LOOKNO))) - DS) (* ; "Set the new font") - (add LOOKNO 1) (* ; "Grab the next set of char looks") - (AND (fetch CLOFFSET of OLOOKS) - (RELMOVETO 0 (fetch CLOFFSET of OLOOKS) - DS)) (* ; "Account for super/subscripting") - (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)) - (* ; - "Remember the starting Xpos for possible later underlining &c") - ) - ((CHARCODE (TAB %#^I)) (* ; - "TAB: use the width from the cache to decide the right formatting.") - [COND - ((OR (IEQP CH (CHARCODE %#^I)) - (fetch CLLEADER of OLOOKS) - (EQ (fetch CLUSERINFO of OLOOKS) - 'DOTTEDLEADER)) - (LET* [[LEADERFONT (COND - (HARDCOPYMODE (FONTCOPY (fetch CLFONT - of OLOOKS) - 'DEVICE HCPYDS)) - (T (fetch CLFONT of OLOOKS] - (DOTWIDTH (CHARWIDTH (CHARCODE %.) - LEADERFONT)) - (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH - (IREMAINDER TX DOTWIDTH] - (while (ILEQ TTX (IPLUS TX DX)) - do (COND - (HARDCOPYMODE (MI-TEDIT.BLTCHAR - (CHARCODE %.) - DS - (FIXR (FQUOTIENT (IDIFFERENCE - TTX DOTWIDTH) - SCALE)) - DISPLAYDATA DDPILOTBBT CLIPRIGHT - )) - ((OR TERMSA HARDCOPYMODE) - (* ; - "Using special instrns from TERMSA") - (\DSPPRINTCHAR DS (CHARCODE %.))) - (T (* ; "Native charcodes") - (MI-TEDIT.BLTCHAR (CHARCODE %.) - DS - (IDIFFERENCE TTX DOTWIDTH) - DISPLAYDATA DDPILOTBBT CLIPRIGHT))) - (add TTX DOTWIDTH]) - ((CHARCODE (EOL LF CR)) (* ; "It's a CR") - NIL) - (NIL (* ; "NIL signifies a character we've suppressed as part of line formatting (e.g., a discretionary hyphen we didn't use to break the line). Show it as a thin black line.") - (BLTSHADE BLACKSHADE DS TX 0 1 100 'PAINT)) - (COND - [(SMALLP CH) (* ; - "Normal character -- just display it.") - (COND - (HARDCOPYMODE (MI-TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX SCALE)) - DISPLAYDATA DDPILOTBBT CLIPRIGHT)) - ((OR TERMSA HARDCOPYMODE) (* ; - "Using special instrns from TERMSA") - (\DSPPRINTCHAR DS CH)) - (T (* ; "Native charcodes") - (MI-TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT] - (T (* ; "CH is an object.") - (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) - XOFFSET) - (SETQ CURY (DSPYPOSITION NIL DS)) - DS) (* ; - "Go to the base line, left edge of the image region.") - (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN) - CH DS 'DISPLAY (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ - )) - (* ; - "Tell him to display himself here.") - (DSPFONT (fetch CLFONT of OLOOKS) - DS) - (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) - XOFFSET) - CURY DS) (* ; - "Move to after the object's image") - ] - (add TX DX) (* ; "Update our X position") - finally (replace DDXPOSITION of DISPLAYDATA - with (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) - XOFFSET)) (* ; - "Make any necessary looks mods to the last run of characters") - (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (ffetch (LINEDESCRIPTOR - DESCENT) - of LINE] - (BITBLT CACHE 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBOT) of LINE) - (ffetch (TEXTOBJ WRIGHT) of TEXTOBJ) - LHEIGHT - 'INPUT - 'REPLACE) (* ; - "Paint the cached image on the screen (this lessens flicker during update)") - (COND - ((fetch (FMTSPEC FMTREVISED) of (ffetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (* ; - "This paragraph has been revised, so mark it.") - (\TEDIT.MARK.REVISION TEXTOBJ (ffetch (LINEDESCRIPTOR LFMTSPEC) of LINE) - WINDOWDS LINE))) - (SELECTQ (ffetch (LINEDESCRIPTOR LMARK) of LINE) - (GREY (* ; - "This line has some property that isn't visible to the user. Tell him to be careful") - (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) - 6 6 'TEXTURE 'PAINT 42405)) - (SOLID (* ; - "This line has some property that isn't visible to the user. Tell him to be careful") - (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) - 6 6 'TEXTURE 'PAINT BLACKSHADE)) - (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) - 6 6 'TEXTURE 'REPLACE WHITESHADE]) - -(\TEDIT.LINECACHE - (LAMBDA (CACHE WIDTH HEIGHT) (* jds "21-Apr-84 00:52") - - (* Given a candidate line cache, return the bitmap, making sure it's at least - WIDTH by HEIGHT big.) - - (PROG ((BITMAP (fetch LCBITMAP of CACHE)) - CW CH) - (SETQ CW (fetch BITMAPWIDTH of BITMAP)) - (SETQ CH (fetch BITMAPHEIGHT of BITMAP)) - (COND - ((AND (IGEQ CW WIDTH) - (IGEQ CH HEIGHT)) - (RETURN BITMAP)) - (T (RETURN (replace LCBITMAP of CACHE with (BITMAPCREATE (IMAX CW WIDTH) - (IMAX CH HEIGHT))))))))) - -(\TEDIT.CREATE.LINECACHE - (LAMBDA (%#CACHES) (* jds "21-Apr-84 00:58") - - (* Create a linked-together set of LINECACHEs, for saving line images.) - - (PROG ((CACHES (for I from 1 to %#CACHES collect (create LINECACHE - LCBITMAP _ (BITMAPCREATE 100 15))))) - (for CACHE on CACHES do (* Link the caches together.) - (replace LCNEXTCACHE of (CAR CACHE) with (OR (CADR CACHE) - (CAR CACHES)))) - (RETURN CACHES)))) - -(\TEDIT.BLTCHAR - (LAMBDA (CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT) - (* jds " 9-Jan-86 17:14") - - (* Version of BLTCHAR peculiar to TEdit -- - relies on \DISPLAYLINE to make sure things keep working right.) - - (* puts a character on a guaranteed display stream. - Much of the information needed by the BitBlt microcode is prestored by the - routines that change it. This is kept in the BitBltTable.) - (* knows about the representation of - display stream image data) - (* MUST NOT POINT AT A WINDOW'S - DISPLAYSTREAM!!!) - - (* ASSUMES THAT WE NEVER WANT TO PRINT TO THE LEFT OF ORIGIN 0 ON THE LINE - CACHE BITMAP, OR THAT IF WE DO, ALL BETS ARE OFF) - - (DECLARE (LOCALVARS . T)) - (PROG (NEWX LEFT RIGHT IMAGEWIDTH (CHAR8CODE (\CHAR8CODE CHARCODE))) - (COND - ((NEQ (ffetch DDCHARSET of DISPLAYDATA) - (\CHARSET CHARCODE)) - (\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHARCODE)))) - (SETQ IMAGEWIDTH (\GETBASE (fetch DDCHARIMAGEWIDTHS of DISPLAYDATA) - (\CHAR8CODE CHARCODE))) - (SETQ NEWX (IPLUS CURX IMAGEWIDTH)) - (SETQ LEFT (IMAX 0 CURX)) - (SETQ RIGHT (IMIN CLIPRIGHT NEWX)) - (COND - ((ILESSP LEFT RIGHT) - - (* Only print anything if there is a place to put it) - - (UNINTERRUPTABLY - (freplace PBTDESTBIT of DDPILOTBBT with LEFT) - (* Set up the bitblt-table source left) - (freplace PBTWIDTH of DDPILOTBBT with (IMIN IMAGEWIDTH (IDIFFERENCE RIGHT LEFT))) - (freplace PBTSOURCEBIT of DDPILOTBBT with (\GETBASE (fetch DDOFFSETSCACHE - of DISPLAYDATA) - (\CHAR8CODE CHARCODE))) - (\PILOTBITBLT DDPILOTBBT 0)) - T))))) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(PUTPROPS MI-TEDIT.BLTCHAR MACRO [(CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT) - (COND - ((EQ 'MAIKO (MACHINETYPE)) - (SUBRCALL TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX DISPLAYDATA - DDPILOTBBT CLIPRIGHT)) - (T (\TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX DISPLAYDATA - DDPILOTBBT CLIPRIGHT]) -) -) -(DEFINEQ - -(TEDIT.CR.UPDATESCREEN - [LAMBDA (CH# XPOINT TEXTOBJ SEL LINE BLANKSEEN CRSEEN DS CHWIDTH DONTSCROLL) - (* ; "Edited 23-Feb-88 11:12 by jds") - - (* ;; "Update the edit window image after a CR is typed. Move any text after the CR to a new line, and push or pull text as needed.") - - (* ;; "(PROG ((WINDOW (fetch \WINDOW of TEXTOBJ)) (PREVLINE (fetch PREVLINE of LINE))) (COND ((AND (NOT (fetch CR\END of PREVLINE)) (ILEQ (IDIFFERENCE XPOINT (fetch LEFTMARGIN of LINE)) (IDIFFERENCE (fetch RIGHTMARGIN of PREVLINE) (fetch LXLIM of PREVLINE)))) (* This CR should push the start of the line back upward.) (replace DIRTY of PREVLINE with T) (replace TXTNEEDSUPDATE of TEXTOBJ with T))) (TEDIT.UPDATE.SCREEN TEXTOBJ PREVLINE T) (\FIXSEL SEL TEXTOBJ) (\SHOWSEL SEL NIL T) (COND (DONTSCROLL (* SO DO NOTHING)) ((OR (NOT (fetch NEXTLINE of LINE)) (ILEQ (fetch YBOT of (fetch NEXTLINE of LINE)) (fetch BOTTOM of (DSPCLIPPINGREGION NIL WINDOW)))) (* This pushed the caret off-screen. Move it up.) (replace EDITOPACTIVE of TEXTOBJ with NIL) (SCROLLW WINDOW 0 (LLSH (fetch LHEIGHT of (COND ((fetch NEXTLINE of LINE)) (LINE))) 1)))))") - - (HELP]) - -(TEDIT.DELETELINE - [LAMBDA (LINE TEXTOBJ WINDOW) (* ; "Edited 30-May-91 15:58 by jds") - - (* Remove a complete text line descriptor from the edit window, then move lower - lines up over it.) - - (PROG ((PREV (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (NEXT (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (* Fix up the line-descriptor chain - to dis-include line) - (COND - (PREV (replace (LINEDESCRIPTOR NEXTLINE) of PREV with NEXT))) - (COND - (NEXT (replace (LINEDESCRIPTOR PREVLINE) of NEXT with PREV))) - (\TEDIT.CLOSEUPLINES TEXTOBJ PREV NEXT NIL WINDOW) - (* And fix up the screen to cover - the blank space.) - ]) - -(TEDIT.INSERT.DISPLAYTEXT - [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 30-May-91 16:56 by jds") - (* This function does the actual - displaying of typed-in text on the - edit window.) - (* (PROG ((LOOKS ( - \TEDIT.APPLY.STYLES - (fetch (TEXTOBJ CARETLOOKS) of - TEXTOBJ) (fetch (TEXTOBJ \INSERTPC) - of TEXTOBJ) TEXTOBJ)) - (TERMSA (fetch (TEXTOBJ TXTTERMSA) - of TEXTOBJ)) DY FONT) - (DSPFONT (SETQ FONT - (fetch CLFONT of LOOKS)) DS) - (* Change the font) - (COND ((IGREATERP (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE ASCENT)) (fetch - (LINEDESCRIPTOR LTRUEASCENT) of LINE)) - (* The font this character is in is - taller than the existing line. - Adjust the LINEDESCRIPTOR's ascent.) - (\TEDIT.ADJUST.LINES TEXTOBJ LINE DS - (fetch (LINEDESCRIPTOR YBOT) of - (fetch (LINEDESCRIPTOR PREVLINE) of - LINE)) (IDIFFERENCE - (fetch (LINEDESCRIPTOR LTRUEASCENT) - of LINE) (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE ASCENT)))) (* Move other text - to allow for the new height) - (add (fetch (LINEDESCRIPTOR ASCENT) - of LINE) (IDIFFERENCE - (FONTPROP (fetch CLFONT of LOOKS) - (QUOTE ASCENT)) (fetch - (LINEDESCRIPTOR LTRUEASCENT) of LINE))) - (replace (LINEDESCRIPTOR LTRUEASCENT) - of LINE with (FONTPROP (fetch CLFONT of LOOKS) (QUOTE ASCENT))))) (COND ((IGREATERP - (FONTPROP (fetch CLFONT of LOOKS) - (QUOTE DESCENT)) (fetch - (LINEDESCRIPTOR LTRUEDESCENT) of - LINE)) (* If the caret's font will - change the line's descent, adjust - lower lines downward) - (\TEDIT.ADJUST.LINES TEXTOBJ - (fetch (LINEDESCRIPTOR NEXTLINE) of - LINE) DS (fetch (LINEDESCRIPTOR YBOT) - of LINE) (IDIFFERENCE (fetch (LINEDESCRIPTOR LTRUEDESCENT) of LINE) (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE DESCENT)))) - (add (fetch (LINEDESCRIPTOR DESCENT) - of LINE) (IDIFFERENCE - (FONTPROP (fetch CLFONT of LOOKS) - (QUOTE DESCENT)) (fetch - (LINEDESCRIPTOR LTRUEDESCENT) of - LINE))) (* Fix the line's - leading-adjusted descent to account - for this change) (replace - (LINEDESCRIPTOR LTRUEDESCENT) of - LINE with (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE DESCENT))) (* Also the - unadjusted descent) - (replace (LINEDESCRIPTOR YBOT) of - LINE with (IDIFFERENCE - (fetch (LINEDESCRIPTOR YBASE) of - LINE) (fetch (LINEDESCRIPTOR DESCENT) - of LINE))) (* And note our new location.))) (BITBLT DS XPOINT (fetch (LINEDESCRIPTOR YBOT) of - LINE) DS (IPLUS XPOINT CHWIDTH) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IDIFFERENCE (fetch - (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - XPOINT) (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) (QUOTE INPUT) (QUOTE REPLACE)) - (* Move the old text over) - (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - CHWIDTH (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) - (* Blank out the area we're going to - write into) (MOVETO XPOINT - (IPLUS (fetch (LINEDESCRIPTOR YBASE) - of LINE) (OR (fetch CLOFFSET of - LOOKS) 0)) DS) (* Set the display - stream position) (COND - (TERMSA (* Special terminal table - for controlling character display. - Use it.) (RESETLST - (RESETSAVE \PRIMTERMSA TERMSA) - (replace (TEXTSTREAM REALFILE) of - (fetch (TEXTOBJ STREAMHINT) of - TEXTOBJ) with DS) (COND - ((STRINGP CH) (for CHAR instring CH - do (SELCHARQ CHAR (TAB - (* Put down white) - (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - 36 (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CHAR FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (\DSPPRINTCHAR (fetch - (TEXTOBJ STREAMHINT) of TEXTOBJ) - CHAR)))) (T (SELCHARQ CH - (TAB (* Put down white) - (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - 36 (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CH FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (\DSPPRINTCHAR (fetch - (TEXTOBJ STREAMHINT) of TEXTOBJ) CH)))))) - (T (* No special handling; - just use native character codes) - (COND ((STRINGP CH) - (for CHAR instring CH do - (SELCHARQ CHAR (TAB - (* Put down white) - (BITBLT NIL 0 0 DS - (DSPXPOSITION NIL DS) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - 36 (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS - (DSPXPOSITION NIL DS) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CHAR FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (BLTCHAR CHAR DS)))) - (T (SELCHARQ CH (TAB - (* Put down white) - (BITBLT NIL 0 0 DS - (DSPXPOSITION NIL DS) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - 36 (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (* Blank out the CR's width.) - (BITBLT NIL 0 0 DS - (DSPXPOSITION NIL DS) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CH FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (BLTCHAR CH DS)))))) - (BITBLT NIL 0 0 DS - (fetch (LINEDESCRIPTOR LXLIM) of - LINE) (fetch (LINEDESCRIPTOR YBOT) - of LINE) (fetch (TEXTOBJ WRIGHT) of - TEXTOBJ) (fetch (LINEDESCRIPTOR - LHEIGHT) of LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE) - (* Clear after EOL) - (TEDIT.MODIFYLOOKS LINE XPOINT DS - LOOKS (fetch (LINEDESCRIPTOR YBASE) - of LINE)) (* Do underlining, - strike-out, etc.))) - (HELP]) - -(TEDIT.INSERT.UPDATESCREEN - [LAMBDA (CH CH# CHARS XPOINT TEXTOBJ SEL OTEXTLEN BLANKSEEN CRSEEN DONTSCROLL INCREMENTAL) - (* ; "Edited 30-May-91 16:06 by jds") - (* ; - "Update the edit window after an insertion") - (PROG ((THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - SELINE EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES - NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE) - (replace (SELECTION CH#) of SEL with (IPLUS CHARS CH#)) - (* ; - "These must be here, since SELs are valid even without a window.") - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) of SEL)) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (COND - ((AND INCREMENTAL (\SYSBUFP)) - - (* ;; "We're doing incremental updates, and there's type-in waiting. Bail out, now that we have fixed up the selection.") - - (RETURN)) - ((fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ) - (* ; - "Don't update the screen if updates are being inhibited.") - (RETURN)) - ((NOT WINDOW) (* ; - "If this textobj has no window to update, don't bother") - (RETURN)) - ((OR T (LISTP WINDOW) - (TEXTPROP TEXTOBJ 'SLOWUPDATE)) (* ; - "FOR NOW, ALWAYS UPDATE THE SCREEN THE HARD WAY") - (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T (fetch (SELECTION CH#) of SEL)) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (\COPYSEL SEL TEDIT.SELECTION) - [for WW inside WINDOW as L1 inside (fetch (SELECTION L1) of SEL) - as LN inside (fetch (SELECTION LN) of SEL) as L1LIST - on (fetch (SELECTION L1) of SEL) as LNLIST - on (fetch (SELECTION LN) of SEL) - do (COND - (DONTSCROLL - - (* ;; "If scrolling is suppressed, don't bother with the next check:") - - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WW)) - [(EQ WW (fetch (TEXTOBJ SELWINDOW) of TEXTOBJ)) - (COND - ([OR (NULL (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT L1) - (RIGHT LN) - NIL)) - (ILEQ (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (LINEDESCRIPTOR YBOT) of L1)) - (RIGHT (fetch (LINEDESCRIPTOR YBOT) of LN)) - 0) - (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL WW] - - (* ;; - "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.") - - (while (OR [COND - ((SETQ SELINE (SELECTQ (fetch (SELECTION POINT) - of SEL) - (LEFT (CAR L1LIST)) - (RIGHT (CAR LNLIST)) - NIL)) - (ILESSP (fetch (LINEDESCRIPTOR YBOT) of SELINE - ) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - (T (ILESSP (fetch (SELECTION Y0) of SEL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (AND (IGEQ (fetch (SELECTION Y0) of SEL) - (fetch (TEXTOBJ WTOP) of TEXTOBJ)) - (NULL SELINE))) - do - - (* ;; "The caret just went off-screen. Move it up some.") - - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with - NIL) - (SCROLLW WW 0 (LLSH (COND - [(SELECTQ (fetch (SELECTION POINT) - of SEL) - (LEFT (CAR L1LIST)) - (RIGHT (CAR LNLIST)) - NIL) - (fetch (LINEDESCRIPTOR LHEIGHT) - of (SELECTQ (fetch - (SELECTION POINT) - of SEL) - (LEFT (CAR L1LIST)) - (RIGHT (CAR LNLIST)) - (SHOULDNT] - (T 12)) - 1] - (T (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WW] - (\COPYSEL SEL TEDIT.SELECTION]) - -(TEDIT.UPDATE.SCREEN - [LAMBDA (TEXTOBJ STARTINGLINE INCREMENTAL? NEXTCARETCH#) - (* ; "Edited 30-May-91 15:58 by jds") - (* Update the screen, as needed to - fix up "dirty" lines.) - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (COND - ((NOT (fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ)) - (* ; - "Only update the screen if we aren't suppressing updating.") - (bind NLINE for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - as LINE inside (OR STARTINGLINE (fetch (TEXTOBJ LINES) of TEXTOBJ)) - do (SETQ NLINE (\TEDIT.FIXCHANGEDPART TEXTOBJ LINE WW INCREMENTAL? NEXTCARETCH#)) - (* The last line in the edit window) - (AND NLINE (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of NLINE) - NLINE TEXTOBJ NIL WW NEXTCARETCH#]) - -(\BACKFORMAT - [LAMBDA (LINES TEXTOBJ WHEIGHT) (* ; "Edited 30-May-91 15:58 by jds") - - (* Move back to the next preceding CR (to guarantee a line break)%, then format - lines to reach where we are now.) - (* LINES is the dummy first line for - this window in TEXTOBJ) - - (* Returns a pointer to the last of the back-formatted lines - (i.e., the one that comes latest in the document)%, or to LINES if no lines are - formatted) - - (PROG ((LINE1 (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - CH1 CHNO CH NLINE) - [SETQ CH1 (COND - (LINE1 (fetch (LINEDESCRIPTOR CHAR1) of LINE1)) - (T (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - (COND - ((ILEQ CH1 1) (* No more lines can be formatted -- - we're at the front of the file.) - (RETURN LINES)) - (T (* There is more to do.) - (\SETUPGETCH (IDIFFERENCE CH1 1) - TEXTOBJ) - [for old CHNO from (IDIFFERENCE CH1 2) to 1 by -1 - do (* Back up until we find a CR) - (SETQ CH (\GETCHB TEXTOBJ)) - (COND - ((EQ CH (CHARCODE CR)) - (RETURN] - (SETQ CHNO (IMAX (ADD1 CHNO) - 1)) (* But never further than the front - of the document) - (while (ILEQ CHNO (SUB1 CH1)) do (* Now move forward, formatting - lines until we catch up with where - we were.) - (SETQ NLINE (\FORMATLINE TEXTOBJ NIL CHNO - )) - (* Format the next line) - (replace (LINEDESCRIPTOR YBOT) - of NLINE with WHEIGHT) - (* Make sure it thinks it's - off-window) - (replace (LINEDESCRIPTOR YBASE) - of NLINE with WHEIGHT) - (replace (LINEDESCRIPTOR PREVLINE) - of NLINE with LINES) - (* Hook it onto the end of the chain) - (replace (LINEDESCRIPTOR NEXTLINE) - of LINES with NLINE) - (SETQ LINES NLINE) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR - CHARLIM) - of NLINE))) - (* And find the start of the next - line)) - (replace (LINEDESCRIPTOR NEXTLINE) of NLINE with LINE1) - - (* Now, with the final line we formatted, hook the rest of the line chain onto - it.) - - (AND LINE1 (replace (LINEDESCRIPTOR PREVLINE) of LINE1 with NLINE)) - (RETURN NLINE]) - -(\FILLWINDOW - [LAMBDA (YBOT CURLINE TEXTOBJ DONTFILLFLG WINDOW NEXTCARETCH#) - (* ; "Edited 30-May-91 16:57 by jds") - (* Fill out TEXTOBJ's window, - starting with the line after - CURLINE, whose ybottom is YBOT) - (* Return T if any lines are moved - up.) - (* DONTFILLFLG => Don't bother - printing any new lines at the bottom - of the screen.) - - (* NEXTCARETCH# => always format to at least this CH#, to assure that we know - where the caret will next be.) - - (PROG* ((LINE (fetch (LINEDESCRIPTOR NEXTLINE) of CURLINE)) - (CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of CURLINE)) - (PREVLINE CURLINE) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (LINES\DELETED NIL) - (WINDOW (OR WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - (WHEIGHT (WINDOWPROP WINDOW 'HEIGHT)) - NEXTLINE OFLOWFN) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) - (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT)) do (* Do not start with a line which is - above the top of the screen.) - (SETQ PREVLINE LINE) - (SETQ CHARLIM (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE)) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE))) - [repeatwhile (ILESSP CHARLIM TEXTLEN) - do (* Walk thru the lines below the - starting line.) - [COND - ((AND LINE (IGEQ (SETQ YBOT (\TEDIT.NEXT.LINE.BOTTOM YBOT LINE PREVLINE)) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - (* If there is a line to display, - and space to display it, go ahead.) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) - (\DISPLAYLINE TEXTOBJ LINE WINDOW)) - [(AND LINE NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - NEXTCARETCH#)) - (* There's a line, and it's earlier - than the next caret location. - Keep going.) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE] - (LINE (* There is a line, but it won't - fit.) - [COND - ((fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of PREVLINE))) - (T (SETQ YBOT (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - - (* This existing line won't fit. Punt out of this, setting YBOT so the screen - gets cleared right.) - - [COND - ((SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (* Try calling any user-supplied - overflow fn, to handle the space - overflow) - (AND (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETFROM '\FILLWINDOW NIL] - (RETURN)) - (DONTFILLFLG (* We are instructed NOT to try - filling the screen, so punt out.) - (RETURN)) - ((OR (ILESSP CHARLIM TEXTLEN) - (AND (IEQP CHARLIM TEXTLEN) - (fetch (LINEDESCRIPTOR CR\END) of CURLINE)) - (ZEROP TEXTLEN)) (* No existing lines to display, but - there's text left (or the doc is - empty and we need a dummy first line)) - (SETQ LINE (\FORMATLINE TEXTOBJ NIL (ADD1 CHARLIM))) - (* Format the next line) - (replace (LINEDESCRIPTOR PREVLINE) of LINE with PREVLINE) - (* Hook it into the chain of line - descriptors) - (replace (LINEDESCRIPTOR NEXTLINE) of LINE - with (SETQ NEXTLINE (fetch (LINEDESCRIPTOR NEXTLINE) of - PREVLINE - ))) - (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with LINE) - (AND NEXTLINE (replace (LINEDESCRIPTOR PREVLINE) of NEXTLINE - with LINE)) - (COND - ((IGEQ [COND - [(fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) - (SETQ YBOT (IDIFFERENCE (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of PREVLINE)) - (IPLUS (fetch FMTBASETOBASE - of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE] - (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE] - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* If there's room, display the new - line) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE)) - ) - (\DISPLAYLINE TEXTOBJ LINE WINDOW)) - [(AND NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - NEXTCARETCH#)) - - (* This line is needed to find the next caret location, even tho it won't fit - on the screen) - - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE] - (T (* Otherwise, we've overflown the - window again) - (SETQ YBOT (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE))) - [COND - ((SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (AND (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETFROM '\FILLWINDOW NIL] - (RETURN] - (COND - (LINE (* Move forward to the next line in - the chain, if any) - (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (T (* Otherwise, note that we ran off - the end of the file.) - (SETQ CHARLIM (ADD1 TEXTLEN] - (while LINE do - - (* If there are any existing lines which didn't fit, set their YBOTs to 0 so - they don't show) - - [AND (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - TEXTLEN) - (replace (LINEDESCRIPTOR YBOT) of LINE - with (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (COND - ((IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* If there is space left at the - bottom of the window, blank it out.) - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IDIFFERENCE YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE))) - (COND - ((AND PREVLINE (fetch (LINEDESCRIPTOR CR\END) of PREVLINE) - (OR (ILESSP (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - WHEIGHT) - (ILEQ (fetch (LINEDESCRIPTOR CHARTOP) of PREVLINE) - 0)) - (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE) - TEXTLEN)) (* If the last line ends in a CR, - put a dummy line below it.) - [SETQ LINE (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE - with (\FORMATLINE TEXTOBJ NIL (ADD1 TEXTLEN] - (replace (LINEDESCRIPTOR PREVLINE) of LINE with PREVLINE) - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE - (fetch (LINEDESCRIPTOR - YBOT) - of PREVLINE) - (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE))) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IDIFFERENCE - (fetch (LINEDESCRIPTOR - YBOT) - of PREVLINE) - (fetch (LINEDESCRIPTOR - ASCENT) - of LINE))) - (replace (LINEDESCRIPTOR CHARLIM) of LINE with (ADD1 TEXTLEN)) - (SETQ PREVLINE LINE))) - (COND - ((AND (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE) - TEXTLEN) - (NOT (fetch (LINEDESCRIPTOR CR\END) of PREVLINE))) - (* This line lies at end of text, so - chop off any following lines.) - (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with NIL))) - (RETURN LINES\DELETED]) - -(\FIXDLINES - [LAMBDA (LINES SEL CH#1 CH#LIM TEXTOBJ) (* ; "Edited 30-May-91 15:59 by jds") - - (* ;; - "Fix up the list LINES of line descriptors, given that characters CH#1 thru CH#LIM were deleted.") - - (* ;; "Change CHAR1 and CHARLIM entries in each descriptor, and remove any descriptors for lines which disappeared entirely.") - - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - - (* ;; "Only do this if we're allowed to change the document.") - - (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (SETQ LINES (WINDOWPROP WW 'LINES)) - (PROG ((NLINES LINES) - (DCH (IDIFFERENCE CH#LIM CH#1)) - (CH#1L (SUB1 CH#1)) - PL NL CHARLIM) - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - CHARLIM CHAR1 while LINE - do (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) - (SETQ CHAR1 (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (COND - [(ILESSP CHARLIM CH#1) - (COND - ((AND (IGEQ CH#1 CHAR1) - (ILEQ CH#1 (fetch (LINEDESCRIPTOR CHARTOP) - of LINE))) - - (* ;; "This change happened in a place where it may affect this line's break decision. Better reformat to be safe.") - - (replace (LINEDESCRIPTOR DIRTY) of LINE with - T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ - with T)) - ((AND (fetch (LINEDESCRIPTOR CR\END) of LINE) - (IEQP CHARLIM CH#1L)) - - (* ;; "This line ends in CR, and the deletion starts immediately thereafter. Best to reformat, for safety.") - - (replace (LINEDESCRIPTOR DIRTY) of LINE with - T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ - with T] - ((IGEQ CHAR1 CH#LIM) (* ; - "This line contains none of the deleted text but is after it. Update CHAR1, CHARLIM and CHARTOP") - (replace (LINEDESCRIPTOR CHAR1) of LINE - with (IMAX 1 (IDIFFERENCE CHAR1 DCH))) - (replace (LINEDESCRIPTOR CHARLIM) of LINE - with (IDIFFERENCE CHARLIM DCH)) - (replace (LINEDESCRIPTOR CHARTOP) of LINE - with (IDIFFERENCE (fetch (LINEDESCRIPTOR CHARTOP) - of LINE) - DCH))) - [(OR (ILESSP CHAR1 CH#1) - (IGEQ CHARLIM CH#LIM)) - (* ; - "This line contains some of the deleted text, mark it as dirty and update CHAR1 and CHARLIM") - (replace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with - T) - (replace (LINEDESCRIPTOR CHAR1) of LINE - with (IMAX 1 (IMIN CHAR1 CH#1))) - (COND - [(IGEQ CHARLIM CH#LIM) - (replace (LINEDESCRIPTOR CHARLIM) of LINE - with (IDIFFERENCE CHARLIM (IMIN DCH (IDIFFERENCE - CH#LIM CHAR1] - (T (replace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#1L] - (T (* ; - "This line is totally within the deleted text, remove it") - (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - (SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (COND - (PL (replace (LINEDESCRIPTOR NEXTLINE) of PL - with NL))) - (COND - (NL (replace (LINEDESCRIPTOR PREVLINE) of NL - with PL))) - (COND - ((EQ NLINES LINE) - (SETQ NLINES NL))) - (replace (LINEDESCRIPTOR DELETED) of LINE with - T) - (* ; - "Mark this line deleted, so DELETETEXTCHARS know to ignore it.") - (AND NL (replace (LINEDESCRIPTOR DIRTY) of NL - with T))(* ; - "This may well force a reformatting of the next line. Mark it dirty just in case.") - )) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) (* ; - "Fix up the selections in this textobj") - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) - (RETURN NLINES]) - -(\FIXILINES - [LAMBDA (TEXTOBJ SEL CH#1 DCH OTEXTLEN) (* ; "Edited 30-May-91 16:07 by jds") - - (* ;; - "Fix the list LINES of line descriptors to account for DCH characters inserted before CH#1") - - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - - (* ;; "Only make this change if you're allowed to change the document.") - - (LET (LINES CH# CHLIM CHAR1 CHARLIM) - (SETQ CH#1 (IMAX CH#1 1)) (* ; - "Make sure we're inserting in a legit spot.") - [for WW inside (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as L1 - in (fetch (SELECTION L1) of SEL) - do - - (* ;; "For each pane in the editing window, examine the pane's list of lines") - - (bind [LINE _ (COND - ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINES) - 0) (* ; - "Make sure to skip the initial dummy line") - LINES) - (T (ffetch (LINEDESCRIPTOR NEXTLINE) of LINES] - while LINE do (\DTEST LINE 'LINEDESCRIPTOR) - (COND - ((IGREATERP (SETQ CHAR1 (ffetch (LINEDESCRIPTOR - CHAR1) - of LINE)) - CH#1) - (* ; - "This line starts after the insertion point. Update it's CHAR1") - (freplace (LINEDESCRIPTOR CHAR1) of LINE - with (IPLUS CHAR1 DCH))) - ((AND (IEQP CH#1 CHAR1) - (NEQ LINE L1)) - (* ; - "The insertion is at the end of the PRIOR line--so go ahead and update this CHAR1") - (freplace (LINEDESCRIPTOR CHAR1) of LINE - with (IPLUS CHAR1 DCH)) - (COND - ((ffetch (LINEDESCRIPTOR PREVLINE) - of LINE) - (freplace (LINEDESCRIPTOR DIRTY) - of (ffetch (LINEDESCRIPTOR PREVLINE) - of LINE) with T))) - (freplace (LINEDESCRIPTOR DIRTY) of LINE - with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of - TEXTOBJ - with T)) - ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) - of LINE) - CH#1)(* ; - "This line spans the insert point. Mark it DIRTY.") - (freplace (LINEDESCRIPTOR DIRTY) of LINE - with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of - TEXTOBJ - with T)) - ((AND (IGEQ (SETQ CHARLIM (ffetch ( - LINEDESCRIPTOR - CHARLIM) - of LINE)) - OTEXTLEN) - (NOT (ffetch (LINEDESCRIPTOR CR\END) - of LINE))) - - (* ;; "This line is the last in the file, and its CHAR1 is <= the insert point, and it doesn't end in a CR. Therefore, move the line's end upward to accomodate the insertion.") - - (freplace (LINEDESCRIPTOR DIRTY) of LINE - with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of - TEXTOBJ - with T))) - [COND - ([OR (IGEQ (SETQ CHARLIM (ffetch (LINEDESCRIPTOR - CHARLIM) - of LINE)) - CH#1) - (AND (IGEQ CHARLIM OTEXTLEN) - (NOT (ffetch (LINEDESCRIPTOR CR\END) - of LINE] - (freplace (LINEDESCRIPTOR CHARLIM) of - LINE - with (IPLUS CHARLIM DCH)) - (COND - ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) - of LINE) - CH#1) - (freplace (LINEDESCRIPTOR CHARTOP) - of LINE - with (IPLUS (ffetch (LINEDESCRIPTOR - CHARTOP) - of LINE) - DCH] - (SETQ LINE (ffetch (LINEDESCRIPTOR NEXTLINE) - of LINE] - (\TEDIT.FIXINSSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - TEXTOBJ CH#1 DCH) - (\TEDIT.FIXINSSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - TEXTOBJ CH#1 DCH) - (\TEDIT.FIXINSSEL SEL TEXTOBJ CH#1 DCH]) - -(\SHOWTEXT - [LAMBDA (TEXTOBJ LINES WINDOW) - - (* ;; "Edited 12-Jan-2022 18:56 by rmk: I took out the WAITINGCURSOR, the resetsave wasn't working for some reason, and it really isn't necessary for modern machines.") - - (* ;; "Edited 12-Jun-90 19:22 by mitani") - - (* ;; "Fill the editor window with text, starting from the top of the file.") - - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* ; - "If there is no edit window, just return.") - (PROG1 (PROG (WREG) - (SETQ WINDOW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) - (DSPFILL (PROG1 (DSPCLIPPINGREGION NIL WINDOW) - (* ; "For region within a window:") - - (* ;; "(CREATEREGION (fetch (TEXTOBJ WLEFT) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) (fetch (TEXTOBJ WLEFT) of TEXTOBJ)) (IDIFFERENCE (fetch (TEXTOBJ WTOP) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)))") - - ) - WHITESHADE - 'REPLACE WINDOW) (* ; "Clear the window.") - (RETURN (RESETLST - - (* ;; "RMK: For reasons unknown, the original cursor is not restored when this exits. But there is presumably no need for this waiting indicator in modern times. This only fills lines visible within a window, and machines are really fast.") - - (* ;; "Display the hourglass cursor as we work") - - (AND NIL (RESETSAVE (CURSOR WAITINGCURSOR))) - (SETQ LINES - (create LINEDESCRIPTOR - YBOT _ (WINDOWPROP WINDOW 'HEIGHT) - CHAR1 _ 0 - CHARLIM _ 0 - SPACELEFT _ -1 - RIGHTMARGIN _ (SUB1 (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) - NEXTLINE _ NIL - CHARTOP _ -1 - LHEIGHT _ 0 - LXLIM _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - CR\END _ T - ASCENT _ 0 - DESCENT _ 0 - LTRUEASCENT _ 0 - LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC)) - (* ; - "Make sure we have the anchor pseudo-line") - (WINDOWPROP WINDOW 'LINES LINES) - (\FILLWINDOW (WINDOWPROP WINDOW 'HEIGHT) - LINES TEXTOBJ NIL WINDOW) - (* ; "Fill the window as usual") - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW) - LINES)]) - -(\TEDIT.ADJUST.LINES - [LAMBDA (TEXTOBJ FIRSTLINE WINDOW LINETOP DY) (* ; "Edited 30-May-91 15:59 by jds") - - (* Move all lines from FIRSTLINE (inclusive) on up or down. - Fill in a line or drop one off, accordingly. - Positive DY means move UP.) - - (* LINETOP is the top of the region to be moved as the adjustment is made. - It corresponds to the TOP of FIRSTLINE.) - - (PROG ((OFLOW NIL) - OFLOWFN OYBOT PREVLINE) - [COND - ((ZEROP DY) (* This line's total height HAS NOT - CHANGED. Don't make any adjustments.) - ) - ((ILESSP LINETOP (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* This line is off the screen. - Don't bother adjusting it.) - ) - (FIRSTLINE - - (* This line's total height changed -- must move the rest of the window, and - adjust YBOT/BASEs.) - - (bind (LL _ FIRSTLINE) while (AND LL (IGEQ (fetch (LINEDESCRIPTOR - YBOT) of - LL) - (fetch (TEXTOBJ WBOTTOM) - of TEXTOBJ))) - do - - (* Loop thru the line descriptors that are affected by the change - (i.e., those below it)%, and adjust their Y locations.) - - (SETQ OYBOT (fetch (LINEDESCRIPTOR YBOT) of LL)) - [COND - ((ILESSP (replace (LINEDESCRIPTOR YBOT) of LL - with (IPLUS OYBOT DY)) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* This line moved below the bottom - of the screen) - (BITBLT NIL 0 0 WINDOW 0 OYBOT (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - (fetch (LINEDESCRIPTOR LHEIGHT) of LL) - 'TEXTURE - 'REPLACE WHITESHADE) (* So clear the space it used to - occupy.) - (COND - ((AND (SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (SETQ OFLOW T) - (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETURN NIL)) - - (* We walked off the bottom, and the user gave us an OFLOWFN to handle it. - Give it a try.) - - ] - (add (fetch (LINEDESCRIPTOR YBASE) of LL) - DY) (* Adjust the baseline of the line, - as well as its physical bottom.) - (replace (LINEDESCRIPTOR YBOT) of LL - with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LL) - (fetch (LINEDESCRIPTOR DESCENT) of LL))) - (* I realize this looks redundant, - but the line's descent may have - changed, too.) - (SETQ PREVLINE LL) - - (* Remember the prior line, since we'll need it if we later try to fill out the - window with more text.) - - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL)) - (* Move to the next line.)) - (AND OFLOW (RETURN NIL)) - - (* If there was an overflow, and it got handled by the user's OFLOWFN, don't - bother trying anything further.) - - (COND - [(IGREATERP DY 0) (* The line is shorter; - move the rest up.) - (BITBLT WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - WINDOW 0 (IPLUS DY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - LINETOP - 'INPUT - 'REPLACE) (* Move the text up) - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - DY - 'TEXTURE - 'REPLACE WHITESHADE) (* Now clear the bottom part of the - window, which got vacated by the - adjustment) - (COND - ((AND PREVLINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - - (* If there is space left on the screen, try to fill it with new text.) - - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - PREVLINE TEXTOBJ NIL WINDOW] - (T (* The line is taller; - move the rest down.) - (BITBLT WINDOW 0 (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (IMINUS DY)) - WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IDIFFERENCE LINETOP (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'INPUT - 'REPLACE) (* Move the text down) - (BITBLT NIL 0 0 WINDOW 0 (IPLUS LINETOP DY) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IMINUS DY) - 'TEXTURE - 'REPLACE WHITESHADE) (* Now clear the region we moved it - out of.) - ] - (RETURN T]) - -(\TEDIT.CLEAR.SCREEN.BELOW.LINE - [LAMBDA (TEXTOBJ WINDOW LINE) (* ; "Edited 30-May-91 15:59 by jds") - (* Clears the edit window to white, - clearing only the sapce below the - line given.) - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE]) - -(\TEDIT.CLOSEUPLINES - [LAMBDA (TEXTOBJ PREVLINE NEXTLINE DONTFILLFLG WINDOW) (* ; "Edited 30-May-91 15:59 by jds") - - (* ;; "Given a gap between PREVLINE and NEXTLINE, move NEXTLINE et seq up to coverthe gap, and adjust the YBOTs. If DONTFILLFLG is T then we're not filling the screen") - (* ; - "NEXTLINE = NIL => remove all lower lines.") - (COND - (PREVLINE (* ; - "PREVLINE = NIL => DON'T close up anything.") - (PROG [DY (WWIDTH (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (fetch (TEXTOBJ WLEFT) of TEXTOBJ))) - (LOWESTY (COND - (PREVLINE (fetch (LINEDESCRIPTOR YBOT) of PREVLINE)) - (T (ADD1 (fetch (TEXTOBJ WTOP) of TEXTOBJ] - [COND - (NEXTLINE (* ; - "If the gap isn't at the end, move whatever else up over it.") - [SETQ DY (IDIFFERENCE LOWESTY (IPLUS (fetch (LINEDESCRIPTOR YBOT) - of NEXTLINE) - (fetch (LINEDESCRIPTOR LHEIGHT - ) of - NEXTLINE - ] - (AND (ILEQ DY 0) - (RETURN)) (* ; - "If there's no gap, don't bother with anything else.") - (BITBLT WINDOW (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - WINDOW - (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (IPLUS DY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - WWIDTH - (IPLUS (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) - of NEXTLINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (fetch (LINEDESCRIPTOR LHEIGHT) of NEXTLINE)) - 'INPUT - 'REPLACE) (* ; - "Move the remaining lines upward.") - (bind (LINE _ NEXTLINE) - (NYBOT _ LOWESTY) while LINE - do (* ; - "Scan the remaining lines, fixing up the vertical spacing information") - (SETQ NYBOT (IDIFFERENCE NYBOT (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE))) - (COND - ((IGEQ NYBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (SETQ LOWESTY NYBOT))) - [COND - [(ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* ; - "Line is off screen. Display it at the right spot.") - (AND DONTFILLFLG (RETURN)) - (* ; - "If we're not filling the screen, then stop here.") - (replace (LINEDESCRIPTOR YBOT) of LINE - with NYBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS NYBOT (fetch (LINEDESCRIPTOR - DESCENT) - of LINE))) - (\DISPLAYLINE TEXTOBJ LINE WINDOW) - (COND - ((fetch (LINEDESCRIPTOR NEXTLINE) of LINE) - (* ; - "There's a next line after the current one. Use it") - ) - ((IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of - LINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "We're at the end of the text; don't bother trying to add more lines") - ) - (T (* ; - "There's more; try adding another line.") - [replace (LINEDESCRIPTOR NEXTLINE) of LINE - with (\FORMATLINE - TEXTOBJ NIL (ADD1 (fetch - (LINEDESCRIPTOR - CHARLIM) - of LINE] - (replace (LINEDESCRIPTOR PREVLINE) - of (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE) with LINE] - (T (* ; - "Line is visible; just update YBOT/YBASE") - (replace (LINEDESCRIPTOR YBOT) of LINE - with NYBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) - of LINE) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE] - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - until (ILESSP NYBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (BITBLT NIL 0 0 WINDOW (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - WWIDTH - (IDIFFERENCE LOWESTY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE) (* ; - "Clear the part of the screen below the lowest line now displayed") - (RETURN T]) - -(\TEDIT.COPY.LINEDESCRIPTOR - [LAMBDA (FROMLINE TOLINE) (* ; "Edited 30-May-91 16:57 by jds") - - (* Copy the contents of one line descriptor into another -- - except for chaining and Y-location info.) - - (freplace (LINEDESCRIPTOR LEFTMARGIN) of TOLINE with (ffetch (LINEDESCRIPTOR - LEFTMARGIN) - of FROMLINE)) - (freplace (LINEDESCRIPTOR RIGHTMARGIN) of TOLINE with (ffetch (LINEDESCRIPTOR - RIGHTMARGIN) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LXLIM) of TOLINE with (ffetch (LINEDESCRIPTOR LXLIM) - of FROMLINE)) - (freplace (LINEDESCRIPTOR SPACELEFT) of TOLINE with (ffetch (LINEDESCRIPTOR - SPACELEFT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LHEIGHT) of TOLINE with (ffetch (LINEDESCRIPTOR LHEIGHT - ) of - FROMLINE - )) - (freplace (LINEDESCRIPTOR CHAR1) of TOLINE with (ffetch (LINEDESCRIPTOR CHAR1) - of FROMLINE)) - (freplace (LINEDESCRIPTOR CHARLIM) of TOLINE with (ffetch (LINEDESCRIPTOR CHARLIM - ) of - FROMLINE - )) - (freplace (LINEDESCRIPTOR CHARTOP) of TOLINE with (ffetch (LINEDESCRIPTOR CHARTOP - ) of - FROMLINE - )) - (freplace (LINEDESCRIPTOR DIRTY) of TOLINE with NIL) - (freplace (LINEDESCRIPTOR CR\END) of TOLINE with (ffetch (LINEDESCRIPTOR CR\END) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LDOBJ) of TOLINE with (ffetch (LINEDESCRIPTOR LDOBJ) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LHASPROT) of TOLINE with (ffetch (LINEDESCRIPTOR - LHASPROT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LFMTSPEC) of TOLINE with (ffetch (LINEDESCRIPTOR - LFMTSPEC) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LTRUEDESCENT) of TOLINE with (ffetch (LINEDESCRIPTOR - LTRUEDESCENT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LTRUEASCENT) of TOLINE with (ffetch (LINEDESCRIPTOR - LTRUEASCENT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR ASCENT) of TOLINE with (ffetch (LINEDESCRIPTOR ASCENT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR DESCENT) of TOLINE with (ffetch (LINEDESCRIPTOR DESCENT - ) of - FROMLINE - )) - (freplace (LINEDESCRIPTOR LHASTABS) of TOLINE with (ffetch (LINEDESCRIPTOR - LHASTABS) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LMARK) of TOLINE with (ffetch (LINEDESCRIPTOR LMARK) - of FROMLINE)) - (freplace (LINEDESCRIPTOR 1STLN) of TOLINE with (ffetch (LINEDESCRIPTOR 1STLN) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LSTLN) of TOLINE with (ffetch (LINEDESCRIPTOR LSTLN) - of FROMLINE]) - -(\TEDIT.FIXCHANGEDLINE - [LAMBDA (TEXTOBJ PREVYBOT LINES WINDOW TEXTLEN THISLINE WHEIGHT CHARLIM NEXTCARETCH# PREVDESCENT) - (* ; "Edited 30-May-91 16:57 by jds") - (* Reformat a single line, if need - be. Returns the changed line) - (PROG ((YBOT PREVYBOT) - (FORMATDONE NIL) - LIMITCHANGED WASDIRTY OCHLIM OLHEIGHT (PREVLINE NIL) - (FOUND NIL) - DY OFLOWFN NEWLINE) - [COND - ((IEQP CHARLIM 1) - (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES] - (COND - ([OR (fetch (LINEDESCRIPTOR DIRTY) of LINES) - (NOT (IEQP CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES] - - (* Only act if this line has changed, or if there is a gap or overlap between - this line and the prior one) - - (SETQ OCHLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINES)) - (* This line's old CHLIM, for seeing - if it changes) - (SETQ OLHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES)) - (* This line's old height, for - seeing if it changes.) - (SETQ NEWLINE (\FORMATLINE TEXTOBJ NIL CHARLIM)) - (* Create the fresh line) - (COND - ((AND (ILESSP CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES)) - (IEQP (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of NEWLINE)) - (fetch (LINEDESCRIPTOR CHAR1) of LINES))) - (* If this is a space-filling line, - just move the other lines down.) - (\TEDIT.INSERTLINE NEWLINE LINES)) - (T (* Otherwise, write over existing - lines) - (\TEDIT.COPY.LINEDESCRIPTOR NEWLINE LINES) - (* Move it into place in the chain) - (replace (THISLINE DESC) of THISLINE with LINES) - (* And pretend that LINES is the - line we just formatted--since it - effectively IS.) - (SETQ NEWLINE LINES) (* And copy it back over the - original) - )) - (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of NEWLINE))) - (* Find the end of the new line - (this MUST be before this COND, - because LINES is set to NIL inside - it.)) - (COND - ((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - WHEIGHT) (* Do nothing until we see a change - to a line which is on-screen.) - (replace (LINEDESCRIPTOR YBOT) of NEWLINE with (fetch ( - LINEDESCRIPTOR - YBOT) - of LINES)) - (* Except to make sure that the - fresh line also thinks it is off - screen) - ) - ((AND (IGEQ (SETQ YBOT (\TEDIT.NEXT.LINE.BOTTOM YBOT NEWLINE (fetch - (LINEDESCRIPTOR - PREVLINE) - of NEWLINE)) - ) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (NEQ LINES NEWLINE)) (* If there's space left on the - screen for this line, - (and it is a new line)) - (\TEDIT.ADJUST.LINES TEXTOBJ (fetch (LINEDESCRIPTOR NEXTLINE) of - NEWLINE - ) - WINDOW - (fetch (LINEDESCRIPTOR YBOT) of (fetch (LINEDESCRIPTOR PREVLINE) - of NEWLINE)) - (IMINUS (fetch (LINEDESCRIPTOR LHEIGHT) of NEWLINE))) - (* Move the existing lines down to - fit it in) - (replace (LINEDESCRIPTOR YBOT) of NEWLINE with YBOT) - (* Display it where we are now) - (replace (LINEDESCRIPTOR YBASE) of NEWLINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of NEWLINE))) - (* Base line for the characters to - sit on) - (\DISPLAYLINE TEXTOBJ NEWLINE WINDOW) (* Display it) - ) - ((IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - - (* If there's space left on the screen for this line, and we're overlaying an - existing line.) - - [\TEDIT.ADJUST.LINES TEXTOBJ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES) - WINDOW - (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES) - (IMINUS OLHEIGHT)) - (COND - ((fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINES)) - (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINES) - YBOT)) - (T (IDIFFERENCE OLHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of - LINES] - (* Adjust for the possible - difference in heights between old - and new line) - (replace (LINEDESCRIPTOR YBOT) of LINES with YBOT) - (* Display it where we are now) - (replace (LINEDESCRIPTOR YBASE) of LINES with - (IPLUS YBOT (fetch - (LINEDESCRIPTOR - DESCENT) - of LINES))) - (* Base line for the characters to - sit on) - (\DISPLAYLINE TEXTOBJ LINES WINDOW) (* Display it) - ) - ((AND NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINES) - NEXTCARETCH#)) (* This line is off-screen, but is - needed for finding the caret's new - location) - (replace (LINEDESCRIPTOR YBOT) of LINES with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINES with YBOT)) - (T - - (* We have walked off the bottom of the screen. - Chop off the lines from here.) - - (SETQ LINES NEWLINE) - (AND (SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETFROM (FUNCTION \TEDIT.FIXCHANGEDLINE))) - [replace (LINEDESCRIPTOR YBOT) of LINES - with (replace (LINEDESCRIPTOR YBASE) of LINES - with (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (* Mark this line as being - off-screen) - (COND - ((IGREATERP (fetch (LINEDESCRIPTOR CHARLIM) of LINES) - NEXTCARETCH#) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL))) - - (* Chop off any lines below it, to preserve changes that may propogate off the - bottom of the window) - - (\TEDIT.CLEAR.SCREEN.BELOW.LINE TEXTOBJ WINDOW (fetch (LINEDESCRIPTOR - PREVLINE) - of LINES)) - (* And clear the space below the - bottom line on the screen) - (RETURN))) - (SETQ LINES NEWLINE) - - (* So that if we inserted a line, we start by moving up to the pre-existing - line) - - )) - (RETURN LINES]) - -(\TEDIT.FIXCHANGEDPART - [LAMBDA (TEXTOBJ STARTINGLINE WINDOW INCREMENTAL? NEXTCARETCH#) - (* ; "Edited 30-May-91 16:07 by jds") - - (* ;; "Reformat lines as needed after a change. Return the last line changed, or NIL if there's no need for a \FILLWINDOW.") - - (PROG* ((THISW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) - [LINES (fetch (LINEDESCRIPTOR NEXTLINE) of (WINDOWPROP THISW 'LINES] - (REGION (DSPCLIPPINGREGION NIL THISW)) - (YBOT (fetch (REGION PTOP) of REGION)) - (FORMATDONE NIL) - LIMITCHANGED WASDIRTY CHARLIM OCHLIM OLHEIGHT (PREVLINE NIL) - (TPREVLINE NIL) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (WHEIGHT (fetch (REGION PTOP) of REGION)) - (WBOTTOM (fetch (REGION BOTTOM) of REGION)) - (CLEARBOTTOM T) - [NEXTCARETCH# (OR NEXTCARETCH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ - SEL) - of TEXTOBJ] - DY OFLOWFN NEWLINE TYBOT) - (AND LINES (SETQ TPREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of LINES))) - [while LINES do (* ; - "Find the first line descriptor of a DIRTY line.") - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of LINES)) - (COND - ((ILESSP 0 (SETQ DY (IDIFFERENCE (\TEDIT.NEXT.LINE.BOTTOM - YBOT LINES (fetch - (LINEDESCRIPTOR - PREVLINE) - of LINES)) - YBOT))) - (* ; - "There used to be another line above this one. Move this up to cover it.") - (\TEDIT.CLOSEUPLINES TEXTOBJ (fetch (LINEDESCRIPTOR - PREVLINE) - of LINES) - LINES NIL (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) - (* ; - "This HAS to fill the window, or we may wind up with missing lines at the bottom of the screen") - )) - (COND - ((AND (ILESSP YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINES) - NEXTCARETCH#)) - (* ; - "We've run off the bottom of the screen.") - (replace (LINEDESCRIPTOR NEXTLINE) of TPREVLINE - with NIL) (* ; - "There may be unfixed changes there, so chop off any further lines.") - (SETQ LINES NIL)) - ((fetch (LINEDESCRIPTOR DIRTY) of LINES) - (RETURN)) - ([AND [NOT (IEQP (fetch (LINEDESCRIPTOR CHAR1) of LINES) - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of TPREVLINE] - (NOT (ZEROP (fetch (LINEDESCRIPTOR CHARLIM) - of TPREVLINE] - - (* ;; "This line doesn't match up with the previous line; we should start updating here. But don't worry about the dummy first line") - - (RETURN)) - (T (SETQ TPREVLINE LINES) - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of - LINES] - [COND - ((AND LINES (ILESSP (fetch (LINEDESCRIPTOR CHARTOP) of LINES) - 0)) (* ; - "If we hit on the dummy first line, skip over it -- never try to reformat it.") - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES] - [COND - ((NOT LINES) (* ; - "No changed lines found -- clear below last line on screen") - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)) - (IDIFFERENCE YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE) - (COND - [[OR (ZEROP TEXTLEN) - (NOT (fetch (LINEDESCRIPTOR NEXTLINE) of (WINDOWPROP - (OR WINDOW (\TEDIT.PRIMARYW - TEXTOBJ)) - 'LINES] - - (* ;; "If there is no text, or no image, force a call to \FILLWINDOW, to provide a dummy empty line descriptor for the guy to type at.") - - (RETURN (WINDOWPROP WINDOW 'LINES] - (T (* ; - "We found no changes; return a NIL last-line-changed") - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) - (* ; - "Reset the 'needs-update' flag so we don't come back looking for work again.") - (RETURN NIL] - [SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of (SETQ PREVLINE (fetch ( - LINEDESCRIPTOR - PREVLINE) - of LINES] - (* ; - "Y bottom of the first line to reformat.") - (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE))) - (* ; "char to start formatting with") - (while (AND LINES (OR (IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (ILEQ CHARLIM NEXTCARETCH#))) - do - - (* ;; "Run thru lines, cleaning them up. Start with the first dirty line, and only stop if we're both past the place the caret will be AND off the bottom of the screen.") - - [COND - ([ILESSP 0 (SETQ DY (IDIFFERENCE (\TEDIT.NEXT.LINE.BOTTOM - YBOT LINES (fetch (LINEDESCRIPTOR - PREVLINE) - of LINES)) - (fetch (LINEDESCRIPTOR YBOT) of LINES] - (* ; - "There used to be another line above this one. Move this up to cover it.") - (\TEDIT.CLOSEUPLINES TEXTOBJ (fetch (LINEDESCRIPTOR PREVLINE) - of LINES) - LINES NIL (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ] - [COND - ((IGREATERP CHARLIM (IMIN (IMAX 1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINES)) - TEXTLEN)) (* ; - "This line has been rendered superfluous -- Delete it.") - (TEDIT.DELETELINE LINES TEXTOBJ WINDOW)) - (T - (* ;; "Try updating the line. If the updater returns NIL, it ran off the bottom of the screen, and we should give up.") - - (COND - ((SETQ LINES (\TEDIT.FIXCHANGEDLINE TEXTOBJ YBOT LINES WINDOW - TEXTLEN THISLINE WHEIGHT CHARLIM NEXTCARETCH# - (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE) - )) (* ; - "We're still on screen; update the character and Y-position counters for the next loop") - (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINES))) - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of LINES))) - (T (* ; - "Ran off the bottom of the window; the bottom has already been cleared, so avoid doing it here.") - (SETQ CLEARBOTTOM NIL) - (RETURN] - (COND - ((IGEQ CHARLIM TEXTLEN) (* ; -"If we've run out of text, chop off any remaining line descriptors, since we won't be needing them.") - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) - (* ; - "And there's no more screen updating to do, either.") - ) - ((AND INCREMENTAL? (fetch (LINEDESCRIPTOR NEXTLINE) of LINES) - (IGREATERP CHARLIM NEXTCARETCH#) - (\SYSBUFP)) (* ; - "This is an incremental update, and he hit a key. Stop updating and listen to him") - (* ; - "HOWEVER, NEVER STOP ON THE LAST LINE -- IF THERE ARE NEW LINES TO ADD, ADD ONE.") - (SETQ PREVLINE NIL) - (SETQ CLEARBOTTOM NIL) - (RETURN))) - (SETQ PREVLINE LINES) (* ; - "Remember the last line we really formatted.") - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - (* ; "Move to the next line")) - (COND - (CLEARBOTTOM (* ; - "There had been lines yet to be formatted, so there may be garbage below the end of the screen.") - (\TEDIT.CLEAR.SCREEN.BELOW.LINE TEXTOBJ WINDOW PREVLINE))) - (RETURN PREVLINE]) - -(\TEDIT.INSERTLINE - [LAMBDA (NEWLINE BEFORELINE) (* ; "Edited 30-May-91 16:05 by jds") - (* Inserts NEWLINE in front of - BEFORELINE in the line-descriptor - chain) - (PROG ((PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of BEFORELINE))) - (replace (LINEDESCRIPTOR PREVLINE) of NEWLINE with PREVLINE) - (replace (LINEDESCRIPTOR NEXTLINE) of NEWLINE with BEFORELINE) - (replace (LINEDESCRIPTOR PREVLINE) of BEFORELINE with NEWLINE) - (AND PREVLINE (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with NEWLINE]) - -(\TEDIT.LINE.LIST - [LAMBDA (TEXTOBJ WINDOW) (* ; "Edited 12-Jun-90 19:23 by mitani") - (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) when (EQ WW WINDOW) - do (RETURN LINES]) - -(\TEDIT.MARK.LINES.DIRTY - [LAMBDA (TEXTOBJ CH1 CHLIM) (* ; "Edited 30-May-91 16:05 by jds") - (* Mark dirty the lines that - intersect the range ch1 t chlim - inclusive) - (bind (CH# _ (IMIN CH1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (CHLIM# _ (COND - ((IEQP CHLIM -1) - (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (T CHLIM))) for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ - ) - do (bind (LL _ (WINDOWPROP WW 'LINES)) while LL - do (* Mark changed lines as DIRTY.) - (COND - ((AND (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LL) - CHLIM#) - (IGEQ (fetch (LINEDESCRIPTOR CHARTOP) of LL) - CH#)) - - (* The dirty range overlaps with this line -- - it is between the 1st char on the line, and the last char examined when - deciding where to break the line.) - - (replace (LINEDESCRIPTOR DIRTY) of LL with T))) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) - finally (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T]) - -(\TEDIT.NEXT.LINE.BOTTOM - [LAMBDA (CURYBOT LINE PREVLINE) (* ; "Edited 24-Sep-87 10:00 by jds") - -(* ;;; "Given a current Y-bottom for PREVLINE, and a LINE to follow it, compute the new line's YBOT value. Takes into account Base-to-base leading, as well as paragraph leadings.") - - (PROG (NEWYBOT PARALEADING PARALOOKS BASETOBASE) - [COND - [[SETQ BASETOBASE (fetch (FMTSPEC FMTBASETOBASE) of (SETQ PARALOOKS (fetch ( - LINEDESCRIPTOR - LFMTSPEC) - of LINE] - - (* ;; "If base-to-base spacing is specified, we have to do this in two parts: First, compute the proper spacing between the lines; then add in any paragraph leading.") - - [SETQ NEWYBOT (IDIFFERENCE (IPLUS CURYBOT (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE)) - (IPLUS BASETOBASE (fetch (LINEDESCRIPTOR DESCENT) of LINE] - (COND - ((fetch (LINEDESCRIPTOR 1STLN) of LINE) (* ; - "This is the first line of a new paragraph. Add in any paragraph leading.") - - [SETQ PARALEADING (IPLUS (fetch (FMTSPEC LEADBEFORE) of PARALOOKS) - (fetch (FMTSPEC LEADAFTER) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of PREVLINE] - - (* ;; "The inter-paragraph space is the sum of the previous para's post-leading and this para's pre-leading.") - - (SETQ NEWYBOT (IDIFFERENCE NEWYBOT PARALEADING] - (T - - (* ;; "If there's no base-to-base spacing, then paragraph leading was taken into account in the line formatter, and is already part of LHEIGHT.") - - (SETQ NEWYBOT (IDIFFERENCE CURYBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (RETURN NEWYBOT]) -) - - - -(* RMK%: These duplicate what appears on TEDITHCPY, GLOBALVARS moved to TEDITDCL) - - - - -(* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133" -"41,131" "41,127" "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143" "Hira,145" -"Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" "Kata,51" "Kata,103" "Kata,143" -"Kata,145" "Kata,147" "Kata,156"))) (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" -"41,126"))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))) - -(PUTPROPS TEDITSCREEN COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1992 1993 1994 2021)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (2761 76753 (\FORMATLINE 2771 . 56499) (\TEDIT.NSCHAR.RUN 56501 . 63318) ( -\TEDIT.PURGE.SPACES 63320 . 63778) (\DOFORMATTING 63780 . 76751)) (76754 98622 (\DISPLAYLINE 76764 . -94622) (\TEDIT.LINECACHE 94624 . 95375) (\TEDIT.CREATE.LINECACHE 95377 . 96121) (\TEDIT.BLTCHAR 96123 - . 98620)) (99237 213820 (TEDIT.CR.UPDATESCREEN 99247 . 100498) (TEDIT.DELETELINE 100500 . 101534) ( -TEDIT.INSERT.DISPLAYTEXT 101536 . 116775) (TEDIT.INSERT.UPDATESCREEN 116777 . 123529) ( -TEDIT.UPDATE.SCREEN 123531 . 124749) (\BACKFORMAT 124751 . 129062) (\FILLWINDOW 129064 . 144168) ( -\FIXDLINES 144170 . 151407) (\FIXILINES 151409 . 159384) (\SHOWTEXT 159386 . 162770) ( -\TEDIT.ADJUST.LINES 162772 . 170239) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 170241 . 170971) ( -\TEDIT.CLOSEUPLINES 170973 . 179489) (\TEDIT.COPY.LINEDESCRIPTOR 179491 . 185057) ( -\TEDIT.FIXCHANGEDLINE 185059 . 196238) (\TEDIT.FIXCHANGEDPART 196240 . 208667) (\TEDIT.INSERTLINE -208669 . 209489) (\TEDIT.LINE.LIST 209491 . 209817) (\TEDIT.MARK.LINES.DIRTY 209819 . 211505) ( -\TEDIT.NEXT.LINE.BOTTOM 211507 . 213818))))) -STOP diff --git a/library/TEDITSELECTION b/library/TEDITSELECTION deleted file mode 100644 index 87d68a1b..00000000 --- a/library/TEDITSELECTION +++ /dev/null @@ -1,2277 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Aug-94 10:56:07" {DSK}export>lispcore>library>TEDITSELECTION.;4 157341 - - changes to%: (VARS TEDITSELECTIONCOMS) (FILES TEDITDCL) - - previous date%: "29-Mar-94 13:45:15" {DSK}export>lispcore>library>TEDITSELECTION.;3) - - -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994 by John Sybalsky & Xerox Corporation. All rights reserved. -") - -(PRETTYCOMPRINT TEDITSELECTIONCOMS) - -(RPAQQ TEDITSELECTIONCOMS ((FILES TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) (FNS TEDIT.SEL.AS.STRING TEDIT.SELECTED.PIECES \TEDIT.FIND.FIRST.LINE \TEDIT.FIND.LAST.LINE \TEDIT.FIND.OVERLAPPING.LINE \TEDIT.FIND.PROTECTED.END \TEDIT.FIND.PROTECTED.START \TEDIT.WORD.BOUND) (INITVARS (TEDIT.EXTEND.PENDING.DELETE T)) (FNS \CREATE.TEDIT.SELECTION \CREATE.TEDIT.SHIFTEDSELECTION \CREATE.TEDIT.MOVESELECTION \CREATE.TEDIT.DELETESELECTION) (* ; "Added by yabu.fx, for LOADUP without DWIM.") (VARS (TEDIT.SELECTION (\CREATE.TEDIT.SELECTION)) (* ; "Original was %"(create SELECTION)%".") (TEDIT.SCRATCHSELECTION (\CREATE.TEDIT.SELECTION)) (* ; "Original was %"(create SELECTION)%".") (TEDIT.SHIFTEDSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) (* ; "Original was %"(create SELECTION HASCARET _ NIL)%".") (TEDIT.COPYLOOKSSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) (* ; "Original was %"(create SELECTION HASCARET _ NIL)%".") (TEDIT.MOVESELECTION (\CREATE.TEDIT.MOVESELECTION)) (* ; "Original was %"(CREATE SELECTION HASCARET _ NIL HOWHEIGHT _ 32767)%".") (TEDIT.DELETESELECTION (\CREATE.TEDIT.DELETESELECTION)) (* ; "Original was %"(CREATE SELECTION HOW _ BLACKSHADE HASCARET _ NIL HOWHEIGHT _ 32767)%".") (* ; "Changed by yabu.fx, for LOADUP without DWIM.") (TEDIT.SELPENDING NIL)) (GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING TEDIT.EXTEND.PENDING.DELETE) (COMS (* ; "Selection manipulating code") (FNS TEDIT.EXTEND.SEL TEDIT.SELECT TEDIT.SCAN.LINE TEDIT.SELECT.LINE.SCANNER \TEDIT.SELECT.CHARACTER) (FNS \FIXSEL \TEDIT.FIXDELSEL \TEDIT.FIXINSSEL \TEDIT.FIXSELS) (FNS TEDIT.RESET.EXTEND.PENDING.DELETE \TEDIT.SET.SEL.LOOKS) (FNS \SHOWSEL \SHOWSEL.HILIGHT \TEDIT.UPDATE.SHOWSEL \TEDIT.SHOWSELS \TEDIT.REFRESH.SHOWSEL) (FNS \COPYSEL \TEDIT.SEL.CHANGED?)) (COMS (* ;; "User entries to the selection code") (FNS TEDIT.GETPOINT TEDIT.GETSEL TEDIT.MAKESEL TEDIT.SCANSEL TEDIT.SET.SEL.LOOKS TEDIT.SETSEL TEDIT.SHOWSEL))) -) - -(FILESLOAD TEDITDCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) TEDITDCL) -) -(DEFINEQ - -(TEDIT.SEL.AS.STRING - [LAMBDA (STREAM SEL) (* ; "Edited 22-Apr-93 16:44 by jds") - - (* ;; - "Given a text stream, go to the TEXTOBJ, get the current selection, and return it as a string.") - - (SETQ STREAM (TEXTSTREAM STREAM)) - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - LEN TSEL RESULT OFFST BASE) - (SETQ TSEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (SETQ LEN (fetch (SELECTION DCH) of TSEL)) - (COND - ((ZEROP LEN) (* ; - "There is no selection, or it's zero-width. Return ''") - (RETURN "")) - (T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE))) - (* ; "The resulting string") - (\SETUPGETCH (fetch (SELECTION CH#) of TSEL) - TEXTOBJ) (* ; - "Starting point for the string is start of selection.") - (for I from 1 to LEN do (* ; - "Get chars from the stream, and put them in the string.") - (RPLCHARCODE RESULT I (\GETCH TEXTOBJ))) - (RETURN RESULT]) - -(TEDIT.SELECTED.PIECES - [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) - (* ; "Edited 20-Apr-93 17:06 by jds") - - (* ;; "Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result as the copy of the piece") - - (PROG ((CH1 (fetch (SELECTION CH#) of SEL)) - (CHLIM (fetch (SELECTION CHLIM) of SEL)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (INSERTPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) - LEN INSPC INSPC# PC NPC (PCCH 1) - NPCCH OPLEN EVENT REPLACING INSERTCH# PCLST OBJ COPYFN UNDOCHAIN NODE) - (* ; "Find the insertion point") - (AND (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (RETURN NIL)) - (SETQ PCLST (TCONC NIL)) - (first (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while PC for I from 1 - do - - (* ;; "Gather a list of pieces to be copied") - - (SETQ NODE PC) - [COND - ((IGEQ PCCH CHLIM) (* ; - "We've passed beyond the copy region. Bail out.") - (RETURN)) - ((ILEQ (SETQ NPCCH (IPLUS PCCH (fetch (PIECE PLEN) of PC))) - CH1) (* ; - "The current piece isn't inside the region to be copied.") - ) - (T (* ; - "This piece overlaps the copy-source region of the document") - (* ; "Add it to the copy list.") - (COND - ((ILESSP PCCH CH1) (* ; - "The piece overlaps the bottom of the copy region: Chop off its front part.") - (COND - ((EQ PC INSERTPC) - - (* ;; - "We're splitting the insertion piece. Never let the underlying string be touched again.") - - (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with NIL))) - (SETQ PC (\SPLITPIECE PC (- CH1 PCCH) - TEXTOBJ I)) - (SETQ PCCH CH1))) - (COND - ((ILESSP CHLIM NPCCH) (* ; - "This piece overlaps the end of the copy region. Shorten it at the end.") - (\SPLITPIECE PC (- CHLIM PCCH) - TEXTOBJ I))) - (TCONC PCLST (SETQ NPC (COND - (PIECEMAPFN (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 - FNARG2)) - (T PC] - (add PCCH (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (RETURN (CDAR PCLST]) - -(\TEDIT.FIND.FIRST.LINE - [LAMBDA (TEXTOBJ WHEIGHT CH# WINDOW) (* ; "Edited 30-May-91 23:02 by jds") - (* Find the first line to be - displayed, given that it must - include character CH#) - (PROG ((LINES (OR (AND WINDOW (WINDOWPROP WINDOW 'LINES)) - (fetch (TEXTOBJ LINES) of TEXTOBJ))) - (WWIDTH (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) - (TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - LINE CHNO CH) - [COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* If there's no text, force an - empty line) - (SETQ CHNO 1) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL) - (RETURN LINES)) - ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* If there's no text on the screen, - just return nil) - (RETURN NIL)) - [(fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ)(* For a para-formatted object, back - up to the prior para bound.) - (SETQ CHNO (CAR (\TEDIT.PARABOUNDS TEXTOBJ CH#] - (T (* Otherwise, move back thru the - text until we find a for-sure line - break) - (\SETUPGETCH CH# TEXTOBJ) - (SETQ CH 0) - (for old CHNO from (SUB1 CH#) to 2 by -1 - repeatwhile (NOT (EQ CH (CHARCODE CR))) do (SETQ CH (\BACKBIN TEXTSTREAM)) - ) - (SETQ CHNO (COND - ((ILEQ CHNO 1) (* If we moved back to - start-of-file, move forward from - there;) - 1) - ((IEQP CHNO CH#) (* If we landed on a CR first shot, - let's try moving forward from there.) - CH#) - (T (* Else, skip the CR we passed over) - (ADD1 CHNO] - (SETQ CH# (IMIN CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - [repeatwhile (ILEQ CHNO CH#) do - - (* Starting from the known line break, move forward until we find the line - which has the right CH# in it) - - (SETQ LINE (\FORMATLINE TEXTOBJ NIL CHNO)) - (replace (LINEDESCRIPTOR YBOT) of LINE - with WHEIGHT) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES - with LINE) - (replace (LINEDESCRIPTOR PREVLINE) of LINE - with LINES) - (SETQ LINES LINE) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE] - (RETURN LINE]) - -(\TEDIT.FIND.LAST.LINE - [LAMBDA (TEXTOBJ LINES) (* ; "Edited 30-May-91 23:02 by jds") - - (* Among the line descriptors in LINES, find the last one on the screen; - then return it.) - - (OR LINES (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ))) - (* Make sure a list of line - descriptors is specified.) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* If there's no window, return NIL.) - (bind (OLINE _ LINES) - (LINE _ LINES) - (CURY _ (fetch (LINEDESCRIPTOR YBOT) of LINES)) - while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do (* Find the lowest line above screen - bottom, and put it in OLINE.) - (SETQ OLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - finally (RETURN OLINE))) - (T NIL]) - -(\TEDIT.FIND.OVERLAPPING.LINE - [LAMBDA (LINES Y) (* ; "Edited 30-May-91 22:57 by jds") - (while LINES do (COND - ((ILEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - Y) - (RETURN LINES)) - (T (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES]) - -(\TEDIT.FIND.PROTECTED.END - [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 18-Apr-93 23:49 by jds") - - (* ;; "Starting from a CH# in a selectable region, find the CH# of the last selectable character following that. This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow unprotected areas.") - - (* ;; "If LIMITCH# is given, the search will stop there.") - - (bind (OURLIMIT _ (IMIN (OR LIMITCH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (PCTB _ (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - START-OF-PIECE PC first (SETQ PC (\CHTOPC CH# (fetch (TEXTOBJ PCTB) of TEXTOBJ - ) - T)) while PC - do - - (* ;; "Move forward thru the pieces of the document, looking for one that contains protected text. If that comes before the end of the region we're interested in, tell the caller about the earlier end to selectable text.") - - [COND - ((IGREATERP START-OF-PIECE OURLIMIT) (* ; - "We've passed the limit, so it's time to give up. Just return the LIMITCH#") - (RETURN OURLIMIT)) - ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PC)) - - (* ;; "We've found the beginning of a protected region -- i.e., the end of the selectable region. Tell the caller about it.") - - (RETURN (SUB1 START-OF-PIECE] - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally (RETURN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ]) - -(\TEDIT.FIND.PROTECTED.START - [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 30-Apr-93 01:39 by jds") - - (* ;; "Starting from a CH# in a selectable region, find the CH# of the earliest contiguously-selectable character preceding that. This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow unprotected areas.") - - (* ;; "Will stop looking when it passes LIMITCH#, or at the beginning of the document.") - - (bind (OURLIMIT _ (OR LIMITCH# 1)) - (PCTB _ (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - PC START-OF-PIECE first (SETQ PC (\CHTOPC CH# PCTB T)) - (AND (LITATOM PC) - (SETQ PC (\CHTOPC CH# (SUB1 START-OF-PIECE) - T))) while PC - do [COND - ((ILEQ START-OF-PIECE OURLIMIT) (* ; - "If he specified a LIMITCH#, and we have passed it, stop bothering and return the LIMITCH#") - (RETURN OURLIMIT)) - ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PC)) - - (* ;; "We hit a PROTECTED piece of text. This is the place to stop. Return the CH# just AFTER the protected text we found.") - - (RETURN (IPLUS START-OF-PIECE (fetch (PIECE PLEN) of PC] - (SETQ PC (fetch (PIECE PREVPIECE) of PC)) - (SETQ START-OF-PIECE (IDIFFERENCE START-OF-PIECE (fetch (PIECE PLEN) of PC]) - -(\TEDIT.WORD.BOUND - [LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 30-May-91 23:02 by jds") - (PROG ((READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) - TEDIT.WORDBOUND.READTABLE))) - SYN1 SYN2) - (COND - ((NOT (AND (FIXP PREVCH) - (FIXP CH))) - (RETURN T))) - (SETQ SYN1 (\SYNCODE READSA PREVCH)) - (SETQ SYN2 (\SYNCODE READSA CH)) - (RETURN (NEQ SYN1 SYN2]) -) - -(RPAQ? TEDIT.EXTEND.PENDING.DELETE T) -(DEFINEQ - -(\CREATE.TEDIT.SELECTION - [LAMBDA NIL - (create SELECTION]) - -(\CREATE.TEDIT.SHIFTEDSELECTION - [LAMBDA NIL - (create SELECTION - HASCARET _ NIL]) - -(\CREATE.TEDIT.MOVESELECTION - [LAMBDA NIL - (CREATE SELECTION - HASCARET _ NIL - HOWHEIGHT _ 32767]) - -(\CREATE.TEDIT.DELETESELECTION - [LAMBDA NIL - (CREATE SELECTION - HOW _ BLACKSHADE - HASCARET _ NIL - HOWHEIGHT _ 32767]) -) - - - -(* ; "Added by yabu.fx, for LOADUP without DWIM.") - - -(RPAQ TEDIT.SELECTION (\CREATE.TEDIT.SELECTION)) - -(RPAQ TEDIT.SCRATCHSELECTION (\CREATE.TEDIT.SELECTION)) - -(RPAQ TEDIT.SHIFTEDSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) - -(RPAQ TEDIT.COPYLOOKSSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) - -(RPAQ TEDIT.MOVESELECTION (\CREATE.TEDIT.MOVESELECTION)) - -(RPAQ TEDIT.DELETESELECTION (\CREATE.TEDIT.DELETESELECTION)) - -(RPAQQ TEDIT.SELPENDING NIL) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING TEDIT.EXTEND.PENDING.DELETE) -) - - - -(* ; "Selection manipulating code") - -(DEFINEQ - -(TEDIT.EXTEND.SEL - [LAMBDA (X Y OSEL TEXTOBJ SELOPERATION SELWINDOW NEWSEL) - (* ; "Edited 19-Apr-93 13:49 by jds") - (* ; - "Gather a new selected character, and extend OSEL to include it. Return the extended selection.") - (PROG ((NSEL (OR NEWSEL (TEDIT.SELECT X Y TEXTOBJ (SELECTQ (fetch (SELECTION SELKIND) - of OSEL) - ((LINE PARA) - 'LINE) - ((WORD CHAR) - 'TEXT) - 'TEXT) - (OR (EQ (fetch (SELECTION SELKIND) of OSEL) - 'WORD) - (EQ (fetch (SELECTION SELKIND) of OSEL) - 'PARA)) - SELOPERATION SELWINDOW T))) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NPOINT NIL) - (SETOSELFLG NIL) - (FIXUPNEEDED NIL)) - (COND - ((ZEROP TEXTLEN) (* ; - "No sense in extending a selection if there's no text!") - (RETURN NSEL))) - (COND - ((AND NSEL (fetch (SELECTION SET) of NSEL)) - (* ; - "If there's no second selection, don't bother trying") - (\TEDIT.SET.SEL.LOOKS NSEL SELOPERATION) - - (* ;; "Make the new selection be the same kind as the original, as to what it's for -- regular, copy-source, etc.") - - [SETQ NPOINT (COND - ((IGEQ (fetch (SELECTION CHLIM) of NSEL) - (fetch (SELECTION CHLIM) of OSEL)) - (* ; - "The new selection ends to the right of the old one. Move this edge.") - 'RIGHT) - ((ILEQ (fetch (SELECTION CH#) of NSEL) - (fetch (SELECTION CH#) of OSEL)) - (* ; - "If the new selection starts to left of old one, caret goes at the LEFT") - 'LEFT) - ([IGREATERP (IABS (IDIFFERENCE (fetch (SELECTION CHLIM) - of NSEL) - (fetch (SELECTION CHLIM) of OSEL))) - (IABS (IDIFFERENCE (fetch (SELECTION CH#) of NSEL) - (fetch (SELECTION CH#) of OSEL] - (SETQ SETOSELFLG T) - 'LEFT) - (T (SETQ SETOSELFLG T) - 'RIGHT] - [SELECTQ NPOINT - (LEFT (* ; - "Caret's to the left. Keep the same right end") - [replace (SELECTION CHLIM) of NSEL - with (IMAX (fetch (SELECTION CHLIM) of NSEL) - (SELECTQ (fetch (SELECTION POINT) of OSEL) - (LEFT (IPLUS (fetch (SELECTION CH#) of OSEL) - (fetch (SELECTION DCH) of OSEL))) - (RIGHT (fetch (SELECTION CHLIM) of OSEL)) - (SHOULDNT] - (replace (SELECTION XLIM) of NSEL with (fetch (SELECTION - XLIM) - of OSEL)) - (replace (SELECTION YLIM) of NSEL with (fetch (SELECTION - YLIM) - of OSEL)) - (replace (SELECTION LN) of NSEL with (COPY (fetch - (SELECTION LN) - of OSEL))) - (COND - ((NEQ SELOPERATION 'COPY) (* ; - "The old sel is in a protected area. Only let him extend to the start of it.") - [replace (SELECTION CH#) of NSEL - with (IMAX (fetch (SELECTION CH#) of NSEL) - (\TEDIT.FIND.PROTECTED.START - TEXTOBJ - (SUB1 (fetch (SELECTION CHLIM) of OSEL)) - (fetch (SELECTION CH#) of NSEL] - (SETQ FIXUPNEEDED T) (* ; - "Note that the L1/LN may be invalid as a result of this contraction. Force a \FIXSEL later.") - ))) - (RIGHT (* ; - "Point's to the right; keep the same left end.") - [replace (SELECTION CH#) of NSEL - with (IMIN (fetch (SELECTION CH#) of NSEL) - (SELECTQ (fetch (SELECTION POINT) of OSEL) - (LEFT (fetch (SELECTION CH#) of OSEL)) - (RIGHT (IDIFFERENCE (fetch (SELECTION CHLIM) - of OSEL) - (fetch (SELECTION DCH) of OSEL))) - (SHOULDNT] - (replace (SELECTION X0) of NSEL with (fetch (SELECTION - X0) - of OSEL)) - (replace (SELECTION Y0) of NSEL with (fetch (SELECTION - Y0) - of OSEL)) - (replace (SELECTION L1) of NSEL with (COPY (fetch - (SELECTION L1) - of OSEL))) - (COND - ((NEQ SELOPERATION 'COPY) (* ; - "The old sel is in a protected area. Only let him extend to the start of it.") - [replace (SELECTION CHLIM) of NSEL - with - (IMIN (fetch (SELECTION CHLIM) of NSEL) - (ADD1 (\TEDIT.FIND.PROTECTED.END - TEXTOBJ - (fetch (SELECTION CH#) of OSEL) - (ADD1 (\TEDIT.FIND.PROTECTED.END - TEXTOBJ - (fetch (SELECTION CH#) of OSEL) - (SUB1 (fetch (SELECTION CHLIM) of NSEL] - (replace (SELECTION CH#) of NSEL - with (IMIN (fetch (SELECTION CHLIM) of NSEL) - (fetch (SELECTION CH#) of NSEL))) - (SETQ FIXUPNEEDED T) (* ; - "Note that the L1/LN may be invalid as a result of this contraction. Force a \FIXSEL later.") - ))) - (PROGN (replace (SELECTION CHLIM) of NSEL with (fetch (SELECTION - CHLIM) - of OSEL)) - (replace (SELECTION XLIM) of NSEL with (fetch (SELECTION - XLIM) - of OSEL)) - (replace (SELECTION YLIM) of NSEL with (fetch (SELECTION - YLIM) - of OSEL)) - (replace (SELECTION LN) of NSEL with (COPY (fetch - (SELECTION LN) - of OSEL))) - (replace (SELECTION CH#) of NSEL with (fetch (SELECTION - CH#) - of OSEL)) - (replace (SELECTION X0) of NSEL with (fetch (SELECTION - X0) - of OSEL)) - (replace (SELECTION Y0) of NSEL with (fetch (SELECTION - Y0) - of OSEL)) - (replace L1 of NSEL with (COPY (fetch L1 of OSEL))) - (SETQ NPOINT (fetch POINT of OSEL] - (replace DCH of NSEL with (IDIFFERENCE (IMIN (ADD1 TEXTLEN) - (fetch CHLIM of NSEL)) - (fetch CH# of NSEL))) - (* ; - "The selection's length cannot exceed that of the whole text.") - (replace CHLIM of NSEL with (IPLUS (fetch CH# of NSEL) - (fetch DCH of NSEL))) - (* ; - "This assures that the CHLIM corresponds to the DCH.") - (replace POINT of NSEL with NPOINT) - (replace (SELECTION DX) of NSEL with (IDIFFERENCE (fetch XLIM - of NSEL) - (fetch X0 of NSEL))) - (COND - ((NEQ (fetch SELOBJ of OSEL) - (fetch SELOBJ of NSEL)) - (replace SELOBJ of NSEL with NIL))) - (COND - (FIXUPNEEDED - - (* ;; "We're in a menu, and this selection got contracted because of a protection violation. Fix up everything.") - - (\FIXSEL NSEL TEXTOBJ))) - (COND - (SETOSELFLG (* ; - "For whatever reason, it is wise to copy the new sel into the old one.") - (\COPYSEL NSEL OSEL)) - (T (* ; - "Otherwise, set the POINT of the old sel to correspond to the new sel's.") - (* ; - "(replace POINT of OSEL with NPOINT)") - (* ; - "THIS WAS REMOVED, BECAUSE EXTENDING A POINT-SELECTION WOULD DIE WHEN THIS WAS DONE") - )) - (RETURN NSEL)) - (T (* ; - "No new selection was made; just return the old one.") - (RETURN OSEL]) - -(TEDIT.SELECT - [LAMBDA (X Y TEXTOBJ REGION WORDSELFLG SELOPERATION WINDOW EXTENDING) - (* ; "Edited 30-May-91 23:07 by jds") - (* Select the character word, line, - or paragraph the mouse is pointing - at.) - (PROG ((SEL NIL) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - PREVLINE L1 LN) - (SETQ SEL (TEDIT.SELECT.LINE.SCANNER X Y TEXTOBJ (\TEDIT.LINE.LIST TEXTOBJ WINDOW) - REGION WORDSELFLG SELOPERATION WINDOW EXTENDING)) - (COND - ((AND (type? SELECTION SEL) - (fetch (SELECTION SET) of SEL)) (* He pointed at something real; - return that.) - (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) - [COND - ([AND (CAR (fetch (SELECTION L1) of SEL)) - (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of (CAR (fetch (SELECTION - L1) - of SEL] - (replace (SELECTION X0) of SEL with (FIXR (FQUOTIENT - (fetch (SELECTION X0) - of SEL) - 35.27778] - [COND - ([AND (CAR (fetch (SELECTION LN) of SEL)) - (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of (CAR (fetch (SELECTION - LN) - of SEL] - (replace (SELECTION XLIM) of SEL with (FIXR (FQUOTIENT - (fetch (SELECTION - XLIM) - of SEL) - 35.27778] - (replace (SELECTION DX) of SEL with (IDIFFERENCE (fetch (SELECTION - XLIM) - of SEL) - (fetch (SELECTION X0) - of SEL))) - (\FIXSEL SEL TEXTOBJ WINDOW T) - (RETURN SEL)) - ((type? LINEDESCRIPTOR SEL) - - (* He pointed below the bottom of the text. - Select to the right of the last character on the screen.) - - (COND - ((fetch (LINEDESCRIPTOR LHASPROT) of SEL) - (* The last line is protected. - Don't select anything.) - (RETURN))) - (SETQ PREVLINE SEL) - (SETQ SEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION SET) of SEL with T) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - [replace (SELECTION CH#) of SEL with - (IMAX 1 (ADD1 (IMIN TEXTLEN (fetch - (LINEDESCRIPTOR - CHARLIM) - of PREVLINE] - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) - of SEL)) - (replace (SELECTION DCH) of SEL with 0) - [replace (SELECTION POINT) of SEL with (COND - ((IGREATERP (fetch - (SELECTION CH#) - of SEL) - (fetch (TEXTOBJ - TEXTLEN) - of TEXTOBJ)) - - (* Can't select to the right of a character past EOF, only to the left -- - which is the right edge of the text.) - - 'LEFT) - (T 'RIGHT] - (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) - (\FIXSEL SEL TEXTOBJ) - (RETURN SEL]) - -(TEDIT.SCAN.LINE - [LAMBDA (TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION WINDOW EXTENDING) - (* ; "Edited 31-May-91 12:26 by jds") - - (* ;; "Given a line, find the character which straddles the mouse.") - - (PROG ((L NIL) - (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (LLIST (fetch (THISLINE LOOKS) of THISLINE)) - (LOOKNO 1) - (DX 0) - OTX YBOT YBASE TX (CH (CHARCODE SPACE)) - PREVCH CHOBJB TXB CHB (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - L1 LN CLOOKS PCLOOKS) - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If the cache doesn't describe this line, call \FORMATLINE so it will.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) of LINE) - LINE))) - [COND - ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (* ; - "This is a hardcopy-mode line. Convert units to micas") - (SETQ X (FIXR (FTIMES X 35.27778] - [SETQ OTX (SETQ TXB (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE] - (SETQ X (IMAX X TX)) (* ; - "The mouse MUST be inside the line being selected.") - (SETQ CHB (SUB1 (fetch (LINEDESCRIPTOR CHAR1) of LINE))) - (SETQ CLOOKS (\EDITELT LLIST 0)) - (\TEDIT.CHECK (IGEQ X (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))) - (* ; - "The mouse MUST be inside the line being selected.") - (for I from 0 to (fetch LEN of THISLINE) as CHNO - from (SUB1 (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - do (SETQ PREVCH CH) - (SETQ PCLOOKS CLOOKS) - (SETQ CH (\EDITELT CHLIST I)) - [COND - ((EQ CH LMInvisibleRun) (* ; "An invisible run -- skip it") - (add CHNO (\EDITELT LLIST LOOKNO))(* ; "The length of the run") - (add LOOKNO 1) (* ; - "Move to next CLook for next transition") - (add I 1) (* ; - "Don't count this toward the CHNO counter.") - (SETQ CH (\EDITELT CHLIST I] - (\TEDIT.CHECK (NEQ CH LMInvisibleRun)) (* ; - "Can't have 2 invisible runs in a row.") - [COND - ((EQ CH LMLooksChange) (* ; - "Change of CharLooks -- make the switch") - (SETQ CLOOKS (\EDITELT LLIST LOOKNO)) (* ; "New looks") - (add LOOKNO 1) (* ; - "Move to next CLook for next transition") - (add I 1) (* ; - "Don't count this toward the CHNO counter.") - (SETQ CH (\EDITELT CHLIST I] - [COND - ((AND (ILESSP X TX) - (OR (EQ SELOPERATION 'COPY) - (fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - (NOT (fetch (CHARLOOKS CLPROTECTED) of PCLOOKS))) - (OR (NOT WORDSELFLG) - (NOT (SMALLP PREVCH)) - (\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH))) - - (* ;; "If we're beyond the mouse's X, and the character is selectable, and we're in char select or this is a word boundary then SELECT!!!") - - (\TEDIT.CHECK (NOT (ZEROP I))) (* ; - "We had best not have fouled out to the left of the left margin!") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (* ; "Grab the scratch sel") - (replace (SELECTION SET) of L with T) - (* ; "Mark it valid") - [replace (SELECTION SELKIND) of L with (COND - (WORDSELFLG 'WORD) - (T 'CHAR] - (\TEDIT.SELECT.CHARACTER TEXTOBJ L PREVCH LINE X Y TXB WINDOW SELOPERATION - EXTENDING) - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR - YBOT) of LINE)) - (replace (SELECTION X0) of L with (COND - ((fetch (CHARLOOKS - CLSELHERE) - of PCLOOKS) - (* ; - "If CLSelHere, then select to RIGHT always.") - TX) - (WORDSELFLG TXB) - (T OTX))) - (replace (SELECTION DX) of L with (COND - ((fetch (CHARLOOKS - CLSELHERE) - of PCLOOKS) - 0) - (WORDSELFLG (IDIFFERENCE - TX TXB)) - (T DX))) - [replace (SELECTION CH#) of L with (IMAX 1 (COND - ((fetch - (CHARLOOKS - CLSELHERE) - of PCLOOKS) - (ADD1 CHNO)) - (WORDSELFLG - (ADD1 CHB)) - (T CHNO] - (replace (SELECTION XLIM) of L with (COND - ((fetch (CHARLOOKS - CLSELHERE) - of PCLOOKS) - TX) - (WORDSELFLG TX) - (T TX))) - [replace (SELECTION CHLIM) of L with - (ADD1 (COND - ((fetch (CHARLOOKS - CLSELHERE) - of PCLOOKS) - CHNO) - (WORDSELFLG CHNO) - (T CHNO] - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR - YBOT) of - LINE)) - (for L1 on (fetch (SELECTION L1) of L) as LN - on (fetch (SELECTION LN) of L) as WW - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - when (EQ WW WINDOW) do (RPLACA L1 LINE) - (RPLACA LN LINE)) - [replace (SELECTION POINT) of L - with (COND - ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - (* ; - "Always to the right of an otherwise-protected insertion point marker") - 'RIGHT) - [WORDSELFLG (COND - ((AND (NEQ PREVCH (CHARCODE CR)) - (IGEQ X (LRSH (IPLUS TX TXB) - 1))) - (* ; - "To the right if it isn't a CR and we're right of center.") - 'RIGHT) - (T 'LEFT] - (T (COND - ((AND (IGEQ DX 3) - (NEQ PREVCH (CHARCODE CR)) - (IGEQ X (LRSH (IPLUS TX OTX) - 1))) - - (* ;; "If it's wide enough to sensibly decide on an edge for, this isn't a CR, and we're right of center, then put the caret to the RIGHT") - - 'RIGHT) - (T 'LEFT] - (replace (SELECTION DCH) of L with (COND - ((fetch (CHARLOOKS - CLSELHERE) - of PCLOOKS) - 0) - (WORDSELFLG (IDIFFERENCE - CHNO CHB)) - (T 1))) - (RETURN)) - (T - (* ;; "We're not past the mouse yet; just track the last word boundary (or protected-text boundary) for word selection.") - - (COND - ((OR (AND (NOT (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - (\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH)) - (NEQ (fetch (CHARLOOKS CLPROTECTED) of PCLOOKS) - (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - (fetch (CHARLOOKS CLSELHERE) of PCLOOKS)) - (SETQ TXB TX) - (SETQ CHB CHNO) - (SETQ CHOBJB PREVCH] - (SETQ OTX TX) - (SETQ DX (\EDITELT WLIST I)) - (SETQ TX (IPLUS TX DX))) - [COND - ((AND (NOT L) - (IGEQ (fetch LEN of THISLINE) - 0) - (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - - (* ;; "He's pointing to the right of the line, but there's protected text at the end. Select a point at the last legal spot.") - - (COND - ((SMALLP CHOBJB) (* ; - "And the last item wasn't a menu button") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION SET) of L with T) - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (replace (SELECTION X0) of L with TXB) - (replace (SELECTION DX) of L with 0) - (replace (SELECTION CH#) of L with (IMAX 1 (ADD1 CHB))) - (replace (SELECTION XLIM) of L with TXB) - (replace (SELECTION CHLIM) of L with (IMAX 1 (ADD1 CHB))) - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (for L1 on (fetch (SELECTION L1) of L) as LN - on (fetch (SELECTION LN) of L) as WW - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - when (EQ WW WINDOW) do (RPLACA L1 LINE) - (RPLACA LN LINE)) - (replace (SELECTION POINT) of L with 'LEFT) - (replace (SELECTION DCH) of L with 0) - (replace (SELECTION SELOBJ) of L with NIL)) - (T (* ; - "Oops--the last item WAS a menu button. Don't let it be selected.") - (RETURN 'DON'T] - (COND - (L (* ; - "If we found the place he's pointing, set up the inter-pointers so each can find the other") - (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ)) - (T (* ; - "We didn't find what he was pointing at. Point to the end of the line.") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION SET) of L with T) - [replace (SELECTION SELKIND) of L with (COND - (WORDSELFLG 'WORD) - (T 'CHAR] - (* ; - "THIS MUST PRECEDE THE \TEDIT.SELECT.CHARACTER, SO OBJECTS CAN TURN THE SELECTION VOLATILE.") - (\TEDIT.SELECT.CHARACTER TEXTOBJ L CH LINE X Y TXB WINDOW SELOPERATION EXTENDING) - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - [replace (SELECTION X0) of L with (COND - (WORDSELFLG TXB) - (T (IDIFFERENCE TX DX] - (replace (SELECTION XLIM) of L with TX) - (replace (SELECTION DX) of L with (COND - (WORDSELFLG (IDIFFERENCE TX TXB)) - (T DX))) - [replace (SELECTION CH#) of L with (COND - (WORDSELFLG (ADD1 CHB)) - (T (IMIN (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE) - TEXTLEN] - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (replace (SELECTION CHLIM) of L with (ADD1 (IMIN (fetch ( - LINEDESCRIPTOR - CHARLIM) - of LINE) - TEXTLEN))) - [replace (SELECTION POINT) of L - with (COND - [(NEQ CH (CHARCODE CR)) (* ; - "You can select only to the left of a CR; elsewhere, you can select to the right") - (COND - ([IGEQ X (COND - (WORDSELFLG (* ; - "If it's a word, check our location against mid-word to see which side to put the caret on") - (LRSH (IPLUS TX TXB) - 1)) - (T (* ; - "Otherwise, check against mid-character") - (IDIFFERENCE TX (LRSH DX 1] - (* ; - "If we're to the right of mid-item, put the caret on the right.") - 'RIGHT) - (T (* ; "Otherwise, put it on the left.") - 'LEFT] - (T 'LEFT] - (for L1 on (fetch (SELECTION L1) of L) as LN - on (fetch (SELECTION LN) of L) as WW - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - when (EQ WW WINDOW) do (RPLACA L1 LINE) - (RPLACA LN LINE)) - (replace (SELECTION DCH) of L - with (COND - (WORDSELFLG (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR CHARLIM) - of LINE) - TEXTLEN) - CHB)) - (T 1))) - (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ))) - (RETURN L]) - -(TEDIT.SELECT.LINE.SCANNER - [LAMBDA (X Y TEXTOBJ LINE.LIST REGION WORDSELFLG SELOPERATION WINDOW EXTENDING) - (* ; "Edited 31-May-91 12:26 by jds") - (* ; - "Find the text line the mouse is pointing at.") - (* ; - "LINE.LIST is the dummy first line for the window in which selection happened.") - (PROG ((L NIL) - (WWIDTH (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) - (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (WREG (DSPCLIPPINGREGION NIL WINDOW)) - PREVLINE PARABOUNDS PARASTART PARAEND L1 LN) - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINE.LIST)) - while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch BOTTOM of WREG))) - do - - (* ;; "Search thru the list of (real) displayed lines, looking for the first one whose bottom is below the mouse. That's the line we're pointing at.") - - (COND - ((ILEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - Y) (* ; "Found it.") - (SELECTQ REGION - ((TEXT WINDOW) (* ; - "We're in the regular text area, so scan accross looking for the character.") - (SETQ L (TEDIT.SCAN.LINE TEXTOBJ LINE THISLINE X Y WORDSELFLG - SELOPERATION WINDOW EXTENDING))) - (LINE (* ; - "He is selecting an entire line, or a paragraph.") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (for TL1 on (fetch (SELECTION L1) of L) as TLN - on (fetch (SELECTION LN) of L) as WW - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - when (EQ WW WINDOW) do (SETQ L1 TL1) - (SETQ LN TLN) - (RETURN)) - (COND - ((AND (fetch (LINEDESCRIPTOR LHASPROT) of LINE) - (NEQ SELOPERATION 'COPY))(* ; - "In a TEDIT menu, you can't select a whole paragraph or line.") - (replace (SELECTION SET) of L with NIL) - (RETURN L))) (* ; "The scratch selection") - (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ) - (* ; - "Make sure he knows what document the selection's in.") - (replace (SELECTION SET) of L with T) - (* ; "Mark it valid.") - (replace (SELECTION SELOBJ) of L with NIL) - (* ; - "Not selecting an object just yet") - (COND - [WORDSELFLG (* ; "Select a paragraph.") - (replace (SELECTION SELKIND) of L with 'PARA) - (* ; - "SEARCH FORWARD FROM THE CURRENT LINE TO A LINE WITH A CR OR CHARLIM=EOTEXT") - [COND - ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) - - (* ;; "If this is a para-formatted document, use the paragraph bounds. Otherwise, delimit a para by the surrounding CRs.") - - (SETQ PARABOUNDS (\TEDIT.PARABOUNDS TEXTOBJ (fetch - (LINEDESCRIPTOR - CHAR1) of LINE)) - ) - (SETQ PARASTART (\TEDIT.FIND.PROTECTED.START - TEXTOBJ - (fetch (LINEDESCRIPTOR CHAR1) of LINE) - (CAR PARABOUNDS))) - (SETQ PARAEND (\TEDIT.FIND.PROTECTED.END TEXTOBJ - (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - (CDR PARABOUNDS] - (RPLACA L1 LINE) - (RPLACA LN LINE) - (bind (LL _ LINE) - while (AND [COND - ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) - (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) - of LL) - PARAEND)) - (T (NOT (fetch (LINEDESCRIPTOR CR\END) - of LL] - (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) - of LL) - TEXTLEN)) - do (* ; - "Walk forward thru the lines, looking for the last line in the paragraph.") - [COND - ((fetch (LINEDESCRIPTOR NEXTLINE) of LL) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) - of LL))) - (T [replace (LINEDESCRIPTOR NEXTLINE) of LL - with (\FORMATLINE TEXTOBJ NIL - (ADD1 (fetch (LINEDESCRIPTOR - CHARLIM) - of LL] - (replace (LINEDESCRIPTOR PREVLINE) - of (fetch (LINEDESCRIPTOR NEXTLINE) - of LL) with LL) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) - of LL] finally (RPLACA LN LL)) - (* ; - "SEARCH BACK TO A LINE WITH A CR OR BOTEXT") - [COND - ((IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) - 1) (* ; - "Only search backward if we're not on the first line already.") - (bind (LL _ LINE) - while [AND (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) - of LL) - 1) - (COND - ((fetch (TEXTOBJ FORMATTEDP) of - TEXTOBJ) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) - of LL) - PARASTART)) - (T (NOT (fetch (LINEDESCRIPTOR CR\END) - of (fetch (LINEDESCRIPTOR - PREVLINE) - of LL] - do - - (* ;; "Back up until we find the first line of the paragraph, or we hit the dummy top line (which claims to end in CR.)") - - (SETQ LL (fetch (LINEDESCRIPTOR PREVLINE) - of LL)) - finally - (RPLACA L1 (COND - ((AND (fetch (TEXTOBJ FORMATTEDP) - of TEXTOBJ) - (IEQP (fetch (LINEDESCRIPTOR CHAR1) - of LL) - PARASTART)) - (* ; "We found a true start of para.") - LL) - ([AND (fetch (LINEDESCRIPTOR PREVLINE) - of LL) - (NOT (ZEROP (fetch (LINEDESCRIPTOR - CHARLIM) - of (fetch - (LINEDESCRIPTOR - PREVLINE) - of LL] - (* ; - "We hit the first line in the paragraph, fair and square") - LL) - ((IEQP 1 (fetch (LINEDESCRIPTOR CHAR1) - of LL)) - (* ; - "We hit the front of the document.") - LL) - (T (\BACKFORMAT LINE.LIST TEXTOBJ - (fetch PTOP of WREG)) - (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE.LIST] - [replace (SELECTION CH#) of L - with (OR PARASTART (fetch (LINEDESCRIPTOR CHAR1) - of (CAR L1] - [replace (SELECTION CHLIM) of L - with (ADD1 (OR PARAEND (fetch (LINEDESCRIPTOR CHARLIM) - of (CAR LN] - [replace (SELECTION POINT) of L - with (COND - ((ILEQ (IDIFFERENCE (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - (fetch (SELECTION CH#) of L)) - (IDIFFERENCE (fetch (SELECTION CHLIM) - of L) - (fetch (LINEDESCRIPTOR CHARLIM) - of LINE))) - 'LEFT) - (T 'RIGHT] - (replace (SELECTION DCH) of L - with (IDIFFERENCE (fetch (SELECTION CHLIM) of L) - (fetch (SELECTION CH#) of L))) - (COND - ((fetch (LINEDESCRIPTOR LHASPROT) of LINE) - (* ; -"We have cause to suspect there may be protected text around this para. Fix the sel the hard way.") - (\FIXSEL L TEXTOBJ)) - (T (* ; - "No protected text is evident. DO it the easy way.") - (replace (SELECTION Y0) of L with - (fetch (LINEDESCRIPTOR - YBOT) - of (CAR L1))) - (replace (SELECTION YLIM) of L - with (fetch (LINEDESCRIPTOR YBOT) of (CAR LN))) - (replace (SELECTION X0) of L with - (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of (CAR L1))) - (replace (SELECTION XLIM) of L - with (fetch (LINEDESCRIPTOR LXLIM) - of (CAR LN))) - (replace (SELECTION DX) of L - with (IPLUS 1 (IDIFFERENCE (fetch (SELECTION XLIM) - of L) - (fetch (SELECTION X0) - of L] - (T (* ; - "Select the line we're pointing at.") - (replace (SELECTION SELKIND) of L with 'LINE) - (RPLACA L1 LINE) - (RPLACA LN LINE) - (replace (SELECTION CH#) of L with (fetch - (LINEDESCRIPTOR - CHAR1) of - LINE)) - (replace (SELECTION CHLIM) of L - with (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (replace (SELECTION DX) of L - with (IDIFFERENCE (fetch (LINEDESCRIPTOR LXLIM) - of LINE) - (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE))) - (replace (SELECTION X0) of L with (fetch - (LINEDESCRIPTOR - LEFTMARGIN) - of LINE)) - (replace (SELECTION XLIM) of L with (fetch - (LINEDESCRIPTOR - LXLIM) - of LINE)) - (replace (SELECTION Y0) of L - with (replace (SELECTION YLIM) of L - with (fetch (LINEDESCRIPTOR YBOT) - of LINE))) - (replace (SELECTION DCH) of L - with (IDIFFERENCE (fetch (SELECTION CHLIM) of L) - (fetch (SELECTION CH#) of L))) - (replace (SELECTION POINT) of L with 'LEFT) - (replace (SELECTION SET) of L with T)))) - (SHOULDNT "Unknown text/line-bar region?")) - (RETURN))) - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (RETURN (OR L PREVLINE]) - -(\TEDIT.SELECT.CHARACTER - [LAMBDA (TEXTOBJ SEL PREVCH LINE X Y TXB SELWINDOW SELOPERATION EXTENDING) - (* ; "Edited 29-Mar-94 13:28 by jds") - - (* ;; "We have moved over a particular character. If it's really a character, OK. Otherwise, call in the selection function!") - - (DECLARE (USEDFREE . WORDSELFLG)) - (COND - ((NULL PREVCH) - (replace (SELECTION SELOBJ) of SEL with NIL)) - ((SMALLP PREVCH) - (replace (SELECTION SELOBJ) of SEL with NIL)) - (T (replace (SELECTION SELOBJ) of SEL with PREVCH) - (replace (SELECTION X0) of SEL with TXB) - (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - [PROG ([OBJBOX (OR (IMAGEOBJPROP PREVCH 'BOUNDBOX) - (IMAGEBOX PREVCH SELWINDOW 'DISPLAY] - (DS (WINDOWPROP SELWINDOW 'DSP)) - SELRES) - (RESETLST - (RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS TXB (DSPXOFFSET NIL DS)) - (fetch XKERN of OBJBOX)) - DS) - (LIST (FUNCTION DSPXOFFSET) - (DSPXOFFSET NIL DS) - DS)) - (RESETSAVE (DSPYOFFSET (IDIFFERENCE (IPLUS (fetch (LINEDESCRIPTOR YBASE) - of LINE) - (DSPYOFFSET NIL DS)) - (fetch YDESC of OBJBOX)) - DS) - (LIST (FUNCTION DSPYOFFSET) - (DSPYOFFSET NIL DS) - DS)) - (RESETSAVE (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (IMIN (fetch XSIZE of OBJBOX - ) - (IDIFFERENCE - (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - TXB)) - HEIGHT _ (fetch YSIZE of OBJBOX)) - DS) - (LIST (FUNCTION DSPCLIPPINGREGION) - (DSPCLIPPINGREGION NIL DS) - DS)) - (SETQ SELRES (ERSETQ (APPLY* (IMAGEOBJPROP PREVCH 'BUTTONEVENTINFN) - PREVCH DS SEL (IDIFFERENCE X TXB) - (IDIFFERENCE Y (fetch (LINEDESCRIPTOR YBASE) - of LINE)) - SELWINDOW - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (COND - (EXTENDING 'RIGHT) - (WORDSELFLG 'MIDDLE) - (T 'LEFT)) - SELOPERATION))) - (* ; - "Go tell him he's being pointed at.") - ) - (COND - ((NULL SELRES) (* ; - "If the event fn returns NIL, do nothing untoward") - ) - ((NULL (CAR SELRES)) (* ; - "If it returns something with a CAR of NIL, then UN-SET the object-ness of the selection") - (replace (SELECTION SELOBJ) of SEL with NIL)) - (T (* ; - "Otherwise, check to see what he wants us to do") - (COND - ((EQ (CAR SELRES) - 'DON'T) (* ; - "The object declines to be selected. Don't permit the select to happen.") - (replace (SELECTION SET) of SEL with NIL)) - ((AND (LISTP (CAR SELRES)) - (FMEMB 'DON'T (CAR SELRES))) (* ; - "The object declines to be selected. Don't permit the select to happen.") - (replace (SELECTION SET) of SEL with NIL))) - (COND - ((EQ (CAR SELRES) - 'CHANGED) (* ; - "If the object claims to have changed, update the screen.") - (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL))) - ((AND (LISTP (CAR SELRES)) - (FMEMB 'CHANGED (CAR SELRES)))(* ; - "If the object claims to have changed, update the screen.") - (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL] - (SETQ WORDSELFLG NIL]) -) -(DEFINEQ - -(\FIXSEL - [LAMBDA (SEL TEXTOBJ THISWINDOW AVOIDINGTHISW) (* ; "Edited 31-May-91 12:26 by jds") - - (* ;; "Given that the selection SEL contains the correct CH# and CHLIM, reset the Y0 X0, DX, and XLIM values.") - - (PROG* ((CH# (fetch (SELECTION CH#) of SEL)) - (CHLIM (fetch (SELECTION CHLIM) of SEL)) - (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (THISW (OR THISWINDOW (\TEDIT.MAINW TEXTOBJ))) - (WREG (AND THISW (DSPCLIPPINGREGION NIL THISW))) - (STARTFOUND NIL) - (ENDFOUND NIL) - WLIST CHLIST LOOKS LINE PREVLINE L1HCPY LNHCPY) - (COND - ((NOT WINDOW) (* ; - "There is no window to go with this edit; don't bother to try updating the selection") - (RETURN)) - ((NOT THISW) (* ; - "There is no window to go with this edit; don't bother to try updating the selection") - (RETURN))) - [COND - ((AND AVOIDINGTHISW (fetch (SELECTION Y0) of SEL))) - (T (replace (SELECTION Y0) of SEL with (fetch PTOP of WREG] - (COND - ((AND AVOIDINGTHISW (fetch (SELECTION YLIM) of SEL))) - (T (replace (SELECTION YLIM) of SEL with -1))) - (OR (fetch (SELECTION XLIM) of SEL) - (replace (SELECTION XLIM) of SEL with -1)) - (* ; "Initialize it, if need be.") - (for WW inside WINDOW as L1 on (fetch (SELECTION L1) of SEL) - as LN on (fetch (SELECTION LN) of SEL) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) - do (COND - ([AND (fetch (SELECTION SET) of SEL) - (OR (NOT THISWINDOW) - (NEQ AVOIDINGTHISW (EQ THISWINDOW WW] - (* ; - "Only if a 'real' SELECTION proceed") - (SETQ WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (SETQ CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE)) - (RPLACA L1 NIL) - (RPLACA LN NIL) - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - TX DX while LINE - do (COND - [(AND (IGEQ CH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) - of LINE))) - (* ; - "The selection starts in this line. Fix L1, X0, and Y0.") - (SETQ STARTFOUND T) - (replace (SELECTION Y0) of SEL - with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - (* ; - "Remember that this is a hardcopy-mode line") - (RPLACA L1 LINE) - (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) - (* ; - "Temp. X value for scanning the line from left margin to the right") - (replace (SELECTION X0) of SEL - with (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE)) - (COND - ((IGREATERP CH# (fetch (LINEDESCRIPTOR CHAR1) - of LINE)) - (* ; - "Only bother formatting the line if the selection doesn't include the first character.") - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If this line isn't cached in THISLINE, reformat it.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR - CHAR1) - of LINE) - LINE))) - (COND - ((IGEQ (fetch LEN of THISLINE) - 0) (* ; - "As long as there's something there on the line...") - (bind (LOOKNO _ 0) for I from 0 - to (fetch LEN of THISLINE) as - CHNO - from (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - do - - (* ;; "Run thru the characters on the line, looking for the first selected one. Keep track of our X position, so we know where the selection starts.") - - (SETQ DX (\EDITELT WLIST I)) - (SETQ TX (IPLUS TX DX)) - (COND - ((IGEQ CHNO CH#) - (* ; - "We've found that first character. Time to bail out.") - (RETURN)) - [(EQ LMInvisibleRun (\EDITELT CHLIST I)) - (* ; - "This is INVISIBLE text. Count the characters as though they were there.") - (add LOOKNO 1) - (add CHNO (SUB1 (\EDITELT LOOKS - LOOKNO] - ((EQ LMLooksChange (\EDITELT CHLIST I)) - (* ; - "This is a format effector--reduce CHNO to ignore it") - (add LOOKNO 1) - (SETQ CHNO (SUB1 CHNO))) - (T - (* ; - "Not yet; update our running X-position in the SEL.") - (replace (SELECTION X0) - of SEL with TX] - ((AND (IEQP CH# (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE))) - (IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of - TEXTOBJ - ))) - - (* ;; "The selection starts after the end of this line, but it's also the end of the text. Go ahead and select there.") - - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If this line isn't cached in THISLINE, reformat it.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - LINE))) - (replace (SELECTION Y0) of SEL - with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (RPLACA L1 LINE) (* ; - "Make this line be the first in the selection") - (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - (replace (SELECTION X0) of SEL - with (fetch (LINEDESCRIPTOR LXLIM) of LINE))) - ((AND (NOT STARTFOUND) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of - LINE) - CH#) - (ILESSP (fetch (LINEDESCRIPTOR CHAR1) of LINE) - CHLIM)) (* ; - "The selection starts before this line, so play catch-up") - (replace (SELECTION Y0) of SEL - with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (RPLACA L1 LINE) (* ; - "Grab this line and make it the apparent first line.") - (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - (replace (SELECTION X0) of SEL - with (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE)) - (SETQ STARTFOUND T))) - [COND - ([AND (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of - LINE)) - (IGEQ CHLIM (fetch (LINEDESCRIPTOR CHAR1) of - LINE)) - (ILEQ CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE] - (* ; - "The selection ends in this line. Fix LN, XLIM, and YLIM.") - - (* ;; "NB that it also has to START before the end of this line. This eliminates the case of a 0-wide selection right after the last char on this line.") - - (replace (SELECTION YLIM) of SEL - with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (* ; - "Set the lowest-Y value for the selection") - (RPLACA LN LINE) (* ; "Remember the final line") - (SETQ LNHCPY (fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) - (* ; "Temp X position") - (replace (SELECTION XLIM) of SEL - with (fetch (LINEDESCRIPTOR LXLIM) of LINE)) - (* ; - "Start by assuming that the selection extends all the way across the line") - [COND - [(AND (IEQP CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE))) - (EQ (fetch (SELECTION POINT) of SEL) - 'RIGHT) - (IEQP (fetch (SELECTION DCH) of SEL) - 0) - (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) - (fetch (LINEDESCRIPTOR CR\END) of LINE)) - (* ; - "This selection starts AFTER the CR on a line, and doesn't include it.") - (RPLACA LN (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE)) - (* ; - "Change the selection to start on the next line, at the margin, instead.") - (replace (SELECTION XLIM) of SEL - with (fetch (LINEDESCRIPTOR LEFTMARGIN) - of (CAR LN))) - (replace (SELECTION YLIM) of SEL - with (fetch (LINEDESCRIPTOR YBOT) - of (CAR LN] - ((ILEQ CHLIM (IMIN (fetch (LINEDESCRIPTOR CHARLIM) - of LINE) - (fetch (TEXTOBJ TEXTLEN) of - TEXTOBJ))) - (* ; - "Only bother formatting if the selection doesn't include the last char on the line") - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If this line isn't cached in THISLINE, then reformat it.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR - CHAR1) - of LINE) - LINE))) - (COND - ((IGEQ (fetch LEN of THISLINE) - 0) (* ; - "If there are characters on the line, go looking for the one that ends the selection.") - (bind (LOOKNO _ 0) for I from 0 - to (fetch LEN of THISLINE) as CHNO - from (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - do - - (* ;; "Run thru the characters, until we find the final one that is selected. Kep running track of our X position on the line, so we know how wide the final line's hiliting should be.") - - (SETQ DX (\EDITELT WLIST I)) - (* ; "The current character's width") - (SETQ TX (IPLUS TX DX)) - (* ; "Running Temp-X position") - (COND - ((IGEQ CHNO CHLIM) - (* ; - "OK; this character is past the end of the selection. Stop here.") - (RETURN)) - [(EQ LMInvisibleRun (\EDITELT CHLIST I)) - (* ; - "This is a run of INVISIBLE characters. Count them in the character position, though.") - (add LOOKNO 1) - (add CHNO (SUB1 (\EDITELT LOOKS LOOKNO - ] - ((EQ LMLooksChange (\EDITELT CHLIST I)) - (* ; - "This is a format effector--reduce CHNO to ignore it") - (SETQ CHNO (SUB1 CHNO)) - (add LOOKNO 1)) - (T (* ; - "Keep track of how far across we've gotten.") - (replace (SELECTION XLIM) - of SEL with TX] - (RETURN) (* ; - "And stop looking for an ending line--we've obviously found it!") - ) - ((AND (IEQP CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE))) - (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of - LINE))) - (* ; - "The selection ends either here or at the start of the next line.") - (* ; - "ANN there is something on this line really selected.") - (replace (SELECTION YLIM) of SEL - with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (SETQ LNHCPY (fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - (RPLACA LN LINE) - (replace (SELECTION XLIM) of SEL - with (fetch (LINEDESCRIPTOR LXLIM) of LINE] - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - [COND - (L1HCPY (* ; - "The first line of the selection is hardcopy-mode. Convert the X0 value to screen units") - (replace (SELECTION X0) of SEL - with (FIXR (FQUOTIENT (fetch (SELECTION X0) - of SEL) - 35.27778] - [COND - (LNHCPY (* ; - "The last line of the selection is hardcopy-mode. Convert the XLIM value to screen units") - (replace (SELECTION XLIM) of SEL - with (FIXR (FQUOTIENT (fetch (SELECTION XLIM) - of SEL) - 35.27778] - (COND - [(IEQP 0 (fetch (SELECTION DCH) of SEL)) - (* ; - "If this is a point selection, put it on the correct side of the character we selected.") - (replace (SELECTION DX) of SEL with 0) - (COND - ((EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) - (replace (SELECTION XLIM) of SEL with - (fetch (SELECTION - X0) - of SEL))) - (T (replace (SELECTION X0) of SEL with - (fetch (SELECTION - XLIM) - of SEL] - (T (* ; - "Otherwise, fix DX for the selection") - (replace (SELECTION DX) of SEL - with (IDIFFERENCE (fetch (SELECTION XLIM) of SEL) - (fetch (SELECTION X0) of SEL]) - -(\TEDIT.FIXDELSEL - [LAMBDA (SELTOFIX TEXTOBJ CH#1 CH#LIM DCH) (* ; "Edited 30-May-91 23:00 by jds") - (* Fix up a SELTOFIX after deletion - inside that textobj) - (* Only if the Selection is set, and - is in THIS textobj) - (COND - ((AND (fetch (SELECTION SET) of SELTOFIX) - (EQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELTOFIX))) - (COND - ((IGEQ (fetch (SELECTION CH#) of SELTOFIX) - CH#LIM) (* The selection is after the - deleted text. Just move it forward) - (replace (SELECTION CH#) of SELTOFIX with (IDIFFERENCE (fetch - (SELECTION CH#) - of SELTOFIX) - DCH)) - (replace (SELECTION CHLIM) of SELTOFIX with (IDIFFERENCE (fetch - (SELECTION CHLIM) - of SELTOFIX) - DCH))) - ((IGREATERP (fetch (SELECTION CHLIM) of SELTOFIX) - CH#1) (* It overlaps, at least partially.) - (COND - ((IGEQ (fetch (SELECTION CH#) of SELTOFIX) - CH#1) - - (* If the start of the selection was inside the deleted area, it now starts - where the deletion left off.) - - (replace (SELECTION CH#) of SELTOFIX with CH#1))) - (replace (SELECTION CHLIM) of SELTOFIX with (IMAX CH#1 - (IDIFFERENCE - (fetch (SELECTION - CHLIM) - of SELTOFIX) - DCH))) - (replace (SELECTION DCH) of SELTOFIX with (COND - ((IEQP (fetch (SELECTION - CHLIM) - of SELTOFIX) - CH#1) - 0) - (T (IDIFFERENCE - (fetch (SELECTION CHLIM) - of SELTOFIX) - (fetch (SELECTION CH#) - of SELTOFIX]) - -(\TEDIT.FIXINSSEL - [LAMBDA (SELTOFIX TEXTOBJ CH#1 DCH) (* ; "Edited 30-May-91 23:00 by jds") - (* Fix up a SELTOFIX after deletion - inside that textobj) - (* Only if the Selection is set, and - is in THIS textobj) - (PROG (CH# CHLIM) - (COND - ((AND (fetch (SELECTION SET) of SELTOFIX) - (EQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELTOFIX))) - [COND - ((IGEQ (SETQ CH# (ffetch (SELECTION CH#) of SELTOFIX)) - CH#1) - - (* Fix up the selection; if we're beyond the insert point, move the whole sel - forward) - - (freplace (SELECTION CH#) of SELTOFIX with (IPLUS CH# DCH] - (COND - ((IGREATERP (SETQ CHLIM (ffetch (SELECTION CHLIM) of SELTOFIX)) - CH#1) (* And the tail end of the sel, too.) - (freplace (SELECTION CHLIM) of SELTOFIX with (IPLUS CHLIM DCH]) - -(\TEDIT.FIXSELS - [LAMBDA (TEXTOBJ EXCEPT) (* ; "Edited 30-May-91 23:03 by jds") - (* Fixes all the sels for a given - textobj.) - (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - when (NEQ SELN EXCEPT) do (AND (fetch (SELECTION SET) of SELN) - (\FIXSEL SELN TEXTOBJ]) -) -(DEFINEQ - -(TEDIT.RESET.EXTEND.PENDING.DELETE - [LAMBDA (SEL) (* ; "Edited 30-May-91 23:03 by jds") - (* Reset the "Extend Pending Delete" - status) - (AND SEL (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)) - (SETQ TEDIT.PENDINGDEL NIL) - (AND (fetch (SELECTION \TEXTOBJ) of SEL) - (replace (TEXTOBJ BLUEPENDINGDELETE) of (fetch (SELECTION \TEXTOBJ) of - SEL) - with NIL]) - -(\TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 30-May-91 23:00 by jds") - (* Set what the selection should be - displayed like, given what it's for - (NORMAL, COPY, MOVE, etc.)) - (SELECTQ OPERATION - (NORMAL (* Regular selection) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with T)) - (COPY (* Copy source) - (replace (SELECTION HOW) of SEL with COPYSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with NIL)) - (COPYLOOKS (* copylooks source) - (replace (SELECTION HOW) of SEL with COPYLOOKSSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 2) - (replace (SELECTION HASCARET) of SEL with NIL)) - (MOVE (* Copy source) - (replace (SELECTION HOW) of SEL with EDITMOVESHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL)) - (DELETE (* To be deleted instantly) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL) - NIL) - (PENDINGDEL (* Delete at next type-in) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - (INVERTED (* For people who really want to see - what's selected.) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - NIL]) -) -(DEFINEQ - -(\SHOWSEL - [LAMBDA (SEL HOW ON) (* ; "Edited 22-May-92 16:11 by jds") - - (* ;; "Highlight the selection SEL, according to HOW, turning it on or off according to ON") - - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (SHADE (OR (fetch (SELECTION HOW) of SEL) - BLACKSHADE)) - (SHADEHEIGHT (OR (fetch (SELECTION HOWHEIGHT) of SEL) - 1)) - LL SHOWFN) - (COND - ([OR (NOT (fetch (SELECTION SET) of SEL)) - (NOT (fetch (TEXTOBJ \WINDOW) of (fetch (SELECTION \TEXTOBJ) - of SEL] - - (* ;; "This operation only makes sense if there is a selection, it has been set, and there's a window to do the highlighting in.") - - (RETURN)) - ((fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ) - (* ; - "We're suppressing screen updating, so don't do anything visible.") - (RETURN))) - [for DS inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as L1 - in (fetch (SELECTION L1) of SEL) as LN in (fetch (SELECTION - LN) - of SEL) - as CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (COND - ((fetch (SELECTION SELOBJ) of SEL) - (* ; - "If it is an object and it has a non-nil showselfn then use it") - (\TEDIT.OBJECT.SHOWSEL TEXTOBJ SEL ON DS) - (RETURN))) - (COND - [(AND ON (NOT (fetch (SELECTION ONFLG) of SEL))) - (* ; - "It's off and we want to turn it on") - (\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE) - (COND - [(AND (fetch (SELECTION HASCARET) of SEL) - (ffetch (TEXTOBJ TXTEDITING) of TEXTOBJ)) - - (* ;; - "If the selection has a caret, turn one on. But only if the document is actively being edited.") - - (COND - [(EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) (* ; - "At the LEFT end of the selection") - (COND - ((AND L1 (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) - 0)) - (\SETCARET (fetch (SELECTION X0) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of L1) - DS TEXTOBJ CARET)) - (T (MOVETO -10 -10 DS] - ((AND LN (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LN) - 0)) (* ; "Or at the RIGHT end.") - (\SETCARET (fetch (SELECTION XLIM) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of LN) - DS TEXTOBJ CARET)) - (T (* ; - "Neither end is on screen. For self-caret flashers, move the caret location off-screen") - (MOVETO -10 -10 DS] - (T (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (AND L1 (MOVETO (fetch (SELECTION X0) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of L1) - DS))) - (RIGHT (AND LN (MOVETO (fetch (SELECTION XLIM) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of - LN) - DS))) - NIL] - ((AND (NOT ON) - (fetch (SELECTION ONFLG) of SEL)) - (* ; - "The selection is highlighted and we want to turn it off.") - (COND - ((AND (fetch (SELECTION HASCARET) of SEL) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - (ffetch (TEXTOBJ TXTEDITING) of TEXTOBJ)) - (* ; - "IF the selection has a caret with it, make sure it's turned off.") - (\EDIT.UPCARET CARET) (* ; - "Pick the caret up off the screen.") - )) - (\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE] - (replace (SELECTION ONFLG) of SEL with ON]) - -(\SHOWSEL.HILIGHT - [LAMBDA (TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE X0 XLIM) - (* ; "Edited 30-May-91 23:07 by jds") - - (* * Do the actual highlighting and unhighlighting of a selection for \SHOWSEL) - - (PROG (LL LEFT RIGHT) - (COND - ((OR L1 LN) - - (* One end or the other is on-screen, so it makes sense to try displaying - something.) - - (COND - ((AND L1 (EQ L1 LN) - (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) - 0)) (* It's all in a single line; - just underline the right section and - beat it) - (BITBLT NIL 0 0 DS (OR X0 (fetch (SELECTION X0) of SEL)) - (fetch (LINEDESCRIPTOR YBOT) of L1) - (IDIFFERENCE (OR XLIM (fetch (SELECTION XLIM) of SEL)) - (OR X0 (fetch (SELECTION X0) of SEL))) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of L1)) - 'TEXTURE - 'INVERT SHADE)) - (T (* Different lines.) - (COND - ((AND L1 (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) - 0)) (* If the first line is known, - underline the right section of it.) - [SETQ RIGHT (COND - ((fetch (FMTSPEC FMTHARDCOPY) of (fetch - (LINEDESCRIPTOR - LFMTSPEC) - of L1)) - (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR LXLIM) - of L1) - 35.27778))) - (T (fetch (LINEDESCRIPTOR LXLIM) of L1] - (BITBLT NIL 0 0 DS (OR X0 (fetch (SELECTION X0) of SEL)) - (fetch (LINEDESCRIPTOR YBOT) of L1) - (IDIFFERENCE RIGHT (OR X0 (fetch (SELECTION X0) of SEL))) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of L1)) - 'TEXTURE - 'INVERT SHADE))) - (SETQ LL (OR L1 LINES)) - (AND LL (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) - - (* The line after the first, or the top line on the screen -- - if we didn't have a first line) - - (while LL until (OR (EQ LL LN) - (ILESSP (fetch (LINEDESCRIPTOR YBOT) of - LL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do (* Highlight every line between - first and last) - [COND - [(fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LL)) - (* This line is in hardcopy mode. - Scale the margin values) - (SETQ LEFT (\MICASTOPTS (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LL))) - (SETQ RIGHT (\MICASTOPTS (fetch (LINEDESCRIPTOR LXLIM) - of LL] - (T (SETQ LEFT (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL)) - (SETQ RIGHT (fetch (LINEDESCRIPTOR LXLIM) of LL] - (BITBLT NIL 0 0 DS LEFT (fetch (LINEDESCRIPTOR YBOT) of LL) - (IDIFFERENCE RIGHT LEFT) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) - of LL)) - 'TEXTURE - 'INVERT SHADE) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) - (COND - ((AND LL (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - (* The final line is on-screen. - Hilight it, too.) - [SETQ LEFT (COND - ((fetch (FMTSPEC FMTHARDCOPY) of (fetch - (LINEDESCRIPTOR - LFMTSPEC) - of LL)) - (\MICASTOPTS (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LL))) - (T (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL] - (BITBLT NIL 0 0 DS LEFT (fetch (LINEDESCRIPTOR YBOT) of LN) - (IDIFFERENCE (OR XLIM (fetch (SELECTION XLIM) of SEL)) - LEFT) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LL)) - 'TEXTURE - 'INVERT SHADE))) (* Highlight the final line of the - selection) - ]) - -(\TEDIT.UPDATE.SHOWSEL - [LAMBDA (NSEL OSEL TSTFLG) (* ; "Edited 30-May-91 23:03 by jds") - (* Update the selection highlighting - to reflect the differences between - NSEL and OSEL) - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of OSEL))) - (PROG ((SHADE (OR (fetch (SELECTION HOW) of OSEL) - BLACKSHADE)) - (SHADEHEIGHT (OR (fetch (SELECTION HOWHEIGHT) of OSEL) - 1)) - (EXCHFLG NIL) - TSEL LL) - (replace (SELECTION ONFLG) of NSEL with T) - (* Make the new selection think that - we've really displayed all its new - aspects.) - [COND - ((fetch (SELECTION HASCARET) of OSEL) - (* Turn off the caret, if need be) - (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (\EDIT.UPCARET CARET] - [COND - ((NEQ (fetch (SELECTION CH#) of NSEL) - (fetch (SELECTION CH#) of OSEL)) - (* The new selection starts earlier; - add hilight at the front) - (COND - ((ILESSP (fetch (SELECTION CH#) of OSEL) - (fetch (SELECTION CH#) of NSEL)) - (* Actually, it starts later; - just exchange the selections) - (swap OSEL NSEL) - (SETQ EXCHFLG T))) - (for NEWL1 inside (fetch (SELECTION L1) of NSEL) as OLDL1 - inside (fetch (SELECTION L1) of OSEL) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as DS - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES NEWL1 OLDL1 DS SHADEHEIGHT - SHADE (fetch (SELECTION X0) of NSEL) - (fetch (SELECTION X0) of OSEL] - (COND - (EXCHFLG (* Put the selections back as they - were.) - (swap OSEL NSEL) - (SETQ EXCHFLG NIL))) - (COND - ((ILESSP (fetch (SELECTION CHLIM) of NSEL) - (fetch (SELECTION CHLIM) of OSEL)) - - (* Arrange for NSEL to be the selection that ends later, so that one set of - code will do both earlier AND later cases.) - - (swap OSEL NSEL) - (SETQ EXCHFLG T))) - (for OLDLN in (fetch (SELECTION LN) of OSEL) as NEWLN - in (fetch (SELECTION LN) of NSEL) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as OLDL1 - in (fetch (SELECTION L1) of OSEL) as DS - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES OLDLN NEWLN DS SHADEHEIGHT SHADE - (fetch (SELECTION XLIM) of OSEL) - (fetch (SELECTION XLIM) of NSEL))) - (COND - (EXCHFLG (* Put the selections back as they - were.) - (SETQ TSEL OSEL) - (SETQ OSEL NSEL) - (SETQ NSEL TSEL))) - (COND - ((fetch (SELECTION HASCARET) of NSEL) - (* Now put the caret back up.) - (for L1 in (fetch (SELECTION L1) of NSEL) as LN - in (fetch (SELECTION LN) of NSEL) as DS - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as CARET - inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (COND - ((EQ (fetch (SELECTION POINT) of NSEL) - 'LEFT) (* Left end of the selection) - (AND L1 (\SETCARET (fetch (SELECTION X0) of NSEL) - (fetch (LINEDESCRIPTOR YBOT) of L1) - DS TEXTOBJ CARET))) - (LN (* Right end of the selection) - (\SETCARET (fetch (SELECTION XLIM) of NSEL) - (fetch (LINEDESCRIPTOR YBOT) of LN) - DS TEXTOBJ CARET]) - -(\TEDIT.SHOWSELS - [LAMBDA (TEXTOBJ HOW ON) (* ; "Edited 30-May-91 23:03 by jds") - (* Turns all the selections for a - given Textobj on or off) - (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - do (AND (fetch (SELECTION SET) of SELN) - (\SHOWSEL SELN HOW ON]) - -(\TEDIT.REFRESH.SHOWSEL - [LAMBDA (TEXTOBJ NEWSEL OLDSEL OLDOP NEWOP EXTENDING) (* ; "Edited 30-May-91 23:03 by jds") - - (* * Update the screen hilighting to account for the changes that have taken - place between OLDSEL and NEWSEL.) - - (DECLARE (USEDFREE . GLOBALSEL)) - (PROG (NOSEL) - (COND - ((AND EXTENDING (EQ OLDOP NEWOP)) - - (* If we're extending a selection and the looks haven't changed, we can do it - the fast way, to prevent flicker.) - - (\TEDIT.UPDATE.SHOWSEL NEWSEL OLDSEL) - (\COPYSEL NEWSEL OLDSEL) - (replace (SELECTION ONFLG) of OLDSEL with T)) - (T - - (* Otherwise, we have to turn the old one off, change things, and turn the new - one on.) - - (\SHOWSEL OLDSEL NIL NIL) - (COND - ((NEQ OLDOP NEWOP) - - (* He changed his mind about copying, deleting, or whatever -- - change the kind of selection it is.) - - (SELECTQ NEWOP - ((NORMAL PENDINGDEL) - (SETQ GLOBALSEL TEDIT.SELECTION) - (SETQ NOSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (COPY (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION) - (SETQ NOSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) - (MOVE (SETQ GLOBALSEL TEDIT.MOVESELECTION) - (SETQ NOSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))) - (DELETE (SETQ GLOBALSEL TEDIT.DELETESELECTION) - (SETQ NOSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))) - (COPYLOOKS (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION) - (SETQ NOSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) - NIL) (* Remember the new operation type.) - (replace (SELECTION SET) of OLDSEL with NIL) - (* Turn off the old kind of - selection, so it doesn't reappear to - haunt us.) - (AND (fetch (SELECTION SET) of NOSEL) - (\SHOWSEL NOSEL NIL NIL)) (* If there was a new-type selection - around, turn it off.) - (SETQ OLDSEL NOSEL) (* Now cut over to the new selection) - (\TEDIT.SET.SEL.LOOKS OLDSEL NEWOP) (* And set it up looking right.) - )) - (\COPYSEL NEWSEL OLDSEL) - (replace (SELECTION ONFLG) of OLDSEL with NIL) - (* Make sure we can turn the - highlighting on.) - (\SHOWSEL OLDSEL NIL T))) - (RETURN (OR NOSEL OLDSEL]) -) -(DEFINEQ - -(\COPYSEL - [LAMBDA (FROM TO) (* ; "Edited 31-May-91 12:27 by jds") - (* Copy a SELECTION record from FROM - to TO, without creating any new ones) - (replace (SELECTION Y0) of TO with (fetch (SELECTION Y0) of FROM)) - (replace (SELECTION X0) of TO with (fetch (SELECTION X0) of FROM)) - (replace (SELECTION DX) of TO with (fetch (SELECTION DX) of FROM)) - (replace (SELECTION CH#) of TO with (fetch (SELECTION CH#) of FROM)) - (replace (SELECTION XLIM) of TO with (fetch (SELECTION XLIM) of FROM)) - (replace (SELECTION CHLIM) of TO with (fetch (SELECTION CHLIM) of FROM)) - (replace (SELECTION DCH) of TO with (fetch (SELECTION DCH) of FROM)) - (replace (SELECTION L1) of TO with (COPY (fetch (SELECTION L1) of FROM))) - (replace (SELECTION LN) of TO with (COPY (fetch (SELECTION LN) of FROM))) - (replace (SELECTION YLIM) of TO with (fetch (SELECTION YLIM) of FROM)) - (replace (SELECTION POINT) of TO with (fetch (SELECTION POINT) of FROM)) - (replace (SELECTION SET) of TO with (fetch (SELECTION SET) of FROM)) - (replace (SELECTION \TEXTOBJ) of TO with (fetch (SELECTION \TEXTOBJ) of - FROM)) - (replace (SELECTION SELKIND) of TO with (fetch (SELECTION SELKIND) of FROM)) - (replace (SELECTION HOW) of TO with (fetch (SELECTION HOW) of FROM)) - (replace (SELECTION HOWHEIGHT) of TO with (fetch (SELECTION HOWHEIGHT) - of FROM)) - (replace (SELECTION HASCARET) of TO with (fetch (SELECTION HASCARET) of - FROM)) - (replace (SELECTION SELOBJ) of TO with (fetch (SELECTION SELOBJ) of FROM)) - (replace (SELECTION ONFLG) of TO with (fetch (SELECTION ONFLG) of FROM]) - -(\TEDIT.SEL.CHANGED? - [LAMBDA (NEWSEL OLDSEL OLDSELOP NEWSELOP) (* ; "Edited 30-May-91 23:01 by jds") - - (* Decide whether there has been an interesting change in the selection, so we - can decide whether to refresh its hilighting on the screen.) - - (AND NEWSEL (fetch (SELECTION SET) of NEWSEL) - (NOT (AND (fetch (SELECTION SET) of OLDSEL) - (EQ (fetch (SELECTION SET) of OLDSEL) - (fetch (SELECTION SET) of NEWSEL)) - (EQUAL (fetch (SELECTION CH#) of NEWSEL) - (fetch (SELECTION CH#) of OLDSEL)) - (EQUAL (fetch (SELECTION CHLIM) of NEWSEL) - (fetch (SELECTION CHLIM) of OLDSEL)) - (EQ (fetch (SELECTION \TEXTOBJ) of NEWSEL) - (fetch (SELECTION \TEXTOBJ) of OLDSEL)) - (IEQP (fetch (SELECTION DX) of NEWSEL) - (fetch (SELECTION DX) of OLDSEL)) - (EQ (fetch (SELECTION POINT) of NEWSEL) - (fetch (SELECTION POINT) of OLDSEL)) - (EQ (fetch (SELECTION HOW) of NEWSEL) - (fetch (SELECTION HOW) of OLDSEL)) - (EQ (fetch (SELECTION HOWHEIGHT) of NEWSEL) - (fetch (SELECTION HOWHEIGHT) of OLDSEL)) - (EQ OLDSELOP NEWSELOP]) -) - - - -(* ;; "User entries to the selection code") - -(DEFINEQ - -(TEDIT.GETPOINT - [LAMBDA (STREAM SEL) (* ; "Edited 30-May-91 23:03 by jds") - - (* Given a selection, tell the CH# that type-in would be inserted in front of. - IF SEL is given, use it to decide. Otherwise, use STREAM's current selection.) - - (PROG [(TSEL (OR SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ STREAM] - (RETURN (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of TSEL) - (LEFT (fetch (SELECTION CH#) of TSEL)) - (RIGHT (fetch (SELECTION CHLIM) of TSEL)) - (SHOULDNT "Selection's POINT is neither RIGHT nor LEFT."]) - -(TEDIT.GETSEL - [LAMBDA (STREAM) (* ; "Edited 30-May-91 23:03 by jds") - (create SELECTION using (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) - of STREAM]) - -(TEDIT.MAKESEL - [LAMBDA (STREAM CH# LEN POINT) (* ; "Edited 30-May-91 23:03 by jds") - (PROG ((SEL (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION CH#) of SEL with CH#) - (replace (SELECTION CHLIM) of SEL with (IMAX CH# (IPLUS CH# LEN))) - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION POINT) of SEL with (OR POINT 'LEFT)) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - (replace (SELECTION SET) of SEL with T) - (AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\FIXSEL SEL TEXTOBJ)) - (\SHOWSEL SEL NIL T]) - -(TEDIT.SCANSEL - [LAMBDA (STREAM) (* ; "Edited 30-May-91 23:03 by jds") - - (* Set up to read the selected text; return the sel's length or NIL if nothing - selected.) - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - SEL) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (COND - ((fetch (SELECTION SET) of SEL) - (\SETUPGETCH (fetch (SELECTION CH#) of SEL) - TEXTOBJ) - (RETURN (fetch (SELECTION DCH) of SEL))) - (T (RETURN NIL]) - -(TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 30-May-91 23:01 by jds") - (* Set what the selection should be - displayed like, given what it's for - (NORMAL, COPY, MOVE, etc.)) - (PROG ((WASON (fetch (SELECTION ONFLG) of SEL))) - (\SHOWSEL SEL NIL NIL) - (SELECTQ OPERATION - (NORMAL (* Regular selection) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with T)) - (COPY (* Copy source) - (replace (SELECTION HOW) of SEL with COPYSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with NIL)) - (COPYLOOKS (* copylooks source) - (replace (SELECTION HOW) of SEL with COPYLOOKSSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 2) - (replace (SELECTION HASCARET) of SEL with NIL)) - (MOVE (* Copy source) - (replace (SELECTION HOW) of SEL with EDITMOVESHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL)) - (DELETE (* To be deleted instantly) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL) - NIL) - (PENDINGDEL (* Delete at next type-in) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - (INVERTED (* For people who really want to see - what's selected.) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - NIL) - (\SHOWSEL SEL NIL WASON]) - -(TEDIT.SETSEL - [LAMBDA (STREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION) - (* ; "Edited 30-May-91 23:05 by jds") - - (* ;; "Given a text stream or textobj, and a piece of text to select, set the internal selection, and return it.") - (* ; "Make sure we got a stream") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - SEL TEXTLEN) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (\SHOWSEL SEL NIL NIL) (* ; "First turn the old sel off.") - [COND - ((type? SELECTION CH#) (* ; - "He gave use a selection; just plug it in") - (\COPYSEL CH# SEL) - (replace (SELECTION ONFLG) of SEL with NIL) - (* ; - "And make sure it can be turned on.") - ) - (T (* ; "He fed us numbers; use them") - (replace (SELECTION CH#) of SEL with (IMIN (IMAX 1 CH#) - (ADD1 TEXTLEN))) - (* ; "Starting character") - [replace (SELECTION CHLIM) of SEL with (IMAX 1 CH# - (IMIN (IPLUS CH# LEN) - (ADD1 TEXTLEN] - (* ; "Last selected character") - [replace (SELECTION DCH) of SEL with (IMIN LEN TEXTLEN - (IDIFFERENCE - (fetch (SELECTION CHLIM) - of SEL) - (fetch (SELECTION CH#) - of SEL] - (replace (SELECTION POINT) of SEL with (OR (AND (IGREATERP CH# TEXTLEN) - 'LEFT) - POINT - 'LEFT)) - (* ; - "Which side the caret should go on") - (COND - ((OR (IGREATERP (fetch (SELECTION CH#) of SEL) - TEXTLEN) - (NEQ 1 LEN)) - (replace (SELECTION SELOBJ) of SEL with NIL)) - (T (replace (SELECTION SELOBJ) of SEL - with (fetch (PIECE POBJ) of (\CHTOPC (fetch (SELECTION - CH#) - of SEL) - (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - (* ; - "Link it back to the associated textobj") - [COND - (PENDINGDELFLG (* ; - "This selection is to be a pending-deletion sel.") - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) - (* ; - "Warn TEdit that there's a deletion pending") - (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'PENDINGDEL)) - (* ; - "And make the selection look right.") - ) - (T (* ; - "This selection is to be a pending-deletion sel.") - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL] - (replace (SELECTION SET) of SEL with T)(* ; - "Mark the selection as valid for others to use") - [COND - ((NOT LEAVECARETLOOKS) (* ; - "And set the insertion looks to follow.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL] - (\FIXSEL SEL TEXTOBJ) (* ; - "Update the selection's screen location") - (\SHOWSEL SEL NIL T) (* ; "Highlight it on the screen") - (RETURN SEL]) - -(TEDIT.SHOWSEL - [LAMBDA (STREAM ONFLG SEL) (* ; "Edited 30-May-91 23:04 by jds") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (COND - (SEL (* He's giving us a selection to - highlight. Connect it to this - textobj.) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - (\FIXSEL SEL TEXTOBJ))) - (\SHOWSEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - NIL ONFLG]) -) -(PUTPROPS TEDITSELECTION COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 -1990 1991 1992 1993 1994)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (2782 17597 (TEDIT.SEL.AS.STRING 2792 . 4245) (TEDIT.SELECTED.PIECES 4247 . 7745) ( -\TEDIT.FIND.FIRST.LINE 7747 . 11756) (\TEDIT.FIND.LAST.LINE 11758 . 13039) ( -\TEDIT.FIND.OVERLAPPING.LINE 13041 . 13483) (\TEDIT.FIND.PROTECTED.END 13485 . 15412) ( -\TEDIT.FIND.PROTECTED.START 15414 . 17034) (\TEDIT.WORD.BOUND 17036 . 17595)) (17641 18120 ( -\CREATE.TEDIT.SELECTION 17651 . 17721) (\CREATE.TEDIT.SHIFTEDSELECTION 17723 . 17826) ( -\CREATE.TEDIT.MOVESELECTION 17828 . 17957) (\CREATE.TEDIT.DELETESELECTION 17959 . 18118)) (18864 84316 - (TEDIT.EXTEND.SEL 18874 . 32763) (TEDIT.SELECT 32765 . 38574) (TEDIT.SCAN.LINE 38576 . 59323) ( -TEDIT.SELECT.LINE.SCANNER 59325 . 78264) (\TEDIT.SELECT.CHARACTER 78266 . 84314)) (84317 114722 ( -\FIXSEL 84327 . 108968) (\TEDIT.FIXDELSEL 108970 . 112637) (\TEDIT.FIXINSSEL 112639 . 113957) ( -\TEDIT.FIXSELS 113959 . 114720)) (114723 118260 (TEDIT.RESET.EXTEND.PENDING.DELETE 114733 . 115403) ( -\TEDIT.SET.SEL.LOOKS 115405 . 118258)) (118261 140862 (\SHOWSEL 118271 . 124249) (\SHOWSEL.HILIGHT -124251 . 131073) (\TEDIT.UPDATE.SHOWSEL 131075 . 136880) (\TEDIT.SHOWSELS 136882 . 137605) ( -\TEDIT.REFRESH.SHOWSEL 137607 . 140860)) (140863 144817 (\COPYSEL 140873 . 143265) ( -\TEDIT.SEL.CHANGED? 143267 . 144815)) (144870 157188 (TEDIT.GETPOINT 144880 . 145583) (TEDIT.GETSEL -145585 . 145892) (TEDIT.MAKESEL 145894 . 146787) (TEDIT.SCANSEL 146789 . 147431) (TEDIT.SET.SEL.LOOKS -147433 . 150578) (TEDIT.SETSEL 150580 . 156482) (TEDIT.SHOWSEL 156484 . 157186))))) -STOP diff --git a/library/TFBRAVO.LCOM b/library/TFBRAVO.LCOM deleted file mode 100644 index d1d917350a602882b9b2c2a4284a5ec27696daab..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 21952 zcmb_^eQ?|7eIEeQicOmgDASC>sM=$?azM{w@D7q`9DpE5{6GLd7yw04k|R?DWsrnP zg{1tFW$Rn6Z)-2Jv)FNLrxzz_n{Lg4q_o+xJG8g!I_HnoyYzZe@<(siU6!adi~(a~X1TinJB+t+}u;}gNi@W_W+=uf#W(UXWK zLUA#X&ZdepnaZiEEdtZUO2-mL#6+o_Ic?ch?Y8om49towDz8#~_DCCpW8Pf@e|7k9k>%mKF?uihdxN#ck^S%08XwvJZmn_m{cyx?;?+oR zATmBC&Wp&{xHu{B6BHXFk_d@Q=q@a_MI;sx^CA+Bif2V65)-FIBpemb;Ce^IjEDro z;wcdx4*@~LXuBf9@o_OJ!m%-NQG}xjF$Y2w7gt0$91|504n@V52nQqLEB?F)#m2>w2w`EXA{0r8H4zHO#q%N*iiu^A#He^qj7P*5#8_C=1m@Ym z5=MH>O~TEd%4bHipsQAKMqi__P#II1N?MdeNR+UhdE1_?AQcp;Y3!`3LOW@pMm2M$ zYES0)=2^wkTvbeqh`^>#i>N4~kh-AC(;}w3r!1u7Vy==YkERQwW|$G-`Epmc$G1V3 zPTt+1uTtf!d%D6uOFb1XI5X#6s2!ntd_xD0^A8tUoc->xYh9}f90FJ$8X7t)(>d?J z2?^B)j%i>>jWbtC@$mOi-`SX<2N2#Em!c5D=$WSttM< z+}MQ!GF@Q771;%j*WGwrOl8vfR5^2U0w)#%_DmP5l~N|nhpOT6sL4)@88DtOU@R_5 zi%%_Qmlta*>raX3I8JgVqmLU{s(Qj0z@HEyTp~Iai31a(B7kF=nl5KD?(-XQVUJa` zs-tw(Bx)EU%t;(!9HiItByHb6s;v$jX%YS9BU$C+8R%|H`BZA)NESOC8FzLG_iuFC zF5(g{fc4{MnEf*)*4Yf!fN49^i9}op?5)wbv<@;M#s*$}@LiT`VClWkFsce^sj?r)o$HESb ztugu73iGTmjNh2|FS; z*`9XtqV4-z0xfhlxFo`^O69dxBDOj8}i`>TE+UjKeyzyG65pPI*N-hQv& z7D-z$W#m8i`?{|E_axu8daYIi&AV`7pxUxeTsU6KUOi$D*7vPky|!AL%@^uL+y9C^ z@M67r!uB_h*?lkDLod|7Z2N!1K6>?D``8QhU$&3dhZxs;`v})j=XdOZZ`p&p0sFWw z>+Y%V+7a7dd!fC0%RVaWUmZdH_6A1}Yf#5s2!kuLxI9_`a{`-k;Z-Ps4JA?furg5C zJC#MkL}f+Txn@A&FwnDPL(!-JQGx9W4C53e7^T6Ozo9lLun4&Bfa|Dmbmqz}xDLGS zu5}_y2R=F1fiX^@KEtl7;4V9W+hz`(C9V!Si=1IQO56lrv8%F8G8A(@M`Wnlv*31& z%M2Mo-55tJ5;E?z`0Rx$=K_)0J3rC)!GW#8kTOZ}c*oN>(||@L6xpcYQ$# zv2W~nzTe_ebCk_Pw{q9++PS^vuJ(o+TaCankEzibJq@^%0nN}R!`+C zt)2h#zw!Tnk?*kw71~MA=~R9W(hMXPr}iQ8wW21f zHnbvBJ38)?GY{)K3Wd(>!J!r0TdSrYh5Gfuji3mc3aU}WE$>AlW6mTa5M@p6!{!hP zx@$vS{J`2_=n7^7!ZC*xLIaf&E+bGFOw#nD<`{zNYMO>1MINXCfpqRvnhkQ`pXC%} zOmJ187|GjGB`3AibOLqSz;4`2xCCA|GC-#`^&!-|wDxwDDKQoidDs+10v!Dg@?#5D+itF#2#0i9B!UUI*x11;MST3Q4&%6%F3!uWJC40mgNQiv zFe(@E@R&>BJkU9$l!LR4K?ihrH}@S&jGMk=@i-NW7)%5(fv}bzg92e-98#Nf5`z{Y zGoUSkFc_@>Y9XaW6m|}&C{#og3Rj2t5{(3f7K5V@;8d}Q1|e`y&1AHW0b_;+(J__4 zc5+aXjzr_8y9f}{Enh{jAq%jkxO30Iu96V=3;c2Fc5Y=j4x7Y*gD3loQIU!^EHP49 zIb4MbE4>Kj8K~ZbK2YJu!~)cs5D?iJ9O(p|9GhumU&w;7hOrHM+$j)(>UL}@P`I-a zXrgO7A)v}lpSPx}S=gC6>yzC2AvF5Kh>KF|!;sa|S*f%sxww=mQyxotlD4vnOoAW` z_Ejj!pXwqd*_*8SB+q5(jk#WbmoMqf?Z1|_{^CtjoL#*ExgSKRT*?>isZ3am8<6Dm zpg1|q5_n7`!lU7Y%NF6b1UTwCSq&gi291R&r6$(r@oMe8G&tzb_x(X#OA}IguBhc`U;{K`a&pK6$KFB(h6GJIBD8C8S<()r z!Nnr2QtBlvVdM0am5wZO5UpvN=o|-;>-KoMlfM2?SJL-x&$*-*rtgW`?$F(&%{A^} zVeoHXftgeaR3}oLvyk-OxSmc~Ikthd(pf%5(#>Fflq!~-321^$mQ(Yiz={0aRHnn+ z+QufQrbhKT30WQ9023OSanmC`IF6ox%jmB-klOwbZa%H<4A%CuSb{H^+TT0D=#}KZ zF54YX+E25FoRH1rv86;*is@8!q?b<}b}u-Bo?YA$mo~1f*Wi5t1D6@_+bl1^6Z5FJ zcx4-T<6?Ne4(E}$ytuhVHnq!}8<$ji@u|(l%k@VEaP)j7YfV>2r|k4xAp;y#mk6q3 zCZFLPvKu%D2D&Q9qv6iM;j+b#%>`-Jo2D}PYU&KHyp*m^0=3ELlbRfb={1ukRENbx zp#*#%kKOCT&NO^$H~M{EXeS@eQ(Q(v)=w> z&usG?Q-=9L)1O4fr)u5{1B{PKV|uBTvIlN7k4f?Q6(qbj>;d1G2|Wl=+U8pzLs1`Vg48|<5y%dkJae)zN3J<&+h!>zrYH?;whUN z=8D$ibJp|%YrYck!{DVrp**+%HXfElLTfMrT)zT@2^6Q$GwnTsiB`cE# z%Y$4jA#w^R2;4$J;GaaVfB?*6&VUHOkgt0NUx^8M@Nm4%6=1vwYlAKj*kv-t-P0!H z5SW^Qf%XOl#v2%G(eQZOfDkKSH&q4FYAO<7k-QREyCpz2X1O-tHvZ^@#!nex0dTZ<(3cOT+r^#gxrdl^gfL+{Kv+;An&sLp?QMj%$9SV$CRNq~mr zpeLUm48;o*tYwA)E5;unsV3Pr;rH8TxdlT%jWk0sq0kU^t=_ zNzZhBAn#A6rsTAUZJ;O6HBesN7ZKcv0PdaG-Vj??E??eU-r5qAk^mMA zYWs1}E$?do<98*+6Sc_&xOtAL_Z? zk(IYr->hHXxjmKJ{nccR=dQ|MZ1{d*?WW@WAJoZSE3dA`3oCwkZT9}PT$42Cx)3Q0 zEzqUCL6$cdiSs5M)!;xF(gwV(VbGY9z3e94fN(wzr)wC(!#21#%6mZ$$KY=z$LI`5 zA^BKCaGOlx_C(-UC0vBu4gK^P;9?wpSVF`V0h#@xfIIh!fZV+$pf8zmp%0w5*O$}v z#m&_A#?zCFTgzlQ?#$C<4VS9(?ijQx+Qm$v#FzuNo|+^&2Mxu+r;x_HLlCR?{|&Jg zfLMz;bqo~^2|Xzih3% z)0BSL{a3P$zFRNU{VVVMnljQ|om9YHOaqTv*H_WgL%MVB;74laKgiXXQ10*kajW?s z@>jboB90yC0s;x&IB9I~l#^<9o_Qu=1uQ&|NUu43=pcsVLkEQ+A3A6#eCVKj@S#KU zgby9$4L3_f&lzGVSr@;L##`T}%&c+e3|&=4OUE#Rw+ivW=Rap->v0jh3;dfF~6 zIFhiEZOI%y54DPTn4O%=j@gtdyw0)Y;600WqcXdX!O~9O9MQCz5ij9%{qMRN&T}Nc*yx zvKvv_6T=j`QV3f4$92(~loIM-YVGDHoyjF-7{a>{x0#V^!pDYKa#dMHGLvdq9SlwH zpIiv-AmT~Zmnk$w>vf18Ik+Tpn<_a>u1+tyxB%xCt%^9FhqX4oJ6fiIY=+RY5`4-y zL9P5m#c+CY{gd0Gwjs9bi`&Fh7sdJ_BHqOI;>8C^ozVkS;Aq$97ZnBQ=-8)-fGC!& zDtiv0ZF;U;hT21#ijss~$BgZjQY(b8X&4CZa-kXT8PE2s41S6K_8;{rQt?9em$QwB zemHsa`daSRH*>$RwzgWMfQ}(xCWN3$b+%-K${#>Y-1I5L5av@02*?q@vnjeSqzLM4 zGTBORKbs8?!DYP%I7iF1%M*m1Jk2})kxY?`;ft;J_EM9N(I2|HYO+982M;hAXE?fL z6nF<&h;IR)-Y7W1X~=Et46TM5RgrVF4s|85D^q>)&V^5l9xt4HDjHtS7XAC_4jN7EwHN zJ%KR`WXVXwkTIE5*U*=`xppJP$UbSVAa6G3NhkQb-RjqOy_UQ6LMx||p0{hWNY2*M zxBf*Mr@^jX_A4XkD+9fbOe~ak=787=M?Zr3T&qeDtu+YiJzohjZs;|s@C+iaqz7@Y zCJ;0g3_=t(+gGtBCLV!(BAq=|&Q#~hFi_*(J|Z`h%BJQDg@seVSJ>K7>k;TSn3Dz6 z1q201-akhkK`z7}wjYre1h%3yDGI-856?;*IId|iCTK>*Jh8G zsi)Pv218SOOqI*E(HVXPb;%`O;=;S6OOOVG{WwSya|Kb+1o|PU7UIK1ks^NbNR0Hf zACWm7Y$P3l+zrwV=v+XN9|3JmXEIal{-|&!RHx2;L)DO0idYHL8ZC&{fjBsHjGK+f z9Yi$GmD%_z{UyL6l#%NOxH%6!(4I%S{V2)8q)moK4;y6*DC!=DBqWnMs6i%2NFs`I zAAXPJl{LiOtc-u|c;0tO=sv#811w>i=O#=RB;7yQx)d0zhHW#+(H z5_~)t29v9dDYjp>^56F)<hJHfhdA@-{alw}RgYyy*vJevfG2mxERpz^&fAp? ztZ6|CQJ`o>@`cb|cidP|0#{c|CQR%T{CO^fge2HrlcXJ`_lVirR0l@_eKutoI}ax6$}r~l3dLxedWu50Vo*S_!3Z>U$6d$n(XQgg zwaHayw$xLsS34IxxN|=X1_&!YO!)oxcV)Y-b?5xv zb17?*ccV4y&E2@3^_^+{7y{7&YDvz31D5p);`f105*N+!(#4RWy|RG#Ff9R>LO}Q+ zLEV~#*~9a`*X!{mcRaT!49%1EDht5w@m7kNaMt%S|L%DHqx$_LUFBg@h3_a!&Fxt` zp0DW2L#E^j{Q119@N(<%wLf3-H80(H-E(jhP< zF}cyGwTqc9mTj&RnSUvsoURn`k_;-iP@0)CdBSBPBPp&atIaN%2e#(rON&<;+oi=# z>9xskY^-eoxv_Q?jBe;NaD2HNj+Fjnmt;k6Hza?NI`Oq5)%uWs_U4-@(Mrm!n(r+y zQ4z|M zsWhT2qDa4F;mOs;$JSjV^z+%3x? z3J>&2aCP9A28ObJU-JjP=G(sJcVOItp67UrC?r)cl|pU|OyLUpQ2-PU14Gy?uRK-X zE-Y?7h4*Fj7Q~d1zsaDydKKVu@xWZ3$F0w+5|9nu5_VAyf?8-0H+gymv_Uqyq=!Tt zOMcm;INV;fI4sz{13eX5k(^6d1Q|C)(JC2=ippp)O1JFedk&vtTkfFD z9c-n^1)#&+Q@y0^)j|!U8 z9hV`QZ_9D4+>b5{!0&1g?09w=ANO}Z!M_T>slp(9wf5kS=LOTr18SO7dJH~V`&e^J zwth|ZJJ8dzniouiA=O}Y;BMU%k36jAXVjPm{o)I`c>9Xq+V)W=xa8LoYB0XCNg8K-@bhlrok#&za_^-Ph2{rlfI#kt3m8O z3#>rp4|2BygUyeriT^?2RoT59uPDd(p8EZr;vcRq?7aV{v%7=&z58V!swW=~w3sCh z5{I*x!yICWtU8Z}3dM97!CY~f37;`>5gCdHa>8~n7##T*s;P_e#K8jeO{X9=1CwA0 z4iqD=OAL|*OzJUmIVx%tLwJ>e;es(RB#V4zx{82Jhp@z`n@1s*C-?^viLM?+j1zi} z!XyJ@Jq4C&sha}J3=CtxX@Ql09%eE`l#mis#v|Ye0?nKRgfLw<0_M8JZ})O@m8vyu zQDuzoO1X$_grC?&FmK{COB zxOnT^MdJ)EzV}4L|8=78g&S|Jyxshh9NfacIs3agNpKdmf9zF5PD=PG$qyy4+ z0`lFK^fe#RZFdKCQ4QM9SD^OX960jpE)rM2ZYX42RbBftpJ&H=-|X&xQ;uOptXz)a zmL;F$4k^FyH{|%MXxUoX@%)AE^L5i@x7hK#B`0qxcMGcg-9sw-u@SQJ>$>M|e`}@r zMP2tbr(;j^$Yp76qM3a6w6FQi8s)C7?$`If zQa{^V(2ZVJ-05fJ$kKc9Tbdhvgmceddq7uztyS0ib+$Pm+x)A7>l9Yss=vMS{-3}- zfcL(Vnu8n}G(Sw_54+>!53K+%smmf2hM49^{2a8z1K|y*Gmz0jIrx!$rDhJMh9mO;R2t4IP+?ad0+?1{T66au0kN9| zX>ZHJEH8q-%K#B68%Ch?;=ML{b@~e<(hIM*;VgFLk^U=v(}-Tc-nfdev@Phoa`R-j zB;&g`h`iKJ3wqz}N)hv;ZKGHQC!2!m&F;aE(@D*-v;%o}cofTw{Q%irLP*3S!Xh^n z-HxKiz|1D1A6J&Zu@PjUQ({yg5I6*$!kt`MUt8aJcAcUoVUE~-o<4wK5UQPa5BE}7 z#_%aH4Drlj&qi?i7j{gXNAMpaCLd4h$ruqq+>K%rBsFp76m) zz%CHJ&gBYQjh61N4=Ifkq8X4|K8YZMVnRC`VB^*DzaZW3=@S14S@~$FulX5O`D-o3qlLg)ko&SP8rccInq?~>Aje`tkQKYw(nzw3zfbR3lp zuXfEIeR1dZ1UW8bD5{F6aASx>_b@$GQsO?nWia;&gql=WdWZvIU00!qmtr+bR6~%I zs!T#)H!?OF&$-x{pd1Mh`^dEbsAfgPF0tf6OF5y(#Lq^b*%R0jL z(S|A-0cppL4g_2>b^|sL@ibdu(9~^{*(CdnF2V#Lh6e&5*;`_3dvU!66@wx##ItP8 z8lew&44>oh#wS1(5yc)jDTt_w0JJi&3ow{a#2r`UoVYR4&D-UvJl}oz5$P2H`572+ z-}gM*Ov&#rpPggtK-vm-Q7jI8?%C$YYyIBtyq7{;U&+_JY|A*t*6<%^ziIhX*J0w6 zk3G)40%PZ_cgPxg>q|M`*}We#LT8V|H*tf$*y7+PBPWfCNx7U{d3r`hVWbqa^=LbN zbT#1>=0yOiE4qM;PIJbjKM4;LChhg4e!b?+diS%wH@^y_{om0iWUlsQ)t$fEo%Q)W zh-{#+Z1I`)QP^Rmc97x;$ws8z`9u@xWkt|O!>qycZDs%G?y>t*hlC*bQ;lA}^DS%b z&lj3E`STX6U8tBK87JU`9bg*R2^m5F7O(y6ZO>BV_Gsn+>dmD4EdF8(aIiE%I&_*N zqHOdxkovvZ<|lB7zMOZVk-YV4z?wUkRiZgAr%s5lLFm(GGF9E>hI zOvvQzqOpxQf(gufXaY=^m2J$YepOh;_q+Y8``=*<`4az?#ozDtv}bb}5nyHj1D+)2 z35rD%F~Kvq^4diKE!coKKpl@Q3FTyQJwS70FO>~ngC5vo~Gy!EE?jxI??iDcQpuc3H5R<4gL^#M0^_2VDkHD zr?yv~UKZ=i%eAdxqFrl&%*S zp@ilVq!p-=!wed#imKtJrJ?a)j9P0Kz#;wWB6qU@o(m9_8w1V3=;(k6tp21JyHc+AcRWtnhU|hZP?X!-@)20pkW*oF`&*#ID zU$Su(90+`HM#1S)jEu_z-bSrmWzt$=dTrAQ59YEG=?r7sDpo9nEj!>MN~vwTVWD7Dh|{6i4UEswgocO((h z19e)E?B3)tr!^_X+D!ToK7)Pip{e7uLb#>c8YguU(4W!*%?BbSB41F|jmh$RB1ELx zDp4(t)vhcQ>5W~0)|f_sYY)Uv6iPxsVlNepX!|pxn*Kxyg?e{37g(BUK8ab)%Jw}6 z=Y(p9b?~{fru_#Fk6JT%doq>hJ?U}boeCgD1&75DS7A0o`~o~iau{p@5W8yA*P66| zLf1k@#$u=Gf{~o!dcVaPCN7G$+ch+fh)JCMVkKe(Fc>!=mM8h*XN@uS@Z;094sO_i zL+m+p13&Ef9p3s5=XY>6Sk6y#d_Dib&i}(3-_yDA_$KBYe?JUjhEyBb%_HT?!0_qi zby!s%7H5_>H=Yyejm^s&n~U3cIfeJH<9POnKQa0fr#}h&fr^JeU}8b&9(eH>8j;aN F{}(v@99jSX diff --git a/library/TEDIT b/library/tedit/TEDIT similarity index 98% rename from library/TEDIT rename to library/tedit/TEDIT index 6fed8e36..e776f084 100644 --- a/library/TEDIT +++ b/library/tedit/TEDIT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Jun-2022 20:05:24"  -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT.;41 143462 +(FILECREATED "14-Jul-2022 17:10:16"  +{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT.;47 143546 - :CHANGES-TO (FNS TEDIT) + :CHANGES-TO (VARS TEDITCOMS) - :PREVIOUS-DATE " 6-Jun-2022 00:36:53" -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT.;40) + :PREVIOUS-DATE "14-Jul-2022 16:30:30" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT.;45) (* ; " @@ -16,11 +16,11 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (PRETTYCOMPRINT TEDITCOMS) (RPAQQ TEDITCOMS - [(FILES TEDITDCL) + [(FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) - (FILES PCTREE TEXTOFD TEDITCOMMAND TEDITSCREEN TEDITABBREV TEDITLOOKS) + TEDIT-DCL)) + (FILES TEDIT-PCTREE TEDIT-TEXTOFD TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) (VARS (TEDIT.TERMSA.FONTS NIL) (TEDIT.TENTATIVE NIL) (TEDIT.DEFAULT.PROPS NIL) @@ -49,8 +49,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (COMS (* ; "Object-oriented editing") (FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.SUBTREE TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED)) - (FILES TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY - TEDITPAGE TEDITMENU TEDITFNKEYS) + (FILES TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-WINDOW TEDIT-SELECTION IMAGEOBJ + TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-MENU TEDIT-FNKEYS) (COMS (* ; "TEDIT Support information") (E (SETQ TEDITSYSTEMDATE (DATE))) (VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA")) @@ -63,7 +63,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1) (EXTENSION (TEDIT]) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -75,10 +75,10 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) -(FILESLOAD PCTREE TEXTOFD TEDITCOMMAND TEDITSCREEN TEDITABBREV TEDITLOOKS) +(FILESLOAD TEDIT-PCTREE TEDIT-TEXTOFD TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) (RPAQQ TEDIT.TERMSA.FONTS NIL) @@ -2260,15 +2260,15 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. NIL T]) ) -(FILESLOAD TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY - TEDITPAGE TEDITMENU TEDITFNKEYS) +(FILESLOAD TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-WINDOW TEDIT-SELECTION IMAGEOBJ TEDIT-TFBRAVO + TEDIT-HCPY TEDIT-PAGE TEDIT-MENU TEDIT-FNKEYS) (* ; "TEDIT Support information") -(RPAQQ TEDITSYSTEMDATE "22-Jun-2022 20:05:24") +(RPAQQ TEDITSYSTEMDATE "14-Jul-2022 17:10:16") (RPAQ TEDITSUPPORT "TEditSupport.PA") (DEFINEQ @@ -2294,20 +2294,20 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4349 118632 (\TEDIT2 4359 . 7110) (COERCETEXTOBJ 7112 . 15888) (TEDIT 15890 . 21156) ( -TEDITSTRING 21158 . 21717) (TEDIT-SEE 21719 . 24308) (TEDIT.CHARWIDTH 24310 . 26334) (TEDIT.COPY 26336 - . 34772) (TEDIT.DELETE 34774 . 35464) (TEDIT.DO.BLUEPENDINGDELETE 35466 . 38533) (TEDIT.INSERT 38535 - . 44065) (TEDIT.KILL 44067 . 45624) (TEDIT.MAPLINES 45626 . 47025) (TEDIT.MAPPIECES 47027 . 47983) ( -TEDIT.MOVE 47985 . 57769) (TEDIT.QUIT 57771 . 59771) (TEDIT.STRINGWIDTH 59773 . 60444) (TEDIT.\INSERT -60446 . 62471) (TEXTOBJ 62473 . 63598) (TEXTSTREAM 63600 . 65215) (\TEDIT.INCLUDE 65217 . 69117) ( -\TEDIT.INSERT.PIECES 69119 . 79034) (\TEDIT.MOVE.PIECEMAPFN 79036 . 81115) (\TEDIT.OBJECT.SHOWSEL -81117 . 84746) (\TEDIT.RESTARTFN 84748 . 86743) (\TEDIT.CHARDELETE 86745 . 90707) ( -\TEDIT.COPY.PIECEMAPFN 90709 . 93934) (\TEDIT.DELETE 93936 . 101454) (\TEDIT.DIFFUSE.PARALOOKS 101456 - . 104220) (\TEDIT.FOREIGN.COPY? 104222 . 107949) (\TEDIT.QUIT 107951 . 111097) (\TEDIT.WORDDELETE -111099 . 115932) (\TEDIT1 115934 . 118630)) (118746 118862 (\CREATE.TEDIT.RESTART.MENU 118756 . 118860 -)) (118961 122650 (PLCHAIN 118971 . 119245) (PRINTLINE 119247 . 122011) (SEEFILE 122013 . 122648)) ( -122691 142334 (TEDIT.INSERT.OBJECT 122701 . 131778) (TEDIT.EDIT.OBJECT 131780 . 134036) ( -TEDIT.FIND.OBJECT 134038 . 134931) (TEDIT.FIND.OBJECT.SUBTREE 134933 . 135739) (TEDIT.PUT.OBJECT -135741 . 137400) (TEDIT.GET.OBJECT 137402 . 140601) (TEDIT.OBJECT.CHANGED 140603 . 142332)) (142612 -142975 (MAKETEDITFORM 142622 . 142973))))) + (FILEMAP (NIL (4418 118701 (\TEDIT2 4428 . 7179) (COERCETEXTOBJ 7181 . 15957) (TEDIT 15959 . 21225) ( +TEDITSTRING 21227 . 21786) (TEDIT-SEE 21788 . 24377) (TEDIT.CHARWIDTH 24379 . 26403) (TEDIT.COPY 26405 + . 34841) (TEDIT.DELETE 34843 . 35533) (TEDIT.DO.BLUEPENDINGDELETE 35535 . 38602) (TEDIT.INSERT 38604 + . 44134) (TEDIT.KILL 44136 . 45693) (TEDIT.MAPLINES 45695 . 47094) (TEDIT.MAPPIECES 47096 . 48052) ( +TEDIT.MOVE 48054 . 57838) (TEDIT.QUIT 57840 . 59840) (TEDIT.STRINGWIDTH 59842 . 60513) (TEDIT.\INSERT +60515 . 62540) (TEXTOBJ 62542 . 63667) (TEXTSTREAM 63669 . 65284) (\TEDIT.INCLUDE 65286 . 69186) ( +\TEDIT.INSERT.PIECES 69188 . 79103) (\TEDIT.MOVE.PIECEMAPFN 79105 . 81184) (\TEDIT.OBJECT.SHOWSEL +81186 . 84815) (\TEDIT.RESTARTFN 84817 . 86812) (\TEDIT.CHARDELETE 86814 . 90776) ( +\TEDIT.COPY.PIECEMAPFN 90778 . 94003) (\TEDIT.DELETE 94005 . 101523) (\TEDIT.DIFFUSE.PARALOOKS 101525 + . 104289) (\TEDIT.FOREIGN.COPY? 104291 . 108018) (\TEDIT.QUIT 108020 . 111166) (\TEDIT.WORDDELETE +111168 . 116001) (\TEDIT1 116003 . 118699)) (118815 118931 (\CREATE.TEDIT.RESTART.MENU 118825 . 118929 +)) (119030 122719 (PLCHAIN 119040 . 119314) (PRINTLINE 119316 . 122080) (SEEFILE 122082 . 122717)) ( +122760 142403 (TEDIT.INSERT.OBJECT 122770 . 131847) (TEDIT.EDIT.OBJECT 131849 . 134105) ( +TEDIT.FIND.OBJECT 134107 . 135000) (TEDIT.FIND.OBJECT.SUBTREE 135002 . 135808) (TEDIT.PUT.OBJECT +135810 . 137469) (TEDIT.GET.OBJECT 137471 . 140670) (TEDIT.OBJECT.CHANGED 140672 . 142401)) (142696 +143059 (MAKETEDITFORM 142706 . 143057))))) STOP diff --git a/library/TEDITABBREV b/library/tedit/TEDIT-ABBREV similarity index 72% rename from library/TEDITABBREV rename to library/tedit/TEDIT-ABBREV index 95af7f00..39a46395 100644 --- a/library/TEDITABBREV +++ b/library/tedit/TEDIT-ABBREV @@ -1,25 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Aug-2020 14:52:14"  -{DSK}kaplan>Local>medley3.5>lispcore>library>TEDITABBREV.;4 10066 - changes to%: (VARS TEDITABBREVCOMS) - (FNS \TEDIT.TRY.ABBREV) +(FILECREATED "14-Jul-2022 16:53:34"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;1 9767 - previous date%: "25-Aug-94 10:52:43" -{DSK}kaplan>Local>medley3.5>lispcore>library>TEDITABBREV.;1) + :PREVIOUS-DATE "14-Jul-2022 11:08:10" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-ABBREV.;3) -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, 2020 by Venue & Xerox Corporation. All rights reserved. -") +(PRETTYCOMPRINT TEDIT-ABBREVCOMS) -(PRETTYCOMPRINT TEDITABBREVCOMS) - -(RPAQQ TEDITABBREVCOMS - [(FILES TEDITDCL) +(RPAQQ TEDIT-ABBREVCOMS + [(FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV) (GLOBALVARS TEDIT.ABBREVS) (INITVARS (TEDIT.ABBREVS '(("b" . "357,146") @@ -69,7 +63,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, ("DATE" . \TEDIT.EXPAND.DATE) (">>DATE<<" . \TEDIT.EXPAND.DATE]) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -81,12 +75,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DEFINEQ (\TEDIT.ABBREV.EXPAND - [LAMBDA (STREAM) (* ; "Edited 30-May-91 19:27 by jds") + [LAMBDA (STREAM) (* ; "Edited 30-May-91 19:27 by jds") (* ; "Expand an abbvreviation") (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) SEL CH# (CH NIL) @@ -97,33 +91,33 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, (RIGHT (SUB1 (fetch (SELECTION CHLIM) of SEL))) 0)) [COND - ((ZEROP (fetch (SELECTION DCH) of SEL)) (* ; - "Point Selection, so use the character to the left") + ((ZEROP (fetch (SELECTION DCH) of SEL)) (* ; + "Point Selection, so use the character to the left") (COND ((ZEROP CH#) (* ; - "If we're off the front of the document, don't bother trying.") + "If we're off the front of the document, don't bother trying.") (RETURN))) (\SETUPGETCH CH# TEXTOBJ) [SETQ CH (MKSTRING (CHARACTER (\BIN STREAM] (TEDIT.SETSEL STREAM CH# 1 'RIGHT)) (T (* ; - "We have a selection that isn't just a caret. Use it.") + "We have a selection that isn't just a caret. Use it.") (SETQ CH (TEDIT.SEL.AS.STRING STREAM] - (SETQ EXPANSION (\TEDIT.TRY.ABBREV CH STREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.") + (SETQ EXPANSION (\TEDIT.TRY.ABBREV CH STREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.") (COND (EXPANSION (* ; - "It exists, so insert it where the abbrev used to be") + "It exists, so insert it where the abbrev used to be") (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; "Force it to abandon caching") (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ)) (TEDIT.DELETE TEXTOBJ SEL) (* ; - "First, delete the thing being expanded.") + "First, delete the thing being expanded.") (TEDIT.INSERT STREAM EXPANSION SEL OLDLOOKS]) (\TEDIT.EXPAND.DATE - [LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds") - - (* ;; "Provide the date as the expansion for an abbreviation") + [LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds") + + (* ;; "Provide the date as the expansion for an abbreviation") (PROG* ((DATE (\UNPACKDATE)) (YEAR (pop DATE)) @@ -135,13 +129,13 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, " " DAY ", " YEAR]) (\TEDIT.TRY.ABBREV - [LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:") - (* jds "11-Jul-85 12:46") + [LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:") + (* jds "11-Jul-85 12:46") - (* ;; - "Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.") + (* ;; + "Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.") - (* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.") + (* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.") (PROG (SEL CH# (CH NIL) EXPANSION) @@ -149,16 +143,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, (SASSOC (U-CASE ABBREV) TEDIT.ABBREVS))) - (* Find the abbreviation's expansion --first try it as-is, then try the - upper-case version to be safe.) + (* Find the abbreviation's expansion --first try it as-is, then try the + upper-case version to be safe.) (RETURN (COND - (EXPANSION (* There's an expansion. - Turn it into an insertable string.) + (EXPANSION (* There's an expansion. + Turn it into an insertable string.) (COND [(STRINGP (CDR EXPANSION)) - (* ;; "Could be a character code") + (* ;; "Could be a character code") (COND ((SETQ CH (CHARCODE.DECODE (CDR EXPANSION) @@ -167,14 +161,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, (T (CDR EXPANSION] ((SMALLP (CDR EXPANSION)) - (* ;; "Treat a number as a character code.") + (* ;; "Treat a number as a character code.") (CHARACTER (CDR EXPANSION))) ((AND (LITATOM (CDR EXPANSION)) - (GETD (CDR EXPANSION))) (* It's a function to be called.) + (GETD (CDR EXPANSION))) (* It's a function to be called.) (APPLY* (CDR EXPANSION) STREAM CH)) - (T (* Anything else is a form to EVAL.) + (T (* Anything else is a form to EVAL.) (EVAL (CDR EXPANSION]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -229,9 +223,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993, 1994, (" " . "357,41") ("DATE" . \TEDIT.EXPAND.DATE) (">>DATE<<" . \TEDIT.EXPAND.DATE))) -(PUTPROPS TEDITABBREV COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1991 -1992 1993 1994 2020)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3480 8598 (\TEDIT.ABBREV.EXPAND 3490 . 5811) (\TEDIT.EXPAND.DATE 5813 . 6458) ( -\TEDIT.TRY.ABBREV 6460 . 8596))))) + (FILEMAP (NIL (3281 8423 (\TEDIT.ABBREV.EXPAND 3291 . 5638) (\TEDIT.EXPAND.DATE 5640 . 6273) ( +\TEDIT.TRY.ABBREV 6275 . 8421))))) STOP diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..fe482f187f4daaa724be186d0974a6a518646240 GIT binary patch literal 3842 zcmb_fZExFD6i%~sfVD!07@GJn9T`1Z~lPd9z4~VbqU-Tz%?mf1XuH6O-QDxur+;i`FeeQK7!(6l+ zGr4HlX3}yNT{vIUOI3Zz1krMQvu;~nO@#AxQ#X8l!F~Z=&^;66bV3j$wnGWkeA56? z){>RIPEtuL3dq@fM$Ky(5hStM+uC05v|G^Yf(XKwhFAT1es8DU-zjW1wmXe(q0?(N zI)$xvtJA)xrZR;)z5eEU_g0dSLT7!g-{{{f?6zC$y9Kmm`AL0Yp>AGIU62zX9JZ|H z<+*%1C&F649hq+5-R|#9<)Pc#y^TA=I=ZsBV%sq6bSjk+q18Y$$L=XBV&b(StJ?n` zBFyEoImp*AV9Q5`R-#ISDYC^cqlb#BaZeFSBjsbaNR*-6t z0WN!%>p%@OaBahO-KvLz3Z*i>6nuS%Zy7w(#&;Tg^NQ~-RKUWq=VJpcCm{Cc8?o3} z@l*_df1EqhI8~<^w+J}3`TW6I!tMux=7n^{52WdFZ0=FWs6Vl7nd#jG*jDuaE{MB{JpYq@N=a# ze&R- zCFC5)ISsC(+DdK7^f7O87UjjOX5GciX|qFPmOr+q<#=Y@2U!gP!?aCo4H*eY8n{!6 ziXo#XK^6V_YEVg-3l-6~lbEQTaj8r?lSu~1%Yul0lBa--k8 zjgY?GU+>_1xxo}Fd)+pFb(o~@-P+sP#evt}-feHKwfi`Bo4Y+4IlV7J&}cVln21t0 zRM;qU!`x)u#*;^MMCxHjveZ!(c>0Lq$i~kx3-L3xlf|1X8$3&o-z6FikZY|+W-Cq{ zdA}N8=W16Uk5}W99GtAS;^SjKkj7-Zr4|n!o~@F2zZ!q0S2}U~owp|g2y-sWX)rJA zHq2qa(miF=AeS8?N|qffA!{;3p^|HuDZ^whU@gcAh6fPFrhA@S0!4-E6tFfll1IhM~Sq{AtbF0HtD=tz>dCPE5C zHIti`wXBFs#BPLW8V9x*AaEW0IAAJ%q>{;TpcMhxGzW|UAah`c1L8a*pP2 zGFcE&Aw$5F7;0qj4o9QkgmR8#c?Pd-^c|Pv$WeJli4byB9nzubZ z$$=3Hy)#fD;In8ClI>8|C>#m~a~BkBHJT?AA4e9lRFAu%LY6k13FRE+;u9|OMp9_S zcBqjJ5)sI%LIuPllQN|$wB;`EG%RQcto6vMrc7(Jra1%!j`3VjcT#8rPl81-sJKS1 zvAcj-KT0vyX@vrtpPzq;MuPw7tI}hn9^x|{D;Eg~i3tClZm(fm)WIXs?X_&kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-CHAT.;1 21593 + + :PREVIOUS-DATE "14-Jul-2022 10:40:06" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-CHAT.;1) + + +(PRETTYCOMPRINT TEDIT-CHATCOMS) + +(RPAQQ TEDIT-CHATCOMS + ((COMS (* ; "character routines") + (FNS TEDITCHAT.CHARFN \TEXTSTREAMBOUT)) + (COMS (FNS TEDITSTREAM.INIT TEDITCHAT.MENUFN)) + (COMS (* ; "TEDIT update routines") + (FNS TEDIT.DISPLAYTEXT)) + (GLOBALVARS TEDITCHAT.MENU CHAT.DRIVERTYPES CHAT.DISPLAYTYPES) + (VARS TEDITCHAT.MENUITEMS (TEDITCHAT.MENU)) + (ADDVARS (CHAT.DRIVERTYPES (TEDIT TEDITCHAT.CHARFN NILL))) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) + CHATDECLS)))) + + + +(* ; "character routines") + +(DEFINEQ + +(TEDITCHAT.CHARFN + [LAMBDA (CH CHAT.STATE) (* ; "Edited 12-Jun-90 18:00 by mitani") + (LET* [(TEXTSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE)) + (SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ TEXTSTREAM] + (\CARET.DOWN (fetch (TEXTOBJ DS) of (TEXTOBJ TEXTSTREAM))) + (SELCHARQ CH + (BS (\TEDIT.CHARDELETE TEXTSTREAM "" SEL) + [MOVETO (fetch X0 of SEL) + (fetch Y0 of SEL) + (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM]) + (LF NIL) + (BOUT TEXTSTREAM CH]) + +(\TEXTSTREAMBOUT + [LAMBDA (STREAM BYTE) (* ; "Edited 28-Mar-94 15:29 by jds") + + (* ;; "Do BOUT to a text stream, which is an insertion at the caret.") + + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + CH# WINDOW TEXTLEN PS PC PSTR OFFST SEL) + (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) + (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + (COND + ((NOT (CAR (fetch L1 of SEL))) + (RETURN))) (* ; + "Return if caret out of bounds, ie, user scrolls past end of text") + (SETQ CH# (fetch CH# of SEL)) + (AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#)) + (COND + ((IEQP BYTE 13) + (\INSERTCR BYTE CH# TEXTOBJ)) + (T (\INSERTCH BYTE CH# TEXTOBJ))) + (AND WINDOW + (PROG ((THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) + EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES + NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE CURLINE + FONT (L1 (CAR (fetch L1 of SEL))) + (LN (CAR (fetch LN of SEL))) + (LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) + TEXTOBJ))) + (add (fetch CH# of SEL) + 1) (* ; + "These must be here, since SELs are valid even without a window.") + (replace CHLIM of SEL with (fetch CH# of SEL)) + (replace POINT of SEL with 'LEFT) + (replace DCH of SEL with 0) + (replace SELKIND of SEL with 'CHAR) + (SETQ CURLINE L1) + (add (fetch CHARLIM of CURLINE) + 1) + (add (fetch CHARTOP of CURLINE) + 1) + (SETQ FONT (fetch CLFONT of LOOKS)) + (DSPFONT FONT (CAR WINDOW)) + [COND + [(OR (IGREATERP (PLUS (fetch X0 of SEL) + (CHARWIDTH BYTE FONT)) + (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + 8)) + (IEQP BYTE (CHARCODE CR))) (* ; + "gone off the edge of the line reformat and add new line") + (TEDIT.UPDATE.SCREEN TEXTOBJ) + (\FIXSEL SEL TEXTOBJ (CAR WINDOW)) + (SETQ L1 (CAR (fetch L1 of SEL))) + (SETQ LN (CAR (fetch LN of SEL))) + (COND + ([OR (NULL (SELECTQ (fetch POINT of SEL) + (LEFT L1) + (RIGHT LN) + NIL)) + (ILEQ (SELECTQ (fetch POINT of SEL) + (LEFT (fetch YBOT of L1)) + (RIGHT (fetch YBOT of LN)) + 0) + (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL (CAR WINDOW] + (* ; + "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.") + (while (ILESSP (fetch Y0 of SEL) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + do (* ; + "The caret just went off-screen. Move it up some.") + (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) + (SCROLLW (CAR WINDOW) + 0 + (LLSH (COND + [(SELECTQ (fetch POINT of SEL) + (LEFT L1) + (RIGHT LN) + NIL) + (fetch LHEIGHT + of (SELECTQ (fetch POINT of SEL) + (LEFT L1) + (RIGHT LN) + (SHOULDNT] + (T 12)) + 1] + (T (TEDIT.DISPLAYTEXT TEXTOBJ BYTE (CHARWIDTH BYTE FONT) + CURLINE + (fetch X0 of SEL) + (CAR WINDOW) + SEL) (* ; + "Print out the character on the screen") + (add (fetch X0 of SEL) + (CHARWIDTH BYTE FONT)) + + (* ;; "And move the selection's notion of our X position to the right to account for that character's width.") + + (replace XLIM of SEL with (fetch X0 of SEL] + +(* ;;; "Fix up the TEXTSTREAM so that the FILEPTR looks like it ought to after the BOUT, even though we've been updating the screen (which usually moves the fileptr....)") + + [SETQ PS (ffetch (PIECE PSTR) of (SETQ PC (fetch (TEXTOBJ \INSERTPC) + of TEXTOBJ] + (* ; + "This piece resides in a STRING. Because it's newly 'typed' material.") + (replace (TEXTSTREAM PIECE) of STREAM with PC) + (* ; + "Remember the current piece for others.") + (* ; "And which number piece this is.") + (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) + of PS) + (LRSH (SETQ OFFST + (ffetch (STRINGP OFFST) + of PS)) + 1))) + (* ; + "Pointer to the actual characters in the string (allowing for substrings.)") + (freplace (STREAM CPAGE) of STREAM with 0) + (freplace (STREAM COFFSET) of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH + ) of STREAM + with (LOGAND 1 OFFST)) + (fetch (TEXTOBJ \INSERTLEN) + of TEXTOBJ))) + (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) + (* ; + "Page # within the 'file' where this piece starts") + (freplace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM COFFSET) of STREAM)) + (freplace (STREAM EPAGE) of STREAM with 1) + (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) + (* ; + "We're, perforce, at the end of the piece.") + (freplace (TEXTSTREAM REALFILE) of STREAM with NIL) + (* ; "We're not on a file....") + ]) +) +(DEFINEQ + +(TEDITSTREAM.INIT + [LAMBDA (WINDOW MENUFN) (* ; "Edited 12-Jun-90 18:01 by mitani") + + (* ;; "Initialize and return TEDIT TEXTSTREAM") + + (PROG* ((TEXTSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL)) + (TEXTOBJ (TEXTOBJ TEXTSTREAM))) (* ; + "force shift select typein to be put in keyboard buffer") + (TEXTPROP TEXTSTREAM 'COPYBYBKSYSBUF T) + (replace (STREAM STRMBOUTFN) of TEXTSTREAM with '\TEXTSTREAMBOUT) + (replace SET of (fetch (TEXTOBJ SEL) of TEXTOBJ) with T) + [replace L1 of (fetch (TEXTOBJ SEL) of TEXTOBJ) with (LIST (fetch DESC + of (fetch (TEXTOBJ THISLINE) + of TEXTOBJ] + (* ; + "hookup middle button menu instead of TEDIT menu") + (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN) + (RETURN TEXTSTREAM]) + +(TEDITCHAT.MENUFN + [LAMBDA (WINDOW) (* || "20-Oct-86 15:03") + (DECLARE (GLOBALVARS TEDITCHAT.MENU) + (SPECVARS WINDOW STATE)) (* MIDDLEBUTTON) + (PROG ((STATE (WINDOWPROP WINDOW 'CHATSTATE)) + COMMAND) + [COND + ((NOT STATE) (* No Connection here; + try to reestablish) + (RETURN (COND + ((LASTMOUSESTATE MIDDLE) + (CHAT.RECONNECT WINDOW)) + (T (TOTOPW WINDOW] + (replace (CHAT.STATE HELD) of STATE with T) + (\CHECKCARET WINDOW) + (SELECTQ [SETQ COMMAND (MENU (OR TEDITCHAT.MENU (SETQ TEDITCHAT.MENU + (create MENU + ITEMS _ TEDITCHAT.MENUITEMS] + (Close (replace (CHAT.STATE RUNNING?) of STATE with 'CLOSE) + (* Ask CHAT.TYPEIN to shut things + down.) + ) + (New (replace (CHAT.STATE RUNNING?) of STATE with 'CLOSE) + (WINDOWPROP WINDOW 'KEEPCHAT 'NEW)) + (Suspend (replace (CHAT.STATE RUNNING?) of STATE with 'CLOSE) + (WINDOWPROP WINDOW 'KEEPCHAT T)) + (Freeze (* Leave in HELD state) + (RETURN)) + (NIL) + (APPLY* COMMAND STATE WINDOW)) + (replace (CHAT.STATE HELD) of STATE with NIL]) +) + + + +(* ; "TEDIT update routines") + +(DEFINEQ + +(TEDIT.DISPLAYTEXT + [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 12-Jun-90 18:01 by mitani") + (* This function does the actual + displaying of typed-in text on the + edit window.) + (PROG ((LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) + TEXTOBJ)) + (TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) + DY FONT) + (MOVETO XPOINT (IPLUS (fetch YBASE of LINE) + (OR (fetch CLOFFSET of LOOKS) + 0)) + DS) (* Set the display stream position) + (COND + [TERMSA (* Special terminal table for + controlling character display. + Use it.) + (RESETLST + (RESETSAVE \PRIMTERMSA TERMSA) + (replace (TEXTSTREAM REALFILE) of (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + with DS) + [COND + [(STRINGP CH) + (for CHAR instring CH + do (SELCHARQ CHAR + (TAB (* Put down white) + (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE) + 36 + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CHAR FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) + (\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + CHAR] + (T (SELCHARQ CH + (TAB (* Put down white) + (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE) + 36 + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CH FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) + (\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + CH])] + (T (* No special handling; + just use native character codes) + (COND + [(STRINGP CH) + (for CHAR instring CH do (SELCHARQ CHAR + (TAB (* Put down white) + (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) + (fetch YBOT of LINE) + 36 + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) + (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CHAR FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) + (BLTCHAR CHAR DS] + (T (SELCHARQ CH + (TAB (* Put down white) + (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) + (fetch YBOT of LINE) + 36 + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (* Blank out the CR's width.) + (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) + (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CH FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) + (BLTCHAR CH DS]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDITCHAT.MENU CHAT.DRIVERTYPES CHAT.DISPLAYTYPES) +) + +(RPAQQ TEDITCHAT.MENUITEMS + ((Close 'Close "Closes the connection and returns") + (Suspend 'Suspend "Closes the connection but leaves window up") + (New 'New "Closes this connection and prompts for a new host") + (Freeze 'Freeze "Holds typeout in this window until you bug it again") + ("Dribble" (FUNCTION CHAT.TYPESCRIPT) + "Starts a typescript of window typeout") + ("Input" (FUNCTION CHAT.TAKE.INPUT) + "Allows input from a file") + ("Option" (FUNCTION DO.CHAT.OPTION) + "Do protocol specific option"))) + +(RPAQQ TEDITCHAT.MENU NIL) + +(ADDTOVAR CHAT.DRIVERTYPES (TEDIT TEDITCHAT.CHARFN NILL)) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (SOURCE) + CHATDECLS) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1070 11167 (TEDITCHAT.CHARFN 1080 . 1769) (\TEXTSTREAMBOUT 1771 . 11165)) (11168 14251 +(TEDITSTREAM.INIT 11178 . 12411) (TEDITCHAT.MENUFN 12413 . 14249)) (14290 20705 (TEDIT.DISPLAYTEXT +14300 . 20703))))) +STOP diff --git a/library/tedit/TEDIT-CHAT.LCOM b/library/tedit/TEDIT-CHAT.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..3d3045aa60a978750f42e3b1c74bc2aa3ac3e38e GIT binary patch literal 8296 zcmb_hU2G%Qbta{ayjIsTB@?b7EbJRuZYcv2I6wST+^vS>a5>VDLvw~psop}-id>7* zSQI3x3%4m+8-atqq)39+3Gxs)fP)t3!|t|5fix+BJb4W`$wMACKpu($dDjAcD+>2J z_ue6gl-7Mn`M|mN&N=6vd+xd4IpgwtuYwbefWdam+arysPTxw0%{=XN)R3(+u*jlY_-m;vAyHbQ<+4QJklWTf% zEt&qE=00lQyUdo;+_c=X_^X$yY^|7`PSlvfT+?PXmSmo}<+&bqyuvIDb6VFUH7&d? zl$TkgHxY?U7*i4a9$lM_M#|4pQ}h>RqtS4Gp1)gf`B%>$YW;GTD6QY)|AJw{63-DS zb5Twb^QX_hwI3_5PZL8dl28}{%r-@xeC&OIhmf5t5UYWXSMm{Emt0`98qEVey%_a?&?3>ir7OT-yoie-$-HEfOjSu zv|>^DPM6OsLc;8SU7!8xqNEClrw)G=pX!ef#;1d!x9Ir9<3aZzel2KbL8_|4Nbmkwfj}v?!1X8v8aY6V!XI_r{ z^})W>b|U)Z+Ycf?54a;z)x`fi`Qd}ezlz>|{6>ExdJxcDrh*C;Rxcy?rkMKM&ivP} zlHr8{*WUH7{fBUh`|p>HmNb-;4@69CVDq1QhB$(y4_*z-8lSlEE`GHixX7PAiu^=4 zZzX=czixjz5j!~lkD=;I8gN5+E@_f!<`(LXZ8upe2XHPs4Z8?D)dAZ@ zw^p#NTFt87teZCpzO}T*ZUf3Fx@jrGeiGlPQQTdH9Ku%(*f*R&OX?(tW3-Y=1rf!l z)$Hw6*W0!Mm$?kPZB<>f?iI=`n;UfMEQ9I992KL!xysQMtEqe2hzwcaxD2gXb=bs& zax{b7AZTWX0VadM77Ww!MRZQ*^g%RAXTdm#S?LUjhCM7I)YHS!EsYp5e3#0lcswYY zu#8pnoH}Azk^#37Z&K+Tv&|AUc(NelV@l5i1X@}Wj0y$d(>@aBrjkSa)pKfSYCR2R zgrd;YdMc2tL+A0A8iq(4ooqT-tB#m1)YX$%3lV78tRaDxg((N*S|+>{4dFG=R6{r# z(y7=N@(>ZL)C?>!s;ino^covN8gO96V8oL99B$4WDZS_tcR~fO@_Bi$%VIB zfgcW8luUTjmGlT7wk%kug87H-uqhSt(1E2Cgyn!P9e#oIYDk4O1Vl(Vg61&KLaY|f zi^H%ia#7J=wW^jEbwmxjYdR(ko`QfrN;1RT2D= zuYUImg8KgYe(M^6>mXqrWU8~XlN$o0OK*O>Cz>3?JNpX@@zM(d2l+_+5Bf4+6+!Uu z7xBpGh>-TI)s?oU|H&q(S6TGc@d ztD=ysqU0ELF9ktlY(x`>h@}za!i5tY#qpe4lS&nC@VZ%Ws#U}R%GGb0(rX(Ci{!c3 zST)7L%|qCv`cXxAFP*g8f8Iv5kzt#rStB{9iLzS!dKzrfqg>!M0%&M)lEH)V>x%1>Q07LPaQI4zRz|8CCB?oO3kJa7Go zkG}iKgm$HIas?T46=Fn_{|5OZ|%pLb6mOHxb!d5ZKzs|G%JkrHs_>j2zdTf z`N@Z6C^z?X?P3G%nsZz|0ESKpFtXuV9gYG2tRvsbvixS=^71z2R^ilKLzYoDZFw)F zA^#Z=s)#0|a#Wn4;cH|OBweKVgaSi3xNIB}Dxm^`4&F+&QOTQiI4?pGAc%?zWcxLS zgl(kIKt>$&Wi688IW;N;#8`@ZIEA%a2JR3!mWd7yq8^G`I-s#`qAxRRbDvfDy<~ z7d;%k!k|NUK6G!rh2({9fFuG@g2->j2($=?_%)A6)h)0fJp~%#2F%4n4?xZWJFOOD z6wZX_i3?ATox#$8Z&Vb?S(n+wm!6MCo{=|1x_n+)=MW)#ug~VcR4fQ|nUFQ~)W?$t zk4;WxJ$$A4((IS7a-889$N%_ML4Ro~`oe?gM}|bi=<~+x8#B(_7$VZ;$mrOk$PO-M z=7EdOTmX!8pE5!vv2o`*D4iDxAOFd@{(-aL%mX67PS2n1#5oZC5uv2HZ*m-vONsbP zvUNF5iq+k(5*QhmusiWhF77A(l>OvG8({QQao=#_VrnRQ_;_dj!RPJ^4k_(lZi31q|VGjsQbqG0;9hF&*Cn#!yVZ2#Y$3+W|KWIp9WtJ;tqJ zqVXY^A>h^!4+Cxu@nM{lt|7)se$+?-H)Y5Hw~AbKoD?owzzH^zopB0+Ci;x+aawz#*y zd$PONYoD-_?pd#M)IMEYW{DCq+hJZzCk2`GSkbr)IxYwwHREGn4F)@G5 z&W`C@-{o_M9SqFViJP{QH|$$RJ**rFr(gtstXsEmw}_oRl18BHC5*iAWQoxC zH4;af8pR@~Ph1e45SkB{C(To}Y@C*mvE8?JJ4YmLv3SzCbH{Jvvv#Rb72g24@whwiYf+N!_I6L8&Mu$ebnm2d z++*Flfp|G9muDRvpY<+EGd4|JdZF|tX@>82@0~(Pkg~g2Dg@uf2X!vMIi_6*ODH<@ zfzw-cY7|aj_+ppAK)vo>*Jmh~_d0hwd#o$?p6Uqkaplan>Local>medley3.5>lispcore>library>TEDITCOMMAND.;2 50383 - changes to%: (FNS \TEDIT.READTABLE \TEDIT.COMMAND.LOOP TEDIT.GETFUNCTION TEDIT.SETFUNCTION) +(FILECREATED "14-Jul-2022 16:55:44"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;1 48554 - previous date%: "25-Aug-94 10:52:51" -{DSK}kaplan>Local>medley3.5>lispcore>library>TEDITCOMMAND.;1) + :PREVIOUS-DATE "14-Jul-2022 11:08:09" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-COMMAND.;2) -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 by Venue & Xerox Corporation. All rights reserved. -") +(PRETTYCOMPRINT TEDIT-COMMANDCOMS) -(PRETTYCOMPRINT TEDITCOMMANDCOMS) - -(RPAQQ TEDITCOMMANDCOMS - ((FILES TEDITDCL) +(RPAQQ TEDIT-COMMANDCOMS + ((FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (FNS \TEDIT.INSERT.TTY.BUFFER \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \PNC \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.RESET.SETUP) [INITVARS (TEDIT.INTERRUPTS '((2 BREAK) @@ -32,7 +27,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (TEDIT.BLUEPENDINGDELETE NIL)) (GLOBALVARS TEDIT.COPY.PENDING TEDIT.COPYLOOKS.PENDING TEDIT.MOVE.PENDING TEDIT.DEL.PENDING TEDIT.BLUEPENDINGDELETE TEDIT.INTERRUPTS) - (COMS (* ; "Read-table Utilities") + (COMS (* ; "Read-table Utilities") (FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET) [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) @@ -41,7 +36,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b ] (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)))) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -53,58 +48,57 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DEFINEQ (\TEDIT.INSERT.TTY.BUFFER - [LAMBDA (SCRATCH PASS TEXTOBJ SEL) (* ; "Edited 23-Feb-88 11:11 by jds") - - (* ;; "OBSOLETE 2/9/86 ?? JDS") - - (* ;; "(PROG ((TLEN (fetch (STRINGP OFFST) of SCRATCH))) (COND ((NOT (ZEROP TLEN)) (* If there are typed-ahead characters cached, insert them in the text object and clear the cache.) (replace (STRINGP OFFST) of SCRATCH with 0) (replace (STRINGP LENGTH) of SCRATCH with \SCRATCHLEN) (replace (STRINGP LENGTH) of PASS with TLEN) (TEDIT.\INSERT PASS SEL TEXTOBJ BLANKSEEN CRSEEN))))") + [LAMBDA (SCRATCH PASS TEXTOBJ SEL) (* ; "Edited 23-Feb-88 11:11 by jds") + + (* ;; "OBSOLETE 2/9/86 ?? JDS") + + (* ;; "(PROG ((TLEN (fetch (STRINGP OFFST) of SCRATCH))) (COND ((NOT (ZEROP TLEN)) (* If there are typed-ahead characters cached, insert them in the text object and clear the cache.) (replace (STRINGP OFFST) of SCRATCH with 0) (replace (STRINGP LENGTH) of SCRATCH with \SCRATCHLEN) (replace (STRINGP LENGTH) of PASS with TLEN) (TEDIT.\INSERT PASS SEL TEXTOBJ BLANKSEEN CRSEEN))))") (HELP]) (\TEDIT.INTERRUPT.SETUP - (LAMBDA (PROC FORCEOFF) (* jds "12-Sep-84 15:36") - - (* Disarm any inconvenient interrupts, and save re-arming info on the window.) - - (PROG ((TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW) + [LAMBDA (PROC FORCEOFF) (* jds "12-Sep-84 15:36") + (* Disarm any inconvenient interrupts, + and save re-arming info on the window.) + [PROG [(TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW) (WINDOWPROP (PROCESSPROP PROC 'WINDOW) 'TEXTOBJ) - (TEXTOBJ (PROCESSPROP PROC 'WINDOW))))) + (TEXTOBJ (PROCESSPROP PROC 'WINDOW] (UNINTERRUPTABLY - (COND + [COND ((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) (* There are disarmed interrupts;  re-arm them.) (RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) (PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL)) - ((AND (NOT FORCEOFF) - (NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS))) + ([AND (NOT FORCEOFF) + (NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS] (* There aren't any interrupts  disarmed; go do it.) (PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS (OR (AND TEXTOBJ (TEXTPROP TEXTOBJ 'INTERRUPTS)) TEDIT.INTERRUPTS) - T)))))) - PROC)) + T])] + PROC]) (\TEDIT.MARKACTIVE - [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") + [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T) TEXTOBJ]) (\TEDIT.MARKINACTIVE - [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") + [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) TEXTOBJ]) (\PNC - (LAMBDA (CH STR) (* jds " 7-JUN-82 14:03") + [LAMBDA (CH STR) (* jds " 7-JUN-82 14:03") (PROG ((LEN (fetch (STRINGP LENGTH) of STR)) (OFFST (fetch (STRINGP OFFST) of STR))) (COND @@ -114,12 +108,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (\PUTBASEBYTE (fetch (STRINGP BASE) of STR) OFFST CH) (replace (STRINGP OFFST) of STR with (ADD1 OFFST)) - (replace (STRINGP LENGTH) of STR with (SUB1 LEN)))))))) + (replace (STRINGP LENGTH) of STR with (SUB1 LEN)))]) (\TEDIT.COMMAND.LOOP - [LAMBDA (STREAM RTBL) (* ; "Edited 30-May-91 19:33 by jds") + [LAMBDA (STREAM RTBL) (* ; "Edited 30-May-91 19:33 by jds") - (* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch") + (* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch") (PROG ((TEXTOBJ (COND ((type? STREAM STREAM) @@ -130,15 +124,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1)) (* ; "Used inside \INSERT\TTY\BUFFER") + (SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1)) (* ; "Used inside \INSERT\TTY\BUFFER") (SETQ RTBL (OR RTBL (fetch (TEXTOBJ TXTRTBL) of TEXTOBJ) - TEDIT.READTABLE)) (* ; - "Used to derive command characters from type-in") + TEDIT.READTABLE)) (* ; + "Used to derive command characters from type-in") (for WW inside WINDOW do (WINDOWPROP WW 'PROCESS (THIS.PROCESS))) - (* ; "And the window to this process") - (while (NOT (TTY.PROCESSP)) do (* ; - "Wait until we really have the TTY before proceeding.") - (DISMISS 250)) + (* ; "And the window to this process") + (while (NOT (TTY.PROCESSP)) do (* ; + "Wait until we really have the TTY before proceeding.") + (DISMISS 250)) (RESETLST (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ WINDOW) T)) @@ -160,79 +154,78 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (while (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) do (PROGN - (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action") - (while (OR TEDIT.SELPENDING (fetch (TEXTOBJ EDITOPACTIVE) - of TEXTOBJ)) - do (* ; - "Don't do anything while he's selecting or one of the lock-out ops is active.") - [COND - ((EQ TEDIT.SELPENDING TEXTOBJ) - (* ; - "(OR (EQ TEDIT.SELPENDING TEXTOBJ) (fetch TCUP of (fetch CARET of TEXTOBJ)))") - (* ; - "If this TEdit is the one being selected in, or the caret is explicitly visible, flash it") - (TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ] - (BLOCK)) + (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action") + (while (OR TEDIT.SELPENDING (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)) + do (* ; + "Don't do anything while he's selecting or one of the lock-out ops is active.") + [COND + ((EQ TEDIT.SELPENDING TEXTOBJ) + (* ; + "(OR (EQ TEDIT.SELPENDING TEXTOBJ) (fetch TCUP of (fetch CARET of TEXTOBJ)))") + (* ; + "If this TEdit is the one being selected in, or the caret is explicitly visible, flash it") + (TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ] + (BLOCK)) [COND ((fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) (T (COND ((fetch (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ) - (* ; - "We got here somehow with the window not in sync with the text. Run an update.") + (* ; + "We got here somehow with the window not in sync with the text. Run an update.") (\SHOWSEL SEL NIL NIL) (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T) (\FIXSEL SEL TEXTOBJ) (\SHOWSEL SEL NIL T))) (TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ)) - (* ; - "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)") + (* ; + "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)") (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T) - (* ; - "Before starting to work, note that we're doing something.") + (* ; + "Before starting to work, note that we're doing something.") (AND LOOPFN (ERSETQ (APPLY* LOOPFN STREAM))) - (* ; - "If the guy wants control during the loop, give it to him.") - (* ; "Process any pending selections") + (* ; + "If the guy wants control during the loop, give it to him.") + (* ; "Process any pending selections") [COND - (TEDIT.COPY.PENDING (* ; - "Have to copy the shifted SEL to caret.") + (TEDIT.COPY.PENDING (* ; + "Have to copy the shifted SEL to caret.") (SETQ TEDIT.COPY.PENDING NIL) - (\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ - SHIFTEDSEL) + (\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ + SHIFTEDSEL + ) of TEXTOBJ)) (ERSETQ (TEDIT.COPY (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (replace (SELECTION SET) of - TEDIT.SHIFTEDSELECTION + (replace (SELECTION SET) of TEDIT.SHIFTEDSELECTION with NIL) (replace (SELECTION L1) of TEDIT.SHIFTEDSELECTION with NIL) (replace (SELECTION LN) of TEDIT.SHIFTEDSELECTION with NIL) - (\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ - SHIFTEDSEL) - of TEXTOBJ))) - (TEDIT.COPYLOOKS.PENDING(* ; - "Have to copy the shifted SEL to caret.") - (SETQ TEDIT.COPYLOOKS.PENDING NIL) - (\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ + (\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ SHIFTEDSEL ) + of TEXTOBJ))) + (TEDIT.COPYLOOKS.PENDING(* ; + "Have to copy the shifted SEL to caret.") + (SETQ TEDIT.COPYLOOKS.PENDING NIL) + (\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) [ERSETQ (COND ((EQ 'PARA (fetch (SELECTION SELKIND) of (fetch (TEXTOBJ SHIFTEDSEL) - of TEXTOBJ))) - (* ; - "copy the paragraph looks, since the source selection type was paragraph") - (TEDIT.COPY.PARALOOKS TEXTOBJ (fetch - (TEXTOBJ SHIFTEDSEL) + of TEXTOBJ))) + (* ; + "copy the paragraph looks, since the source selection type was paragraph") + (TEDIT.COPY.PARALOOKS TEXTOBJ (fetch (TEXTOBJ + SHIFTEDSEL) of TEXTOBJ) (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (T (* ; "copy the character looks") - (TEDIT.COPY.LOOKS TEXTOBJ (fetch (TEXTOBJ - SHIFTEDSEL) + (T (* ; "copy the character looks") + (TEDIT.COPY.LOOKS TEXTOBJ (fetch (TEXTOBJ + SHIFTEDSEL + ) of TEXTOBJ) (fetch (TEXTOBJ SEL) of TEXTOBJ] (\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) @@ -243,19 +236,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b with NIL) (replace (SELECTION LN) of TEDIT.COPYLOOKSSELECTION with NIL) - (\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ - SHIFTEDSEL - ) + (\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) - (TEDIT.MOVE.PENDING (* ; - "Have to move the ctrl-shift SEL to caret.") + (TEDIT.MOVE.PENDING (* ; + "Have to move the ctrl-shift SEL to caret.") (SETQ TEDIT.MOVE.PENDING NIL) - (\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL - ) + (\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) (TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) - (ERSETQ (TEDIT.MOVE (fetch (TEXTOBJ MOVESEL) - of TEXTOBJ) + (ERSETQ (TEDIT.MOVE (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) (fetch (TEXTOBJ SEL) of TEXTOBJ))) (replace (SELECTION SET) of TEDIT.MOVESELECTION with NIL) @@ -263,44 +252,38 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b with NIL) (replace (SELECTION LN) of TEDIT.MOVESELECTION with NIL) - (\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL - ) + (\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))) - (TEDIT.DEL.PENDING (* ; "Delete the current selection.") + (TEDIT.DEL.PENDING (* ; "Delete the current selection.") (SETQ TEDIT.DEL.PENDING NIL) - (* ; - "Above all, reset the demand flag first") + (* ; + "Above all, reset the demand flag first") (ERSETQ (COND ((fetch (SELECTION SET) of TEDIT.DELETESELECTION ) - (* ; - "Only try the deletion if he really set the selection.") + (* ; + "Only try the deletion if he really set the selection.") (\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) NIL NIL) - (* ; - "Turn off the selection highlights") - (\SHOWSEL (fetch (TEXTOBJ SEL) - of TEXTOBJ) + (* ; "Turn off the selection highlights") + (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL NIL) (replace (SELECTION SET) - of (fetch (TEXTOBJ DELETESEL) - of TEXTOBJ) with NIL) + of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) + with NIL) (\COPYSEL TEDIT.DELETESELECTION - (fetch (TEXTOBJ SEL) of - TEXTOBJ - )) - (\TEDIT.SET.SEL.LOOKS (fetch (TEXTOBJ - SEL) + (fetch (TEXTOBJ SEL) of TEXTOBJ)) + (\TEDIT.SET.SEL.LOOKS (fetch (TEXTOBJ SEL) of TEXTOBJ) 'NORMAL) - (* ; "Grab the selection we're to use") + (* ; "Grab the selection we're to use") (\TEDIT.DELETE (fetch (TEXTOBJ SEL) of TEXTOBJ) (fetch (SELECTION \TEXTOBJ) of (fetch (TEXTOBJ SEL) - of TEXTOBJ)) + of TEXTOBJ)) NIL) (replace (SELECTION L1) of TEDIT.DELETESELECTION @@ -310,107 +293,101 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b with NIL] (UNINTERRUPTABLY (replace (STRINGP OFFST) of ISCRSTRING with 0) - (replace (STRINGP LENGTH) of ISCRSTRING with - \SCRATCHLEN - )) + (replace (STRINGP LENGTH) of ISCRSTRING with \SCRATCHLEN)) (while (\SYSBUFP) - do (* ; "Handle user type-in") - (SETQ CH (\GETKEY)) - (COND - (CHARFN (* ; - "Give the OEM user control for each character typed.") - (SETQ TCH (APPLY* CHARFN STREAM CH)) - (OR (EQ TCH T) - (SETQ CH TCH)) - (* ; - "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.") - )) - (SELECTC (AND CH (\SYNCODE TEDITSA CH)) - (CHARDELETE.TTC - (* ; - "Backspace handler: Remove the character just before SEL:CH#.") - (\TEDIT.CHARDELETE TEXTOBJ ISCRSTRING SEL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (WORDDELETE.TTC - (\TEDIT.WORDDELETE TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (DELETE.TTC (* ; - "DEL Key handler: Delete the selected characters") - (\TEDIT.DELETE SEL TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (UNDO.TTC (* ; - "He hit the CANCEL key, so go UNDO something") - (TEDIT.UNDO TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (REDO.TTC (* ; - "He hit the REDO key, so go REDO something") - (TEDIT.REDO TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (FUNCTIONCALL.TTC - (* ; - "This is a special character -- it calls a function") - (COND - ([SETQ FN (CAR (FETCH MACROFN - OF (GETHASH CH - TEDITFNHASH] - (* ; - "There IS a command function to be called.") - (APPLY* FN (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ) - TEXTOBJ SEL) - (* ; "do it") - (\SHOWSEL SEL NIL NIL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (* ; - "After a user function, no more blue-pending-delete") - (\SHOWSEL SEL NIL T) - (* ; - "And forget any pending deletion.") - ))) - (NEXT.TTC (* ; - "Move to the next blank to fill in. For now, blanks are delimited by >>...<<") - (TEDIT.NEXT TEXTOBJ)) - (EXPAND.TTC (* ; "EXPAND AN ABBREVIATION") - (\TEDIT.ABBREV.EXPAND (fetch - (TEXTOBJ STREAMHINT - ) - of TEXTOBJ))) - (SELECTC (AND TERMSA CH (fetch TERMCLASS - of (\SYNCODE TERMSA CH) - )) - (CHARDELETE.TC - (* ; - "Backspace handler: Remove the character just before SEL:CH#.") - (\TEDIT.CHARDELETE TEXTOBJ - ISCRSTRING SEL) - (TEDIT.RESET.EXTEND.PENDING.DELETE - SEL)) - (WORDDELETE.TC - (* ; "Back-WORD handler") - (\TEDIT.WORDDELETE TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE - SEL)) - (LINEDELETE.TC - (* ; - "DEL Key handler: Delete the selected characters") - (\TEDIT.DELETE SEL TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE - SEL)) - (COND - (CH (* ; - "Any other key was hit: Just insert the character.") - (TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) - (* ; - "Handle blue pending delete, if there is one.") - (TEDIT.\INSERT CH SEL TEXTOBJ BLANKSEEN - CRSEEN] + do (* ; "Handle user type-in") + (SETQ CH (\GETKEY)) + (COND + (CHARFN (* ; + "Give the OEM user control for each character typed.") + (SETQ TCH (APPLY* CHARFN STREAM CH)) + (OR (EQ TCH T) + (SETQ CH TCH)) + (* ; + "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.") + )) + (SELECTC (AND CH (\SYNCODE TEDITSA CH)) + (CHARDELETE.TTC (* ; + "Backspace handler: Remove the character just before SEL:CH#.") + (\TEDIT.CHARDELETE TEXTOBJ ISCRSTRING SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (WORDDELETE.TTC + (\TEDIT.WORDDELETE TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (DELETE.TTC (* ; + "DEL Key handler: Delete the selected characters") + (\TEDIT.DELETE SEL TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (UNDO.TTC (* ; + "He hit the CANCEL key, so go UNDO something") + (TEDIT.UNDO TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (REDO.TTC (* ; + "He hit the REDO key, so go REDO something") + (TEDIT.REDO TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (FUNCTIONCALL.TTC + (* ; + "This is a special character -- it calls a function") + (COND + ([SETQ FN (CAR (FETCH MACROFN + OF (GETHASH CH TEDITFNHASH] + (* ; + "There IS a command function to be called.") + (APPLY* FN (fetch (TEXTOBJ STREAMHINT) + of TEXTOBJ) + TEXTOBJ SEL) + (* ; "do it") + (\SHOWSEL SEL NIL NIL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) + (* ; + "After a user function, no more blue-pending-delete") + (\SHOWSEL SEL NIL T) + (* ; "And forget any pending deletion.") + ))) + (NEXT.TTC (* ; + "Move to the next blank to fill in. For now, blanks are delimited by >>...<<") + (TEDIT.NEXT TEXTOBJ)) + (EXPAND.TTC (* ; "EXPAND AN ABBREVIATION") + (\TEDIT.ABBREV.EXPAND (fetch (TEXTOBJ + STREAMHINT + ) + of TEXTOBJ))) + (SELECTC (AND TERMSA CH (fetch TERMCLASS + of (\SYNCODE TERMSA CH))) + (CHARDELETE.TC + (* ; + "Backspace handler: Remove the character just before SEL:CH#.") + (\TEDIT.CHARDELETE TEXTOBJ ISCRSTRING + SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE + SEL)) + (WORDDELETE.TC + (* ; "Back-WORD handler") + (\TEDIT.WORDDELETE TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE + SEL)) + (LINEDELETE.TC + (* ; + "DEL Key handler: Delete the selected characters") + (\TEDIT.DELETE SEL TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE + SEL)) + (COND + (CH (* ; + "Any other key was hit: Just insert the character.") + (TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) + (* ; + "Handle blue pending delete, if there is one.") + (TEDIT.\INSERT CH SEL TEXTOBJ BLANKSEEN CRSEEN + ] (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL] (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL))))]) (\TEDIT.COMMAND.RESET.SETUP - [LAMBDA (TEXT&WIND STARTING) (* ; "Edited 12-Jun-90 18:04 by mitani") + [LAMBDA (TEXT&WIND STARTING) (* ; "Edited 12-Jun-90 18:04 by mitani") - (* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing") + (* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing") (PROG ((TEXTOBJ (CAR TEXT&WIND)) (WINDOW (CADR TEXT&WIND)) @@ -420,30 +397,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (OWINDOW (CADR (CDDDDR TEXT&WIND))) TTYWINDOW) [COND - (STARTING (* ; - "We're going INTO the command loop. Set up all the stuff") + (STARTING (* ; + "We're going INTO the command loop. Set up all the stuff") (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T) - (* ; - "Mark us busy until we're set up, so that nobody tries any funny stuff.") + (* ; + "Mark us busy until we're set up, so that nobody tries any funny stuff.") (SETQ OWINDOW (PROCESSPROP (THIS.PROCESS) 'WINDOW - (CAR WINDOW))) (* ; - "Attach the process to this window.") - (\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) - (* ; - "Disarm all interrupt chars, re-arm them when we leave the edit") + (CAR WINDOW))) (* ; + "Attach the process to this window.") + (\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* ; + "Disarm all interrupt chars, re-arm them when we leave the edit") (SETQ OTTYEXITFN (PROCESSPROP (THIS.PROCESS) 'TTYEXITFN '\TEDIT.PROCEXITFN)) - (* ; - "Set up functions for getting in and out of the edit process") + (* ; + "Set up functions for getting in and out of the edit process") (SETQ OTTYENTRYFN (PROCESSPROP (THIS.PROCESS) 'TTYENTRYFN '\TEDIT.PROCENTRYFN)) [COND ((NEQ (TEXTPROP TEXTOBJ 'TTYWINDOW) - 'DON'T) (* ; - "He can suppress the ability to copy-select things into this window if he wants....") + 'DON'T) (* ; + "He can suppress the ability to copy-select things into this window if he wants....") (SETQ TTYWINDOW (OR (TEXTPROP TEXTOBJ 'TTYWINDOW) (CREATEW DEFAULTTTYREGION "TTY Window for TEdit" NIL T))) (SETQ OTTYWINDOW (TTYDISPLAYSTREAM TTYWINDOW)) @@ -452,55 +428,55 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (WINDOWPROP TTYWINDOW 'PROCESS NIL) [WINDOWPROP TTYWINDOW 'CLOSEFN (FUNCTION (LAMBDA (WW) (WINDOWPROP WW 'PROCESS NIL] - (* ; - "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS") + (* ; + "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS") (WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) (WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR WINDOW] (replace (TEXTOBJ TXTEDITING) of TEXTOBJ with T) - (* ; - "Tell TEdit that this document is actively being edited.") + (* ; + "Tell TEdit that this document is actively being edited.") (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) - (* ; - "Mark us un-busy so life can go on.") + (* ; + "Mark us un-busy so life can go on.") ) - (T (* ; - "Coming OUT OF the command loop -- reset everything") + (T (* ; + "Coming OUT OF the command loop -- reset everything") (PROCESSPROP (THIS.PROCESS) 'WINDOW - (CAR WINDOW)) (* ; - "Detach the window from the edit process, to prevent circularity there") + (CAR WINDOW)) (* ; + "Detach the window from the edit process, to prevent circularity there") (WINDOWPROP (CAR WINDOW) 'PROCESS NIL) (\TEDIT.INTERRUPT.SETUP (THIS.PROCESS) - T) (* ; - "Re-arm the interrupts we turned off coming in.") + T) (* ; + "Re-arm the interrupts we turned off coming in.") (COND ((AND (TXTFILE TEXTOBJ) (NOT (WINDOWPROP (CAR WINDOW) - 'TEDIT-CLOSING-FILE T)))(* ; - "Remember to close the file we were editing (Only if the window function isn't closing it.)") + 'TEDIT-CLOSING-FILE T)))(* ; + "Remember to close the file we were editing (Only if the window function isn't closing it.)") (CLOSEF? (TXTFILE TEXTOBJ)) (WINDOWPROP (CAR WINDOW) - 'TEDIT-CLOSING-FILE NIL) (* ; - "And let anyone else who wants to try closing the file do so.") + 'TEDIT-CLOSING-FILE NIL) (* ; + "And let anyone else who wants to try closing the file do so.") )) (PROCESSPROP (THIS.PROCESS) 'TTYEXITFN OTTYEXITFN) (PROCESSPROP (THIS.PROCESS) 'TTYENTRYFN OTTYENTRYFN) (replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with NIL) - (* ; - "To prevent circularities arising from the need to remember textobjs in the history list.") + (* ; + "To prevent circularities arising from the need to remember textobjs in the history list.") (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with NIL) - (* ; - "To prevent a circularity thru the window back to the textobj.") + (* ; + "To prevent a circularity thru the window back to the textobj.") (replace (TEXTOBJ TXTEDITING) of TEXTOBJ with NIL) - (* ; - "Tell TEdit that this document is NO LONGER actively being edited.") + (* ; + "Tell TEdit that this document is NO LONGER actively being edited.") (COND ((NEQ (TEXTPROP TEXTOBJ 'TTYWINDOW) - 'DON'T) (* ; - "He can suppress the ability to copy-select things into this window if he wants....") + 'DON'T) (* ; + "He can suppress the ability to copy-select things into this window if he wants....") (TTYDISPLAYSTREAM OTTYWINDOW) (PROCESSPROP (THIS.PROCESS) 'TEDITTTYWINDOW NIL] @@ -508,9 +484,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b ) (RPAQ? TEDIT.INTERRUPTS '((2 BREAK) - (5 ERROR) - (7 HELP) - (20 CONTROL-T))) + (5 ERROR) + (7 HELP) + (20 CONTROL-T))) (RPAQQ TEDIT.COPY.PENDING NIL) @@ -534,70 +510,69 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (DEFINEQ (\TEDIT.READTABLE - [LAMBDA NIL (* ; "Edited 20-Apr-2018 07:59 by rmk:") - (* jds "12-Sep-86 13:48") + [LAMBDA NIL (* ; "Edited 20-Apr-2018 07:59 by rmk:") + (* jds "12-Sep-86 13:48") - (* Create a TEdit read-table, to control which characters have what functions - and call which commands.) + (* Create a TEdit read-table, to control which characters have what functions and + call which commands.) (PROG [(RTBL (create READTABLEP READMACRODEFS _ (HASHARRAY 50] (for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL in (LIST CHARDELETE.TTC CHARDELETE.TTC WORDDELETE.TTC DELETE.TTC UNDO.TTC NEXT.TTC - CMD.TTC REDO.TTC) do (* Set up the default syntax classes - for command characters) - (\SETSYNCODE (fetch READSA of RTBL) - CH CL)) + CMD.TTC REDO.TTC) do (* Set up the default syntax classes + for command characters) + (\SETSYNCODE (fetch READSA of RTBL) + CH CL)) (for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND) - do (* Set up the default - function-calling characters - (^X to expand abbrevs for now)) - (TEDIT.SETFUNCTION CH FN RTBL)) + do (* Set up the default function-calling + characters (^X to expand abbrevs for + now)) + (TEDIT.SETFUNCTION CH FN RTBL)) (TEDIT.SETFUNCTION (CHARCODE ^O) (FUNCTION GET.OBJ.FROM.USER) - RTBL) (* And for image object capture) + RTBL) (* And for image object capture) (RETURN RTBL]) (\TEDIT.WORDBOUND.READTABLE - [LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds") + [LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds") (* ;; "Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of the adjacent characters is different") (PROG [(RTBL (create READTABLEP READMACRODEFS _ (HARRAY 50] (for CH from 0 to 255 do (\SETSYNCODE (fetch READSA of RTBL) - CH PUNCT.TTC)) + CH PUNCT.TTC)) (* ;; "By default, every character except those noted below is a punctuation character") - (for CH from (CHARCODE A) to (CHARCODE Z) - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) (* ; "Upper case alpha") - (for CH from (CHARCODE a) to (CHARCODE z) - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) (* ; "Lower case alpha") - (for CH from (CHARCODE 0) to (CHARCODE 9) - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) (* ; "And digits are text characters") + (for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE (fetch READSA of RTBL) + CH TEXT.TTC)) + (* ; "Upper case alpha") + (for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE (fetch READSA of RTBL) + CH TEXT.TTC)) + (* ; "Lower case alpha") + (for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE (fetch READSA of RTBL) + CH TEXT.TTC)) + (* ; "And digits are text characters") (* ;; "European chars and accents are text characters:") (for CH from (CHARCODE "361,41") to (CHARCODE "361,376") do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) + CH TEXT.TTC)) (for CH from (CHARCODE "0,301") to (CHARCODE "0,317") do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) + CH TEXT.TTC)) (for CH from (CHARCODE "0,341") to (CHARCODE "0,376") do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA - of RTBL) - CH WHITESPACE.TTC)) + CH TEXT.TTC)) + (for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA of RTBL) + CH WHITESPACE.TTC)) (* ; "And these are white space") (for CH in (LIST MSPACE NSPACE THINSPACE FIGSPACE) do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) + CH TEXT.TTC)) (RETURN RTBL]) (TEDIT.GETSYNTAX @@ -650,52 +625,50 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (APPLY* 'CHARCODE CHAR)) (T CHAR))) TABLE) - (\SETSYNCODE [fetch READSA of (COND - ((type? TEXTOBJ TABLE) + (\SETSYNCODE [fetch READSA of (COND + ((type? TEXTOBJ TABLE) (* ;  "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (OR (fetch (TEXTOBJ TXTRTBL) of TABLE) - TEDIT.READTABLE)) - ((type? STREAM TABLE) + (OR (fetch (TEXTOBJ TXTRTBL) of TABLE) + TEDIT.READTABLE)) + ((type? STREAM TABLE) (* ;  "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM - TEXTOBJ) - of TABLE)) - TEDIT.READTABLE)) - (T (OR TABLE TEDIT.READTABLE] - CHAR - (SELECTQ CLASS - (CHARDELETE CHARDELETE.TTC) - (WORDDELETE WORDDELETE.TTC) - ((DELETE LINEDELETE) - DELETE.TTC) - (UNDO UNDO.TTC) - (REDO REDO.TTC) - (CMD CMD.TTC) - (FN FUNCTIONCALL.TTC) - (NEXT NEXT.TTC) - (EXPAND EXPAND.TTC) - NONE.TTC]) + (OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) + of TABLE)) + TEDIT.READTABLE)) + (T (OR TABLE TEDIT.READTABLE] + CHAR + (SELECTQ CLASS + (CHARDELETE CHARDELETE.TTC) + (WORDDELETE WORDDELETE.TTC) + ((DELETE LINEDELETE) + DELETE.TTC) + (UNDO UNDO.TTC) + (REDO REDO.TTC) + (CMD CMD.TTC) + (FN FUNCTIONCALL.TTC) + (NEXT NEXT.TTC) + (EXPAND EXPAND.TTC) + NONE.TTC)))]) (TEDIT.GETFUNCTION - [LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06") - (* Gets the FN that is called when - CH is hit inside TEDIT.) + [LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06") + (* Gets the FN that is called when CH + is hit inside TEDIT.) [SETQ TABLE (COND ((type? TEXTOBJ TABLE) - (* If given a TEXTOBJ in place of a read table, coerce it to the read table for - that edit session) + (* If given a TEXTOBJ in place of a read table, coerce it to the read table for + that edit session) (fetch (TEXTOBJ TXTRTBL) of TABLE)) ((type? STREAM TABLE) - (* If given a TEXTOBJ in place of a read table, coerce it to the read table for - that edit session) + (* If given a TEXTOBJ in place of a read table, coerce it to the read table for + that edit session) - (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE) - )) + (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE))) (T (OR TABLE TEDIT.READTABLE] (SETQ CHARCODE (COND ((LITATOM CHARCODE) @@ -708,17 +681,17 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of TABLE]) (TEDIT.SETFUNCTION - [LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds") - (* ; - "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.") - (* ; - "If FN is NIL, make the character be normal again.") + [LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds") + (* ; + "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.") + (* ; + "If FN is NIL, make the character be normal again.") [SETQ RTBL (COND - ((type? TEXTOBJ RTBL) (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") + ((type? TEXTOBJ RTBL) (* ; + "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") (fetch (TEXTOBJ TXTRTBL) of RTBL)) - ((type? STREAM RTBL) (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") + ((type? STREAM RTBL) (* ; + "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of RTBL))) (T (OR RTBL TEDIT.READTABLE] (\SETSYNCODE (fetch READSA of RTBL) @@ -729,31 +702,30 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (APPLY* 'CHARCODE CHARCODE)) (T CHARCODE))) (COND - (FN (* ; - "He gave us a function to call. Set up the syntax so it IS called.") + (FN (* ; + "He gave us a function to call. Set up the syntax so it IS called.") FUNCTIONCALL.TTC) - (T (* ; - "He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.") - NONE.TTC))) (* ; - "Mark the character as invoking a function") + (T (* ; + "He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.") + NONE.TTC))) (* ; + "Mark the character as invoking a function") (OR (fetch READMACRODEFS of RTBL) - (replace READMACRODEFS of RTBL with (HARRAY 50))) - (* ; - "Make sure there's a hash table to store the function in.") + (replace READMACRODEFS of RTBL with (HARRAY 50))) (* ; + "Make sure there's a hash table to store the function in.") (PUTHASH CHARCODE (CREATE READMACRODEF MACROTYPE _ 'TEDIT MACROFN _ (LIST FN)) (fetch READMACRODEFS of RTBL]) (TEDIT.WORDGET - (LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24") + [LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24") (\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE)) (COND ((SMALLP CH)) - (T (CHCON1 CH)))))) + (T (CHCON1 CH]) (TEDIT.WORDSET - (LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23") + [LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23") (* SETS TEDIT-STYLE SYNTAX BITS IN A  TERMTABLE) (\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE)) @@ -766,7 +738,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (PUNCTUATION PUNCT.TTC) (WHITESPACE WHITESPACE.TTC) (TEXT TEXT.TTC) - TEXT.TTC)))))) + TEXT.TTC]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -778,13 +750,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1994, 2018 b (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE) ) -(PUTPROPS TEDITCOMMAND COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1991 -1992 1994 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2383 35906 (\TEDIT.INSERT.TTY.BUFFER 2393 . 3003) (\TEDIT.INTERRUPT.SETUP 3005 . 4578) -(\TEDIT.MARKACTIVE 4580 . 4788) (\TEDIT.MARKINACTIVE 4790 . 5002) (\PNC 5004 . 5644) ( -\TEDIT.COMMAND.LOOP 5646 . 29326) (\TEDIT.COMMAND.RESET.SETUP 29328 . 35904)) (36480 49998 ( -\TEDIT.READTABLE 36490 . 38095) (\TEDIT.WORDBOUND.READTABLE 38097 . 40622) (TEDIT.GETSYNTAX 40624 . -42820) (TEDIT.SETSYNTAX 42822 . 45163) (TEDIT.GETFUNCTION 45165 . 46547) (TEDIT.SETFUNCTION 46549 . -49018) (TEDIT.WORDGET 49020 . 49289) (TEDIT.WORDSET 49291 . 49996))))) + (FILEMAP (NIL (2178 34353 (\TEDIT.INSERT.TTY.BUFFER 2188 . 2770) (\TEDIT.INTERRUPT.SETUP 2772 . 4437) +(\TEDIT.MARKACTIVE 4439 . 4651) (\TEDIT.MARKINACTIVE 4653 . 4869) (\PNC 4871 . 5504) ( +\TEDIT.COMMAND.LOOP 5506 . 27793) (\TEDIT.COMMAND.RESET.SETUP 27795 . 34351)) (34915 48289 ( +\TEDIT.READTABLE 34925 . 36534) (\TEDIT.WORDBOUND.READTABLE 36536 . 39129) (TEDIT.GETSYNTAX 39131 . +41327) (TEDIT.SETSYNTAX 41329 . 43522) (TEDIT.GETFUNCTION 43524 . 44884) (TEDIT.SETFUNCTION 44886 . +47325) (TEDIT.WORDGET 47327 . 47588) (TEDIT.WORDSET 47590 . 48287))))) STOP diff --git a/library/TEDITCOMMAND.LCOM b/library/tedit/TEDIT-COMMAND.LCOM similarity index 53% rename from library/TEDITCOMMAND.LCOM rename to library/tedit/TEDIT-COMMAND.LCOM index b723986466239ced268ef19cf4988e243bbdc7d4..89729111882a943d4bb973beab6274d5cb6b02c1 100644 GIT binary patch delta 1049 zcmb_bPiWI%6eo41+c!2R4s{#OFOfk*ZD`tLZPO-QZPU@M>$Wx>C==<{Fw3&Gb{pGJ z>2^^V2+AiYc(%KQzRAwq9|Z#Dx=OMCv#bM+~ogzN?!5=Bv0_4_)GfQ z;fuCL@Um#Oaray@omDeh52tCDxQn?&Ld{?)9zbNvHbhAiR&hHfTd(pMq1?J(v z!Z9#E2lq_UJ^BhbV@$*WW}6*?SbfK}ZU@8ir%Z3eciA+L#V62&jQHsKtpBA62ZHY# zfgqu!T@m)HAsb8o7c)%YI$i6I)^NJJDxT274Wf0JPS3h~J(B!VtH^9Pku&LS9WHfFK7>}h`L{3N24oedG s(%(xqBW*1o%YF8A(yV$KF?+s?oNaH)H%GIQXoR(nV4(Bc5u8E406L5<0ssI2 delta 1196 zcmbtUPi)&{6j#DRH>wX-RYIk#-K(J^7R0ihxUrqusT(_;RmbscXIiCBB5kb_Esdk3 zL91Y7?0|Ly={s`R6^Uae4oGmD#DN_qaX~wv-C+_(#D(W1TdQ61;k}>V`+eX0^S$qT zd^h#{%hWepLz1o9j#cq3BeYCl1UXl0p5#PckbzfJVNI132C~e4eAI2VqXURLzySHo z47TsAHv-EK^lig)3|DvR6~obMmg!hKc}~(DJMb!X-$JnI8~%=t``clqUaJ|d$(2MF z_fc{~quax1JP(4b@`9Qd8Q4pLwLdrj(!yZ1=%5{)0B#A@LAwpXNk1MOgHSk4l;b!C z4w}c99&^?%=GDBQ@(RPgQl-e}CUJ!!mWhFjYF;`ms~`3H`mJWS-R$U2yx(l=N8==t zvf8bFcR%h$2=;o--pQ+FfyC$KJnVnc>>NgYIF46U$X49|$nLlS9Cq3ajZMdb#6UCW z-=e>1?+;n%_M%T)@t{Ah1XmG8lyb)4FsBqi;8jUfC4qry=l@5F0{bEr+r=;JHL`RkE91FRHXO^D*BiF>r2Yt;&k><1vn7C zXI#4mXNNLzKz4i|f{BBsO8U}Tfh8=SAzl-7J9WcEqQ_1dH%q1Y>B-g%f7_^p_H_#g z{k{~=PY&F6L(BIYUWls+oheInYyI*$+>y|^#RYnAy|^$TZaNLivs}}5w@k~iLW|HR z>pH!ttzr?9Ced3OmnOS(Zex)?)GpFTS^*vZXj#hWI--yDW%|*^CHk#?8UN-s-dSYv zn~Z*tGBlP^bH*L(c zl~AdBJHEYjHN+?4dej+2a0PBez4$g%;$AoIHIG|yhXFysD}e$BS&^kgtRkaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2 86549 - changes to%: (VARS TEDITDCLCOMS) +(FILECREATED "14-Jul-2022 17:03:38"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3 84851 - previous date%: "30-Apr-2021 17:26:17" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;1) + :CHANGES-TO (VARS TEDITFILES) + + :PREVIOUS-DATE "14-Jul-2022 16:29:57" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;2) -(* ; " -Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. -") +(PRETTYCOMPRINT TEDIT-DCLCOMS) -(PRETTYCOMPRINT TEDITDCLCOMS) - -(RPAQQ TEDITDCLCOMS +(RPAQQ TEDIT-DCLCOMS [ (* ;;; "This file is the collected record declarations and compile-time necessities for TEDIT.") @@ -150,15 +147,15 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NOTBEFORE.LB 1) (* ; - "Must not break before this character (e.g. Japanese right-paren)") + "Must not break before this character (e.g. Japanese right-paren)") (NOTAFTER.LB 2) (* ; - "Must not break after this character (e.g. Japanese open-quote)") + "Must not break after this character (e.g. Japanese open-quote)") (BEFORE.LB 4) (* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)") (AFTER.LB 8) (* ; - "OK to break after this char, if it's OK to break before the next one (true of most white space)") + "OK to break after this char, if it's OK to break before the next one (true of most white space)") (DISAPPEAR-IF-NOT-SPLIT.LB 16) (* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)") (NEWCHAR-IF-SPLIT.LB 32) @@ -195,45 +192,44 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (* ;; "Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user.") Y0 (* ; - "Y value of topmost line of selection") - X0 (* ; - "X value of left edge of selection") + "Y value of topmost line of selection") + X0 (* ; "X value of left edge of selection") DX (* ; - "Width of the selection, if it's on one line.") + "Width of the selection, if it's on one line.") CH# (* ; - "CH# of the first selected character") + "CH# of the first selected character") XLIM (* ; - "X value of right edge of last selected character") + "X value of right edge of last selected character") CHLIM (* ; - "CH# of the last character in the selection") + "CH# of the last character in the selection") DCH (* ; - "# of characters selected (can be zero, for point selection.)") + "# of characters selected (can be zero, for point selection.)") L1 (* ; - "-> line descriptor for the line where the first selected character is") + "-> line descriptor for the line where the first selected character is") LN (* ; - "-> line descriptor for the line which contains the end of the selection") + "-> line descriptor for the line which contains the end of the selection") YLIM (* ; - "Y value of the bottom of the line that ends the selection") + "Y value of the bottom of the line that ends the selection") POINT (* ; - "Which end should the caret appear at? (LEFT or RIGHT)") + "Which end should the caret appear at? (LEFT or RIGHT)") (SET FLAG) (* ; - "T if this selection is real; NIL if not") + "T if this selection is real; NIL if not") (\TEXTOBJ FULLXPOINTER) (* ; - "TEXTOBJ that describes the selected text") + "TEXTOBJ that describes the selected text") SELKIND (* ; - "What kind of selection? CHAR or WORD or LINE or PARA") + "What kind of selection? CHAR or WORD or LINE or PARA") HOW (* ; - "SHADE used to highlight this selection") + "SHADE used to highlight this selection") HOWHEIGHT (* ; - "Height of the highlight (1 usually, full line for delete selection...)") + "Height of the highlight (1 usually, full line for delete selection...)") (HASCARET FLAG) (* ; - "T if there should be a caret for this selection") + "T if there should be a caret for this selection") SELOBJ (* ; - "If this selection is inside an object, which object?") + "If this selection is inside an object, which object?") (ONFLG FLAG) (* ; - "T if the selection is highlighted on the screen, else NIL") + "T if the selection is highlighted on the screen, else NIL") SELOBJINFO (* ; - "A Place for the selected object to put info about selection inside itself.") + "A Place for the selected object to put info about selection inside itself.") ) SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T Y0 _ 0 X0 _ 0 POINT _ 'LEFT L1 _ (LIST NIL) @@ -283,9 +279,9 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. ) ) -(RPAQQ TEDITFILES (PCTREE TEXTOFD TEDIT TEDITABBREV TEDITCOMMAND TEDITDCL TEDITFILE TEDITFIND - TEDITFNKEYS TEDITHCPY TEDITHISTORY TEDITLOOKS TEDITMENU TEDITPAGE - TEDITSCREEN TEDITSELECTION TEDITWINDOW)) +(RPAQQ TEDITFILES (TEDIT-PCTREE TEDIT-TEXTOFD TEDIT TEDIT-ABBREV TEDIT-COMMAND TEDIT-DCL TEDIT-FILE + TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-LOOKS TEDIT-MENU + TEDIT-PAGE TEDIT-SCREEN TEDIT-SELECTION TEDIT-WINDOW)) @@ -294,91 +290,89 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (DATATYPE THISLINE ( - (* ;; - "Cache for line-related character location info, for selection and line-display code to use.") + (* ;; + "Cache for line-related character location info, for selection and line-display code to use.") - (DESC FULLXPOINTER) (* ; - "Line descriptor for the line this describes now") - LEN (* ; - "Length of the line in characters") - CHARS + (DESC FULLXPOINTER) (* ; + "Line descriptor for the line this describes now") + LEN (* ; "Length of the line in characters") + CHARS - (* ;; "Array of character codes (or objects) on the line (charcode of 400 => dummy entry for looks change--go get next entry in LOOKS)") + (* ;; "Array of character codes (or objects) on the line (charcode of 400 => dummy entry for looks change--go get next entry in LOOKS)") - WIDTHS (* ; - "Array of each character's width in points") - LOOKS (* ; - "Array of any looks changes within the line. LOOKS (0) = starting character looks for the line") - TLSPACEFACTOR (* ; - "The SPACEFACTOR to be used in printing this line") - TLFIRSTSPACE (* ; "The first space to which SPACEFACTOR is to apply. This is used so that spaces to the left of a TAB have their default width.") - ) - LEN _ 0 CHARS _ (ARRAY 512 'POINTER 0 0) - WIDTHS _ (ARRAY 512 'POINTER 0 0) - LOOKS _ (ARRAY 512 'POINTER NIL 0) - TLFIRSTSPACE _ 0) + WIDTHS (* ; + "Array of each character's width in points") + LOOKS (* ; + "Array of any looks changes within the line. LOOKS (0) = starting character looks for the line") + TLSPACEFACTOR (* ; + "The SPACEFACTOR to be used in printing this line") + TLFIRSTSPACE (* ; "The first space to which SPACEFACTOR is to apply. This is used so that spaces to the left of a TAB have their default width.") + ) + LEN _ 0 CHARS _ (ARRAY 512 'POINTER 0 0) + WIDTHS _ (ARRAY 512 'POINTER 0 0) + LOOKS _ (ARRAY 512 'POINTER NIL 0) + TLFIRSTSPACE _ 0) (DATATYPE LINEDESCRIPTOR ( (* ;; - "Description of a single line of formatted text, either on the display or for a printed page.") + "Description of a single line of formatted text, either on the display or for a printed page.") YBOT (* ; - "Y value for the bottom of the line (below the descent)") + "Y value for the bottom of the line (below the descent)") YBASE (* ; - "Yvalue for the base line the characters sit on") + "Yvalue for the base line the characters sit on") LEFTMARGIN (* ; "Left margin, in screen points") RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ; "X value of right edge of rightmost character on the line (may exceed right margin, if char is a space.)") SPACELEFT (* ; - "Space left on the line, ignoring trailing blanks & CRs.") + "Space left on the line, ignoring trailing blanks & CRs.") LHEIGHT (* ; - "Total height of hte line, Ascent+Descent.") + "Total height of hte line, Ascent+Descent.") ASCENT (* ; "Ascent of the line above YBASE") - DESCENT (* ; - "How far line descends below YBASE") + DESCENT (* ; "How far line descends below YBASE") LTRUEDESCENT (* ; - "The TRUE DESCENT for this line, unadjusted for line leading.") + "The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ; - "The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") + "The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") CHAR1 (* ; - "CH# of the first character on the line.") + "CH# of the first character on the line.") CHARLIM (* ; - "CH# of the last character on the line") + "CH# of the last character on the line") CHARTOP (* ; - "CH# of the character which forced the line break (may exceed CHARLIM)") + "CH# of the character which forced the line break (may exceed CHARLIM)") NEXTLINE (* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ; "One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)") LTEXTOBJ (* ; "A cached TEXTOBJ that this line took its text from. Used in hardcopy to disambiguate when chno's should be updated...") CACHE (* ; "A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit.") LDOBJ (* ; - "The object which lies behind this line of text, for updating, etc.") + "The object which lies behind this line of text, for updating, etc.") LFMTSPEC (* ; - "The format spec for this line's paragraph (eventually)") + "The format spec for this line's paragraph (eventually)") (DIRTY FLAG) (* ; - "T if this line has changed since it was last formatted.") + "T if this line has changed since it was last formatted.") (CR\END FLAG) (* ; "T if this line ends with a CR.") (DELETED FLAG) (* ; "T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)") (LHASPROT FLAG) (* ; - "This line contains protected text.") + "This line contains protected text.") (LHASTABS FLAG) (* ; "If this line has a tab in it, this is the line-relative ch# of the final tab. This is to let us punt properly with tabs in a line.") (1STLN FLAG) (* ; - "This line is the first line in a paragraph") + "This line is the first line in a paragraph") (LSTLN FLAG) (* ; - "This is the last line in a paragraph") + "This is the last line in a paragraph") ) CHARLIM _ 1000000 NEXTLINE _ NIL PREVLINE _ NIL DIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL) (DATATYPE LINECACHE ( - (* ;; "Image cache for display lines.") + (* ;; "Image cache for display lines.") - LCBITMAP (* ; - "The bitmap that will be used by this instance of the cache") - (LCNEXTCACHE FULLXPOINTER) (* ; - "The next cache in the chain, for screen updates.") - )) + LCBITMAP (* ; + "The bitmap that will be used by this instance of the cache") + (LCNEXTCACHE FULLXPOINTER) (* ; + "The next cache in the chain, for screen updates.") + )) ) (/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER) @@ -449,154 +443,153 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (RECORD EDITMARK ( - (* ;; "Used for fast access to a given place in the text--a %"Marker%". It consists of the piece, and the offset within the piece, and the piece number within the piece table. That's everything that's needed to set a text stream up quickly to start reading from a given place.") + (* ;; "Used for fast access to a given place in the text--a %"Marker%". It consists of the piece, and the offset within the piece, and the piece number within the piece table. That's everything that's needed to set a text stream up quickly to start reading from a given place.") - PC PCOFF . PCNO)) + PC PCOFF . PCNO)) ) (DECLARE%: EVAL@COMPILE (DATATYPE PIECE ( (* ; - "The piece describes either a string or part of a file. , or a generalized OBJECT.") + "The piece describes either a string or part of a file. , or a generalized OBJECT.") PSTR (* ; - "The string where this piece's text resides, or NIL") + "The string where this piece's text resides, or NIL") PFILE (* ; - "The file which contains this piece's text, or NIL") + "The file which contains this piece's text, or NIL") PFPOS (* ; - "The FILEPTR of the start of the piece in the file") + "The FILEPTR of the start of the piece in the file") PLEN (* ; - "Length of the piece, in characters.") + "Length of the piece, in characters.") NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ; - "-> Prior piece in this text object.") + "-> Prior piece in this text object.") PLOOKS (* ; - "Formatting info and formatting events in this piece") + "Formatting info and formatting events in this piece") POBJ (* ; "The OBJECT this piece describes") (PPARALAST FLAG) (* ; - "This piece contains a paragraph break") + "This piece contains a paragraph break") PPARALOOKS (* ; "Paragraph looks for this piece") (PNEW FLAG) (* ; - "This text is new here; used by the tentative edit system, and anyone else interested.") - (PFATP FLAG) (* ; - "T if the characters in this piece are FAT -- i.e., are 16 bits each.") + "This text is new here; used by the tentative edit system, and anyone else interested.") + (PFATP FLAG) (* ; "T if the characters in this piece are FAT -- i.e., are 16 bits each. This is trumped for a piece on a file that has its own PEXTERNALFORMAT") (PTREENODE XPOINTER) (* ; - "Points to the PCTB tree-node that contains this piece.") - ) + "Points to the PCTB tree-node that contains this piece.") + (PEXTERNALFORMAT POINTER (* ; + "The external format of a piece on a file") + )) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL) (DATATYPE TEXTOBJ ( (* ;; - "This is where TEdit stores its state information, and internal data about the text being edited.") + "This is where TEdit stores its state information, and internal data about the text being edited.") PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") \INSERTPC (* ; "Piece to hold type-in") \INSERTPCNO (* ; "Piece # of the input piece") \INSERTNEXTCH (* ; - "CH# of next char which is typed into that piece.") + "CH# of next char which is typed into that piece.") \INSERTLEFT (* ; "Space left in the type-in piece") \INSERTLEN (* ; - "# of characters already in the piece.") + "# of characters already in the piece.") \INSERTSTRING (* ; - "The string which the piece describes.") + "The string which the piece describes.") \INSERTFIRSTCH (* ; "CH# of first char in the piece.") (\INSERTPCVALID FLAG) (* ; "T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece.") \WINDOW (* ; - "The window where this textobj is displayed") + "The window where this textobj is displayed") MOUSEREGION (* ; - "Section of the window the mouse is in.") + "Section of the window the mouse is in.") LINES (* ; - "-> to top of chain of line descriptors for displayed text") + "-> to top of chain of line descriptors for displayed text") DS (* ; - "Display stream where this textobj is displayed") + "Display stream where this textobj is displayed") SEL (* ; - "The current selection within the text") + "The current selection within the text") SCRATCHSEL (* ; - "Scratch space for the selection code") - MOVESEL (* ; - "Source for the next MOVE of text") + "Scratch space for the selection code") + MOVESEL (* ; "Source for the next MOVE of text") SHIFTEDSEL (* ; "Source for the next COPY") DELETESEL (* ; "Text to be deleted imminently") WRIGHT (* ; - "Right edge of the window (or subregion) where this is displayed") + "Right edge of the window (or subregion) where this is displayed") WTOP (* ; "Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ; "Left edge of the window/region") TXTFILE (* ; - "The original text file we're editing") + "The original text file we're editing") (\XDIRTY FLAG) (* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ; - "-> the TEXTOFD stream which gives access to this textobj") + "-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ; - "T => The guy has asked the editor to go way") + "T => The guy has asked the editor to go way") CARET (* ; - "Describes the flashing caret for the editing window") + "Describes the flashing caret for the editing window") CARETLOOKS (* ; - "Font to be used for inserted text.") + "Font to be used for inserted text.") WINDOWTITLE (* ; - "Original title for this window, of there was one.") + "Original title for this window, of there was one.") THISLINE (* ; - "Cache of line-related info, to speed up selection &c") + "Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ; - "T if this TEXTOBJ is a tedit-style menu") + "T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ; - "Default Formatting Spec to be used when formatting paragraphs") + "Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ; -"Flag for paragraph formatting. T if this document is to contain paragraph formatting information.") + "Flag for paragraph formatting. T if this document is to contain paragraph formatting information.") (TXTREADONLY FLAG) (* ; - "This is only available for shift selection.") + "This is only available for shift selection.") (TXTEDITING FLAG) (* ; "T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing.") (TXTNONSCHARS FLAG) (* ; "T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation.") TXTTERMSA (* ; - "Special instructions for displaying characters on the screen") + "Special instructions for displaying characters on the screen") EDITOPACTIVE (* ; - "T if there is an editing operation in progress. Used to interlock the TEdit menu") + "T if there is an editing operation in progress. Used to interlock the TEdit menu") DEFAULTCHARLOOKS (* ; "The default character looks -- if any -- to be applied to characters coming into the file from outside.") TXTRTBL (* ; - "The READTABLE to be used by the command loop for command dispatch") + "The READTABLE to be used by the command loop for command dispatch") TXTWTBL (* ; - "The READTABLE to be used to decide on word breaks") + "The READTABLE to be used to decide on word breaks") EDITPROPS (* ; - "The PROPS that were passed into this edit session") + "The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ; "T if the next insertion in this document is to be preceded by a deletion of the then-current selection") TXTHISTORY (* ; - "The history list for this edit session.") + "The history list for this edit session.") (SELWINDOW FULLXPOINTER) (* ; "The window in which the last 'real' selection got made for this edit; used to control caret placement") PROMPTWINDOW (* ; - "A window to be used for unscheduled interactions; normally a small window above the edit window") + "A window to be used for unscheduled interactions; normally a small window above the edit window") DISPLAYCACHE (* ; - "The bitmap to be used when building the image of a line for display") + "The bitmap to be used when building the image of a line for display") DISPLAYCACHEDS (* ; - "The DISPLAYSTREAM that is used to build line images") + "The DISPLAYSTREAM that is used to build line images") DISPLAYHCPYDS (* ; "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode") TXTPAGEFRAMES (* ; - "A tree of page frames, specifying how the document is to be laid out.") + "A tree of page frames, specifying how the document is to be laid out.") TXTCHARLOOKSLIST (* ; - "List of all the CHARLOOKSs in the document, so they can be kept unique") + "List of all the CHARLOOKSs in the document, so they can be kept unique") TXTPARALOOKSLIST (* ; - "List of all the FMTSPECs in the document, so they can be kept unique") + "List of all the FMTSPECs in the document, so they can be kept unique") (TXTNEEDSUPDATE FLAG) (* ; - "T => Screen invalid, need to run updater") + "T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ; "T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.") TXTRAWINCLUDESTREAM (* ; - "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") + "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ; - "Document properties that are stored with the document (not used yet)") + "Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ; - "Style sheet local to this document. Not currently saved as part of the file.") + "Style sheet local to this document. Not currently saved as part of the file.") ) [ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (IF (NEQ (FETCH (TEXTOBJ \XDIRTY) OF DATUM) - NEWVALUE) - THEN (* ; - "update the title to reflect the change") - (\TEDIT.WINDOW.TITLE DATUM - (\TEDIT.ORIGINAL.WINDOW.TITLE - (ffetch (TEXTOBJ TXTFILE) - of DATUM) - NEWVALUE))) + NEWVALUE) + THEN (* ; + "update the title to reflect the change") + (\TEDIT.WINDOW.TITLE DATUM + (\TEDIT.ORIGINAL.WINDOW.TITLE + (ffetch (TEXTOBJ TXTFILE) of DATUM) + NEWVALUE))) (freplace \XDIRTY OF DATUM WITH NEWVALUE] SEL _ (create SELECTION) SCRATCHSEL _ (create SELECTION) @@ -614,93 +607,82 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL) (DATATYPE TEXTIMAGEDATA ( - (* ;; "Fills the IMAGEDATA field of text streams.") + (* ;; "Fills the IMAGEDATA field of text streams.") - TICURPARALOOKS (* ; "The current paragraph looks") - TICURIMAGESTREAM (* ; - "The image stream for this hardcopy transduction") - TILOOKSUPDATEFN (* ; - "The function to call to update looks for this stream") - TIPCOFFSET (* ; - "The offset into the current piece, as of the last page cross.") - )) + TICURPARALOOKS (* ; "The current paragraph looks") + TICURIMAGESTREAM (* ; + "The image stream for this hardcopy transduction") + TILOOKSUPDATEFN (* ; + "The function to call to update looks for this stream") + TIPCOFFSET (* ; + "The offset into the current piece, as of the last page cross.") + )) (ACCESSFNS TEXTSTREAM ( - (* ;; - "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") + (* ;; + "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") - (REALFILE (fetch F1 of DATUM) - (REPLACE F1 OF DATUM WITH NEWVALUE)) + (REALFILE (fetch F1 of DATUM) + (REPLACE F1 OF DATUM WITH NEWVALUE)) (* ; - "The real, underlying file behind the current piece") - (CHARSLEFT (fetch F2 of DATUM) - (REPLACE F2 OF DATUM WITH NEWVALUE)) + "The real, underlying file behind the current piece") + (CHARSLEFT (fetch F2 of DATUM) + (REPLACE F2 OF DATUM WITH NEWVALUE)) - (* ;; "The # of characters that will be left in the current piece the next time its file crosses a page boundary") + (* ;; "The # of characters that will be left in the current piece the next time its file crosses a page boundary") - (TEXTOBJ (fetch F3 of DATUM) - (REPLACE F3 OF DATUM WITH NEWVALUE)) + (TEXTOBJ (fetch F3 of DATUM) + (REPLACE F3 OF DATUM WITH NEWVALUE)) (* ; - "The TEXTOBJ that is editing this text") - (PIECE (fetch F5 of DATUM) - (REPLACE F5 OF DATUM WITH NEWVALUE)) + "The TEXTOBJ that is editing this text") + (PIECE (fetch F5 of DATUM) + (REPLACE F5 OF DATUM WITH NEWVALUE)) (* ; - "The PIECE we're currently fetching chars from/putting chars into") - (PCNO (fetch FW8 of DATUM) - (REPLACE FW8 OF DATUM WITH NEWVALUE)) + "The PIECE we're currently fetching chars from/putting chars into") + (PCNO (fetch FW8 of DATUM) + (REPLACE FW8 OF DATUM WITH NEWVALUE)) (* ; - "The position of that piece in the piece table") - (PCSTARTPG (fetch FW6 of DATUM) - (REPLACE FW6 OF DATUM WITH NEWVALUE)) + "The position of that piece in the piece table") + (PCSTARTPG (fetch FW6 of DATUM) + (REPLACE FW6 OF DATUM WITH NEWVALUE)) (* ; - "The underlying file page# that this piece starts on") - (PCSTARTCH (fetch FW7 of DATUM) - (REPLACE FW7 OF DATUM WITH NEWVALUE)) + "The underlying file page# that this piece starts on") + (PCSTARTCH (fetch FW7 of DATUM) + (REPLACE FW7 OF DATUM WITH NEWVALUE)) (* ; - "The char within page of the underlying file that this piece starts on -- for backbin & co") - (PCOFFSET (fetch TIPCOFFSET of (fetch IMAGEDATA of DATUM)) - (REPLACE TIPCOFFSET OF (fetch IMAGEDATA of DATUM) - with NEWVALUE)) (* ; - "The offset into the current piece, as of the last page cross.") - (CURRENTLOOKS (fetch F10 of DATUM) - (replace F10 of DATUM with NEWVALUE)) + "The char within page of the underlying file that this piece starts on -- for backbin & co") + (PCOFFSET (fetch TIPCOFFSET of (fetch IMAGEDATA of DATUM)) + (REPLACE TIPCOFFSET OF (fetch IMAGEDATA of DATUM) with NEWVALUE)) (* ; - "The CHARLOOKS that are currently applicable to characters being taken from the stream.") - (CURRENTPARALOOKS (fetch TICURPARALOOKS of (fetch IMAGEDATA - of DATUM)) - (REPLACE TICURPARALOOKS OF (fetch IMAGEDATA - of DATUM) with - NEWVALUE) - ) (* ; - "The FMTSPEC that is currently applicable to characters being taken from the stream.") - (CURRENTIMAGESTREAM (fetch TICURIMAGESTREAM - of (fetch IMAGEDATA of DATUM)) - (REPLACE TICURIMAGESTREAM OF (fetch IMAGEDATA - of DATUM) with - NEWVALUE) + "The offset into the current piece, as of the last page cross.") + (CURRENTLOOKS (fetch F10 of DATUM) + (replace F10 of DATUM with NEWVALUE)) (* ; - "The image stream that this text is being put onto; used for scaling decisions") - ) - (LOOKSUPDATEFN (fetch TILOOKSUPDATEFN of (fetch IMAGEDATA - of DATUM)) - (REPLACE TILOOKSUPDATEFN OF (fetch IMAGEDATA - of DATUM) with - NEWVALUE)) + "The CHARLOOKS that are currently applicable to characters being taken from the stream.") + (CURRENTPARALOOKS (fetch TICURPARALOOKS of (fetch IMAGEDATA of DATUM)) + (REPLACE TICURPARALOOKS OF (fetch IMAGEDATA of DATUM) with NEWVALUE)) (* ; - "Function to be called each time character looks change.") - (FATSTREAMP (fetch F4 of DATUM) - (REPLACE F4 OF DATUM WITH NEWVALUE)) + "The FMTSPEC that is currently applicable to characters being taken from the stream.") + (CURRENTIMAGESTREAM (fetch TICURIMAGESTREAM of (fetch IMAGEDATA of DATUM)) + (REPLACE TICURIMAGESTREAM OF (fetch IMAGEDATA of DATUM) with NEWVALUE) (* ; - "T if the current piece is 16 bit characters.") - ) - (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ (create - - TEXTIMAGEDATA - )))) + "The image stream that this text is being put onto; used for scaling decisions") + ) + (LOOKSUPDATEFN (fetch TILOOKSUPDATEFN of (fetch IMAGEDATA of DATUM)) + (REPLACE TILOOKSUPDATEFN OF (fetch IMAGEDATA of DATUM) with NEWVALUE)) + (* ; + "Function to be called each time character looks change.") + (FATSTREAMP (fetch F4 of DATUM) + (REPLACE F4 OF DATUM WITH NEWVALUE)) + (* ; + "T if the current piece is 16 bit characters.") + ) + (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ (create TEXTIMAGEDATA)))) ) -(/DECLAREDATATYPE 'PIECE '(POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG - POINTER FLAG FLAG XPOINTER) +(/DECLAREDATATYPE 'PIECE + '(POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG + XPOINTER POINTER) '((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4 POINTER) @@ -713,8 +695,9 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS . 16)) - (PIECE 18 XPOINTER)) - '20) + (PIECE 18 XPOINTER) + (PIECE 20 POINTER)) + '22) (/DECLAREDATATYPE 'TEXTOBJ '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER @@ -792,44 +775,41 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DEFOPTIMIZER TEXTPROP (TEXTOBJ PROP &OPTIONAL (VAL NIL WRITING)) - (* ;; "compiles calls to TEXTPROP") + (* ;; "compiles calls to TEXTPROP") - [COND - ((NOT (LISTP PROP)) (* ; "property is not quoted.") - 'IGNOREMACRO) - ((NOT (EQ (CAR PROP) - 'QUOTE)) (* ; "property is not quoted.") - 'IGNOREMACRO) - [(NOT WRITING) (* ; "fetching a TEXTPROP property.") - (SELECTQ (CADR PROP) - ((READONLY READ-ONLY) - `(fetch (TEXTOBJ TXTREADONLY) of (TEXTOBJ - ,TEXTOBJ))) - ((BEING-EDITED ACTIVE) - `(fetch (TEXTOBJ TXTEDITING) of (TEXTOBJ ,TEXTOBJ))) - ((NO-NS-CHARS NONSCHARS NO-NSCHARS) - `(fetch (TEXTOBJ TXTNONSCHARS) of (TEXTOBJ - ,TEXTOBJ))) - `(LISTGET (fetch (TEXTOBJ EDITPROPS) - of (TEXTOBJ ,TEXTOBJ)) - ,PROP] - (T (* ; "storing a window property") - (SELECTQ (CADR PROP) - ((READONLY READ-ONLY) - `(REPLACE (TEXTOBJ TXTREADONLY) - OF (TEXTOBJ ,TEXTOBJ) WITH ,VAL)) - ((BEING-EDITED ACTIVE) - `(REPLACE (TEXTOBJ TXTEDITING) - OF (TEXTOBJ ,TEXTOBJ) WITH ,VAL)) - ((NO-NS-CHARS NONSCHARS NO-NSCHARS) - `(REPLACE (TEXTOBJ TXTNONSCHARS) - OF (TEXTOBJ ,TEXTOBJ) WITH ,VAL)) - `(LET* (($$TEXTOBJ$$ (TEXTOBJ ,TEXTOBJ)) - ($$PROPLST$$ (FETCH EDITPROPS OF $$TEXTOBJ$$))) - (COND - ($$PROPLST$$ (LISTPUT $$PROPLST$$ ,PROP ,VAL)) - (T (REPLACE EDITPROPS OF $$TEXTOBJ$$ - WITH (LIST ,PROP ,VAL]) + [COND + ((NOT (LISTP PROP)) (* ; "property is not quoted.") + 'IGNOREMACRO) + ((NOT (EQ (CAR PROP) + 'QUOTE)) (* ; "property is not quoted.") + 'IGNOREMACRO) + [(NOT WRITING) (* ; "fetching a TEXTPROP property.") + (SELECTQ (CADR PROP) + ((READONLY READ-ONLY) + `(fetch (TEXTOBJ TXTREADONLY) of (TEXTOBJ ,TEXTOBJ))) + ((BEING-EDITED ACTIVE) + `(fetch (TEXTOBJ TXTEDITING) of (TEXTOBJ ,TEXTOBJ))) + ((NO-NS-CHARS NONSCHARS NO-NSCHARS) + `(fetch (TEXTOBJ TXTNONSCHARS) of (TEXTOBJ ,TEXTOBJ))) + `(LISTGET (fetch (TEXTOBJ EDITPROPS) of (TEXTOBJ ,TEXTOBJ)) + ,PROP] + (T (* ; "storing a window property") + (SELECTQ (CADR PROP) + ((READONLY READ-ONLY) + `(REPLACE (TEXTOBJ TXTREADONLY) OF (TEXTOBJ ,TEXTOBJ) + WITH ,VAL)) + ((BEING-EDITED ACTIVE) + `(REPLACE (TEXTOBJ TXTEDITING) OF (TEXTOBJ ,TEXTOBJ) + WITH ,VAL)) + ((NO-NS-CHARS NONSCHARS NO-NSCHARS) + `(REPLACE (TEXTOBJ TXTNONSCHARS) OF (TEXTOBJ ,TEXTOBJ) + WITH ,VAL)) + `(LET* (($$TEXTOBJ$$ (TEXTOBJ ,TEXTOBJ)) + ($$PROPLST$$ (FETCH EDITPROPS OF $$TEXTOBJ$$))) + (COND + ($$PROPLST$$ (LISTPUT $$PROPLST$$ ,PROP ,VAL)) + (T (REPLACE EDITPROPS OF $$TEXTOBJ$$ + WITH (LIST ,PROP ,VAL]) @@ -860,41 +840,41 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (PUTPROPS \EDITELT DMACRO (OPENLAMBDA (ARR NO) - (* This is equivalent to ELT, but bypasses the checking, since we "know" that - ARR is an array. Hence, much faster.) + (* This is equivalent to ELT, but bypasses the checking, since we "know" that ARR + is an array. Hence, much faster.) - (GETBASEPTR (\ADDBASE2 (fetch (ARRAYP BASE) of ARR) - NO) - 0))) + (GETBASEPTR (\ADDBASE2 (fetch (ARRAYP BASE) of ARR) + NO) + 0))) -(PUTPROPS \GETCH MACRO ((TEXTOBJ) (* jds "23-FEB-82 08:56") +(PUTPROPS \GETCH MACRO ((TEXTOBJ) (* jds "23-FEB-82 08:56") (* Get the next available character - from the text being edited.) - (\BIN (fetch STREAMHINT of TEXTOBJ)))) + from the text being edited.) + (\BIN (fetch STREAMHINT of TEXTOBJ)))) -(PUTPROPS \GETCHB MACRO ((TEXTOBJ) (* Get the next prior character in - the text being edited.) - (\BACKBIN (fetch STREAMHINT of TEXTOBJ)))) +(PUTPROPS \GETCHB MACRO ((TEXTOBJ) (* Get the next prior character in the + text being edited.) + (\BACKBIN (fetch STREAMHINT of TEXTOBJ)))) (PUTPROPS \EDITSETA DMACRO (OPENLAMBDA (ARR N VAL) (* Equivalent to SETA (for pointer-type arrays)%, but bypasses the bounds and - type checking. Hence MUCH faster.) + type checking. Hence MUCH faster.) - (\RPLPTR (\ADDBASE2 (fetch (ARRAYP BASE) of ARR) - N) - 0 VAL))) + (\RPLPTR (\ADDBASE2 (fetch (ARRAYP BASE) of ARR) + N) + 0 VAL))) (PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) - [CHECK (AND (ARRAYP A) - (ZEROP (fetch (ARRAYP ORIG) of A)) - (EQ \ST.POS16 (fetch (ARRAYP TYP) of A] - (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) - J)) - (\PUTBASE (fetch (ARRAYP BASE) of A) - (IPLUS (fetch (ARRAYP OFFST) of A) - J) - V))) + [CHECK (AND (ARRAYP A) + (ZEROP (fetch (ARRAYP ORIG) of A)) + (EQ \ST.POS16 (fetch (ARRAYP TYP) of A] + (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) + J)) + (\PUTBASE (fetch (ARRAYP BASE) of A) + (IPLUS (fetch (ARRAYP OFFST) of A) + J) + V))) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -910,55 +890,55 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (RECORD PAGEFORMATTINGSTATE ( - (* ;; "Contains the state for a TEdit page-formatting job.") + (* ;; "Contains the state for a TEdit page-formatting job.") - PAGE# (* ; - "The current page number. Counted from 1") - FIRSTPAGE + PAGE# (* ; + "The current page number. Counted from 1") + FIRSTPAGE - (* ;; "T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed.") + (* ;; "T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed.") - MINPAGE# (* ; - "The page # of the first page to be printed, or NIL") - MAXPAGE# (* ; - "The page # of the last page to be printed, or NIL") - STATE (* ; "One of FORMATTING or SEARCHING.") - REQUIREDREGIONTYPE (* ; "If STATE is SEARCHING, the kind of box we're looking for. If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page.") - MAINSTREAM (* ; - "The principal textobj/stream source") - CHNO (* ; "Our position in that stream") - PRESSREGION (* ; "The press code's REGION info.") - PAGEHEADINGS (* ; - "The list of current values to be printed, indexed by heading type") - PAGE#GENERATOR (* ; "List of page numbers; later, maybe, a function to generate page numbers. Used to fill in PAGE#TEXT, below") - PAGE#TEXT (* ; "If special page numbers are in use, this is the place to take them from. PAGE# is still used for recto/verso decisions &c") - PAGEISRECTO (* ; - "T if this is a recto page, NIL if it's a VERSO page.") - PAGEFOOTNOTELINES (* ; - "A list of extant footnote lines that should appear at the next opportunity") - PAGEFLOATINGTOPLINES (* ; - "A list of lines that should float to the top of the next available place") - PAGECOUNT (* ; - "The number of pages we've formatted so far.") - PAGELINECACHE (* ; "A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time") - NEWPAGELAYOUT (* ; "If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again.") - ) - PAGECOUNT _ 0) + MINPAGE# (* ; + "The page # of the first page to be printed, or NIL") + MAXPAGE# (* ; + "The page # of the last page to be printed, or NIL") + STATE (* ; "One of FORMATTING or SEARCHING.") + REQUIREDREGIONTYPE (* ; "If STATE is SEARCHING, the kind of box we're looking for. If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page.") + MAINSTREAM (* ; + "The principal textobj/stream source") + CHNO (* ; "Our position in that stream") + PRESSREGION (* ; "The press code's REGION info.") + PAGEHEADINGS (* ; + "The list of current values to be printed, indexed by heading type") + PAGE#GENERATOR (* ; "List of page numbers; later, maybe, a function to generate page numbers. Used to fill in PAGE#TEXT, below") + PAGE#TEXT (* ; "If special page numbers are in use, this is the place to take them from. PAGE# is still used for recto/verso decisions &c") + PAGEISRECTO (* ; + "T if this is a recto page, NIL if it's a VERSO page.") + PAGEFOOTNOTELINES (* ; + "A list of extant footnote lines that should appear at the next opportunity") + PAGEFLOATINGTOPLINES (* ; + "A list of lines that should float to the top of the next available place") + PAGECOUNT (* ; + "The number of pages we've formatted so far.") + PAGELINECACHE (* ; "A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time") + NEWPAGELAYOUT (* ; "If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again.") + ) + PAGECOUNT _ 0) (DATATYPE PAGEREGION ( - (* ;; - "Describe a part of a page for page formatting. Can be made into compound descriptions.") + (* ;; + "Describe a part of a page for page formatting. Can be made into compound descriptions.") - REGIONFILLMETHOD (* ; - "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") - REGIONSPEC (* ; - "The page-relative region this occupies") - REGIONLOCALINFO (* ; "A PLIST for local information") - (REGIONPARENT FULLXPOINTER) (* ; - "The parent node for this box, for sub-boxes") - REGIONSUBBOXES (* ; "The sub-regions of this region") - REGIONTYPE (* ; "A user-settable region type") - )) + REGIONFILLMETHOD (* ; + "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") + REGIONSPEC (* ; + "The page-relative region this occupies") + REGIONLOCALINFO (* ; "A PLIST for local information") + (REGIONPARENT FULLXPOINTER) (* ; + "The parent node for this box, for sub-boxes") + REGIONSUBBOXES (* ; "The sub-regions of this region") + REGIONTYPE (* ; "A user-settable region type") + )) ) (/DECLAREDATATYPE 'PAGEREGION '(POINTER POINTER POINTER FULLXPOINTER POINTER POINTER) @@ -973,15 +953,15 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (RECORD TEDITPAPERSIZE ( - (* ;; - "Describe the size of a sheet of paper (in points), given a paper size-name.") + (* ;; + "Describe the size of a sheet of paper (in points), given a paper size-name.") - TPSNAME (* ; "The name, as a litatom") - TPSWIDTH (* ; "Paper width, in points") - TPSHEIGHT (* ; "Paper Height, in points") - TPSLANDSCAPE? (* ; - "T if we have to rotate things to print them on this paper.") - )) + TPSNAME (* ; "The name, as a litatom") + TPSWIDTH (* ; "Paper width, in points") + TPSHEIGHT (* ; "Paper Height, in points") + TPSLANDSCAPE? (* ; + "T if we have to rotate things to print them on this paper.") + )) ) @@ -1047,126 +1027,124 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (DATATYPE CHARLOOKS ( - (* ;; - "Describes the appearance (%"Looks%") of characters in a TEdit document.") + (* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") - CLFONT (* ; - "The font descriptor for these characters") - CLNAME + CLFONT (* ; + "The font descriptor for these characters") + CLNAME - (* ;; "Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT.") + (* ;; "Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT.") - CLSIZE (* ; "Font size, in points") - (CLITAL FLAG) (* ; - "T if the characters are italic, else NIL") - (CLBOLD FLAG) (* ; - "T if the characters are bold, else NIL") - (CLULINE FLAG) (* ; - "T if the characters are to be underscored, else NIL") - (CLOLINE FLAG) (* ; - "T if the characters are to be overscored, else NIL") - (CLSTRIKE FLAG) (* ; - "T if the characters are to be struck thru, else nil.") - CLOFFSET (* ; - "A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") - (CLSMALLCAP FLAG) (* ; "T if small caps, else NIL") - (CLINVERTED FLAG) (* ; - "T if the characters are to be shown white-on-black") - (CLPROTECTED FLAG) (* ; - "T if chars can't be selected, else NIL") - (CLINVISIBLE FLAG) (* ; - "T if TEDIT is to ignore these chars; else NIL") - (CLSELHERE FLAG) + CLSIZE (* ; "Font size, in points") + (CLITAL FLAG) (* ; + "T if the characters are italic, else NIL") + (CLBOLD FLAG) (* ; + "T if the characters are bold, else NIL") + (CLULINE FLAG) (* ; + "T if the characters are to be underscored, else NIL") + (CLOLINE FLAG) (* ; + "T if the characters are to be overscored, else NIL") + (CLSTRIKE FLAG) (* ; + "T if the characters are to be struck thru, else nil.") + CLOFFSET (* ; + "A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") + (CLSMALLCAP FLAG) (* ; "T if small caps, else NIL") + (CLINVERTED FLAG) (* ; + "T if the characters are to be shown white-on-black") + (CLPROTECTED FLAG) (* ; + "T if chars can't be selected, else NIL") + (CLINVISIBLE FLAG) (* ; + "T if TEDIT is to ignore these chars; else NIL") + (CLSELHERE FLAG) - (* ;; "T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED.") + (* ;; "T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED.") - (CLCANCOPY FLAG) + (CLCANCOPY FLAG) - (* ;; "T if this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)") + (* ;; "T if this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)") - CLSTYLE (* ; - "The style to be used in marking these characters; overridden by the other fields") - CLUSERINFO (* ; - "Any information that an outsider wants to include") - CLLEADER (* ; - "For creating dotted and other kinds of leader") - CLRULES + CLSTYLE (* ; + "The style to be used in marking these characters; overridden by the other fields") + CLUSERINFO (* ; + "Any information that an outsider wants to include") + CLLEADER (* ; + "For creating dotted and other kinds of leader") + CLRULES - (* ;; "For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs.") + (* ;; "For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs.") - (CLMARK FLAG) + (CLMARK FLAG) - (* ;; "Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document") + (* ;; "Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document") - ) - CLOFFSET _ 0) + ) + CLOFFSET _ 0) (DATATYPE FMTSPEC ( - (* ;; - "Describe the paragraph formatting for a paragraph in a TEdit document.") + (* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.") - 1STLEFTMAR (* ; - "Left margin of the first line of the paragraph") - LEFTMAR (* ; - "Left margin of the rest of the lines in the paragraph") - RIGHTMAR (* ; "Right margin for the paragraph") - LEADBEFORE (* ; - "Leading above the paragraph's first line, in points") - LEADAFTER (* ; - "Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") - LINELEAD (* ; - "Leading between lines, in points. Actually, this space is added BELOW each line in the para.") - FMTBASETOBASE (* ; -"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING") - TABSPEC (* ; - "The list of tabs for this paragraph, including CAR for a default tab width") - QUAD (* ; - "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") - FMTSTYLE (* ; - "The STYLE that controls this paragraph's appearance") - FMTCHARSTYLES (* ; "The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)") - FMTUSERINFO (* ; "Space for a PLIST of user info") - FMTSPECIALX (* ; - "A special horizontal location on the printed page for this para.") - FMTSPECIALY (* ; - "A special vertical location on the page for this para") - (FMTHEADINGKEEP FLAG) (* ; - "This para should be kept with the top line or so of the next para..") - FMTPARATYPE (* ; - "What kind of para this is: TEXT, PAGEHEADING, whatever") - FMTPARASUBTYPE (* ; - "Sub type of the type, e.g., what KIND of page heading this is.") - FMTNEWPAGEBEFORE (* ; "Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box.") - FMTNEWPAGEAFTER (* ; "Similarly") - FMTKEEP (* ; - "For information about how this paragraph is to be kept with other paragraphs.") - FMTCOLUMN (* ; - "For setting up side-by-side paragraphs easily ala BravoX") - FMTVERTRULES (* ; - "For Keeping track of vertical rules in force") - (FMTMARK FLAG) (* ; "Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file") + 1STLEFTMAR (* ; + "Left margin of the first line of the paragraph") + LEFTMAR (* ; + "Left margin of the rest of the lines in the paragraph") + RIGHTMAR (* ; "Right margin for the paragraph") + LEADBEFORE (* ; + "Leading above the paragraph's first line, in points") + LEADAFTER (* ; + "Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") + LINELEAD (* ; + "Leading between lines, in points. Actually, this space is added BELOW each line in the para.") + FMTBASETOBASE (* ; + "The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING") + TABSPEC (* ; + "The list of tabs for this paragraph, including CAR for a default tab width") + QUAD (* ; + "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") + FMTSTYLE (* ; + "The STYLE that controls this paragraph's appearance") + FMTCHARSTYLES (* ; "The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)") + FMTUSERINFO (* ; "Space for a PLIST of user info") + FMTSPECIALX (* ; + "A special horizontal location on the printed page for this para.") + FMTSPECIALY (* ; + "A special vertical location on the page for this para") + (FMTHEADINGKEEP FLAG) (* ; + "This para should be kept with the top line or so of the next para..") + FMTPARATYPE (* ; + "What kind of para this is: TEXT, PAGEHEADING, whatever") + FMTPARASUBTYPE (* ; + "Sub type of the type, e.g., what KIND of page heading this is.") + FMTNEWPAGEBEFORE (* ; "Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box.") + FMTNEWPAGEAFTER (* ; "Similarly") + FMTKEEP (* ; + "For information about how this paragraph is to be kept with other paragraphs.") + FMTCOLUMN (* ; + "For setting up side-by-side paragraphs easily ala BravoX") + FMTVERTRULES (* ; + "For Keeping track of vertical rules in force") + (FMTMARK FLAG) (* ; "Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file") (* ; "Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it makes sense to save it on the file.") - (FMTHARDCOPY FLAG) (* ; - "T if this paragraph is to be displayed in hardcopy-format.") - FMTREVISED (* ; "T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output.") - ) - TABSPEC _ (CONS NIL NIL)) + (FMTHARDCOPY FLAG) (* ; + "T if this paragraph is to be displayed in hardcopy-format.") + FMTREVISED (* ; "T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output.") + ) + TABSPEC _ (CONS NIL NIL)) (DATATYPE PENDINGTAB ( - (* ;; "The data structure for a tab, within the line formatter, that we haven't finished dealing with yet, e.g. a centered tab where you need to wait for AFTER the centered text to do the formatting.") + (* ;; "The data structure for a tab, within the line formatter, that we haven't finished dealing with yet, e.g. a centered tab where you need to wait for AFTER the centered text to do the formatting.") - PTNEWTX + PTNEWTX - (* ;; "An updated TX, being passed back to the line formatter. This results from the resolution of an old RIGHT, CENTERED, or DECIMAL tab, which changed the width of a prior tab.") + (* ;; "An updated TX, being passed back to the line formatter. This results from the resolution of an old RIGHT, CENTERED, or DECIMAL tab, which changed the width of a prior tab.") - PTOLDTAB (* ; "The pending tab") - PTTYPE (* ; "Its tab type") - PTTABX (* ; "Its nominal X position") - (PTWBASE FULLXPOINTER) (* ; - "The WBASE for its width, for updating when we've figured out how wide the tab really is") - PTOLDTX (* ; - "The TX as of when the tab was encountered.") - )) + PTOLDTAB (* ; "The pending tab") + PTTYPE (* ; "Its tab type") + PTTABX (* ; "Its nominal X position") + (PTWBASE FULLXPOINTER) (* ; + "The WBASE for its width, for updating when we've figured out how wide the tab really is") + PTOLDTX (* ; + "The TX as of when the tab was encountered.") + )) ) (/DECLAREDATATYPE 'CHARLOOKS @@ -1237,19 +1215,19 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) - (SIGNED (create WORD - HIBYTE _ (\BIN STREAM) - LOBYTE _ (\BIN STREAM)) - BITSPERWORD))) + (SIGNED (create WORD + HIBYTE _ (\BIN STREAM) + LOBYTE _ (\BIN STREAM)) + BITSPERWORD))) (PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) - (\BOUT STREAM (LOGAND 255 (LRSH W 8))) - (\BOUT STREAM (LOGAND W 255)))) + (\BOUT STREAM (LOGAND 255 (LRSH W 8))) + (\BOUT STREAM (LOGAND W 255)))) (PUTPROPS ONOFF MACRO [OPENLAMBDA (VAL) - (COND - (VAL 'ON) - (T 'OFF]) + (COND + (VAL 'ON) + (T 'OFF]) ) ) @@ -1261,29 +1239,29 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (RECORD MBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM) - (OR (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.DISPLAY) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.THREESTATE.DISPLAY) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - '\TEXTMENU.TOGGLE.DISPLAY]) + (OR (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) + 'MB.DISPLAY) + (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) + 'MB.THREESTATE.DISPLAY) + (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) + '\TEXTMENU.TOGGLE.DISPLAY]) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD NWAYBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.NB.DISPLAYFN]) + (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) + 'MB.NB.DISPLAYFN]) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) - [TYPE? (AND (IMAGEOBJP DATUM) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.MARGINBAR.DISPLAYFN]) + [TYPE? (AND (IMAGEOBJP DATUM) + (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) + 'MB.MARGINBAR.DISPLAYFN]) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -1295,33 +1273,33 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (TYPERECORD MB.3STATE ( - (* ;; "Describes a 3-state menu button.") + (* ;; "Describes a 3-state menu button.") - MBLABEL (* ; - "Label for the button on the screen") - MBFONT (* ; - "Font the label text should appear in") - MBCHANGESTATEFN (* ; - "Function to call when the button's state changes") - MBINITSTATE (* ; "Button's initial state.") - ) - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) + MBLABEL (* ; + "Label for the button on the screen") + MBFONT (* ; + "Font the label text should appear in") + MBCHANGESTATEFN (* ; + "Function to call when the button's state changes") + MBINITSTATE (* ; "Button's initial state.") + ) + MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) (TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) - MBBUTTONEVENTFN _ 'MB.DEFAULTBUTTON.FN MBFONT _ (FONTCREATE 'HELVETICA 8 - 'BOLD)) + MBBUTTONEVENTFN _ 'MB.DEFAULTBUTTON.FN MBFONT _ (FONTCREATE 'HELVETICA 8 + 'BOLD)) (TYPERECORD MB.INSERT (MBINITENTRY)) (TYPERECORD MB.MARGINBAR (ignoredfield)) (TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) + MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) (TYPERECORD MB.TEXT (MBSTRING MBFONT)) (TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) + MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) ) (DEFMACRO WITHOUT-UPDATES (TEXTOBJ SCRATCHSEL &BODY BODY) @@ -1349,24 +1327,24 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE (RECORD TEDITHISTORYEVENT ( - (* ;; "Describes one event on the TEdit edit history list.") + (* ;; "Describes one event on the TEdit edit history list.") - THACTION (* ; - "A LITATOM, specifying what the event was") - THPOINT (* ; - "Was the selection to the left or right?") - THLEN (* ; "The # of chars involved") - THCH# (* ; "The starting ch#") - THFIRSTPIECE (* ; "First piece involved") - THOLDINFO (* ; "Old info, for undo") - THAUXINFO (* ; - "Auxiliary info about the event, primarily for redo") - THTEXTOBJ + THACTION (* ; + "A LITATOM, specifying what the event was") + THPOINT (* ; + "Was the selection to the left or right?") + THLEN (* ; "The # of chars involved") + THCH# (* ; "The starting ch#") + THFIRSTPIECE (* ; "First piece involved") + THOLDINFO (* ; "Old info, for undo") + THAUXINFO (* ; + "Auxiliary info about the event, primarily for redo") + THTEXTOBJ - (* ;; "Place to remember a second textobj, for those like MOVE who need to remember both a source and a destination.") + (* ;; "Place to remember a second textobj, for those like MOVE who need to remember both a source and a destination.") - ) - THPOINT _ 'LEFT) + ) + THPOINT _ 'LEFT) ) @@ -1408,40 +1386,40 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(PUTPROPS \INSERT\TTY\BUFFER MACRO (NIL (\TEDIT.INSERT.TTY.BUFFER ISCRSTRING IPASSSTRING - TEXTOBJ SEL))) +(PUTPROPS \INSERT\TTY\BUFFER MACRO (NIL (\TEDIT.INSERT.TTY.BUFFER ISCRSTRING IPASSSTRING TEXTOBJ SEL) + )) (PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* Test to see if only the specified mouse button is down. - DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last - time it WAS called.) + DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last + time it WAS called.) - (SELECTQ (CAR BUTTON) - (LEFT '(IEQP LASTMOUSEBUTTONS 4)) - (MIDDLE '(IEQP LASTMOUSEBUTTONS 1)) - (RIGHT '(IEQP LASTMOUSEBUTTONS 2)) - (SHOULDNT)))) + (SELECTQ (CAR BUTTON) + (LEFT '(IEQP LASTMOUSEBUTTONS 4)) + (MIDDLE '(IEQP LASTMOUSEBUTTONS 1)) + (RIGHT '(IEQP LASTMOUSEBUTTONS 2)) + (SHOULDNT)))) -(PUTPROPS \TEDIT.CHECK MACRO - [ARGS (COND - [(AND (BOUNDP 'CHECK) - CHECK) - (CONS 'PROGN (for I in ARGS as J on ARGS - when (NOT (STRINGP I)) - collect (LIST 'OR I (LIST 'HELP +(PUTPROPS \TEDIT.CHECK MACRO [ARGS (COND + [(AND (BOUNDP 'CHECK) + CHECK) + (CONS 'PROGN + (for I in ARGS as J on ARGS + when (NOT (STRINGP I)) + collect (LIST 'OR I (LIST 'HELP "TEdit consistency-check failure [RETURN to continue]: " - (COND - ((STRINGP (CADR J))) - (T (KWOTE I] - (T (CONS COMMENTFLG ARGS]) + (COND + ((STRINGP (CADR J))) + (T (KWOTE I] + (T (CONS COMMENTFLG ARGS]) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) - (TTDECODE (LOGAND DATUM 31)))) + (TTDECODE (LOGAND DATUM 31)))) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -1519,37 +1497,37 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (* Used to hold the current time, when checking to see if a transition is due) - TCTHENTIME (* Time when the next transition is - to take place) - TCFORCEDDOWN (* TCFORCEDOWN = T means - (Make the caret visible at the next - call to \EDIT.FLIPCARET.)) - TCUP + TCTHENTIME (* Time when the next transition is to + take place) + TCFORCEDDOWN (* TCFORCEDOWN = T means + (Make the caret visible at the next + call to \EDIT.FLIPCARET.)) + TCUP - (* TCUP = T => The caret is NOT VISIBLE. - Used to track the current state of the caret) + (* TCUP = T => The caret is NOT VISIBLE. Used to track the current state of the + caret) - TCCARETDS (* The display stream that the caret - appears in) - TCCURSORBM (* The CURSOR representing the caret) - TCCARETRATE (* %# of MSEC between caret up/down - transitions) - TCFORCEUP + TCCARETDS (* The display stream that the caret + appears in) + TCCURSORBM (* The CURSOR representing the caret) + TCCARETRATE (* %# of MSEC between caret up/down + transitions) + TCFORCEUP (* T => The caret is not allowed to become visible. - Used to keep the caret up during screen updates) + Used to keep the caret up during screen updates) - TCCARETX (* X position in the window that the - caret appears at) - TCCARETY (* Y position in the window where - the caret appears) - TCCARET (* A lisp CARET to be flashed - (eventually)) - ) - TCNOWTIME _ (CREATECELL \FIXP) - TCTHENTIME _ (CREATECELL \FIXP) - TCCURSORBM _ BXCARET TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ - (\CARET.CREATE BXCARET)) + TCCARETX (* X position in the window that the + caret appears at) + TCCARETY (* Y position in the window where the + caret appears) + TCCARET (* A lisp CARET to be flashed + (eventually)) + ) + TCNOWTIME _ (CREATECELL \FIXP) + TCTHENTIME _ (CREATECELL \FIXP) + TCCURSORBM _ BXCARET TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE + BXCARET)) ) (/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER @@ -1589,23 +1567,22 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (DECLARE%: EVAL@COMPILE -(DATATYPE PCTNODE (CHNUM (* ; - "Character #of piece in this node.") - PCE (* ; "PIECE ") - LO (* ; - "Subtree these nodes' ch#are less than this node.") - HI (* ; - " Subtree these nodes' ch#are more than this node.") - BF (* ; "Balance factor.") +(DATATYPE PCTNODE (CHNUM (* ; "Character #of piece in this node.") + PCE (* ; "PIECE ") + LO (* ; + "Subtree these nodes' ch#are less than this node.") + HI (* ; + " Subtree these nodes' ch#are more than this node.") + BF (* ; "Balance factor.") (* ; - "1: Right(HI) Subtree is higher than left(lo) subtree.") + "1: Right(HI) Subtree is higher than left(lo) subtree.") (* ; - "0: Right subtree and left subtree are same height") + "0: Right subtree and left subtree are same height") (* ; - "-1: Right(HI) Subtree is shorter than left(lo) subtree.") - RANK (* ; "(# of nodes in left subtree) +1") - ) - CHNUM _ 0 BF _ 0 RANK _ 1) + "-1: Right(HI) Subtree is shorter than left(lo) subtree.") + RANK (* ; "(# of nodes in left subtree) +1") + ) + CHNUM _ 0 BF _ 0 RANK _ 1) ) (/DECLAREDATATYPE 'PCTNODE '(POINTER POINTER POINTER POINTER POINTER POINTER) @@ -1663,7 +1640,7 @@ Copyright (c) 1986-1991, 1993-1994, 2021 by Venue. (NEWCHAR-IF-SPLIT.LB 32)) ) ) -(PUTPROPS TEDITDCL COPYRIGHT ("Venue" 1986 1987 1988 1989 1990 1991 1993 1994 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL))) + (FILEMAP (NIL (56384 56572 (\NEW-COLUMN-START 56384 . 56572)) (56574 56765 (\FIRST-COLUMN-START 56574 + . 56765)) (72979 74080 (WITHOUT-UPDATES 72979 . 74080))))) STOP diff --git a/library/TEDITDCL.LCOM b/library/tedit/TEDIT-DCL.LCOM similarity index 96% rename from library/TEDITDCL.LCOM rename to library/tedit/TEDIT-DCL.LCOM index da6d0c86..7a269347 100644 --- a/library/TEDITDCL.LCOM +++ b/library/tedit/TEDIT-DCL.LCOM @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Sep-2021 12:53:57" ("compiled on " -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "20-Sep-2021 11:14:12" brecompiled -exprs%: nothing in "FULL 20-Sep-2021 ..." dated "20-Sep-2021 11:14:18") -(FILECREATED "21-Sep-2021 12:53:57" {DSK}kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2 -86549 changes to%: (VARS TEDITDCLCOMS) previous date%: "30-Apr-2021 17:26:17" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;1) -(PRETTYCOMPRINT TEDITDCLCOMS) -(RPAQQ TEDITDCLCOMS ((* ;;; + +(FILECREATED "14-Jul-2022 17:04:17" ("compiled on " +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3) "14-Jul-2022 13:19:07" +tcompl'd in "FULL 14-Jul-2022 ..." dated "14-Jul-2022 13:19:12") +(FILECREATED "14-Jul-2022 17:03:38" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3 84851 :CHANGES-TO (VARS +TEDITFILES) :PREVIOUS-DATE "14-Jul-2022 16:29:57" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;2) +(PRETTYCOMPRINT TEDIT-DCLCOMS) +(RPAQQ TEDIT-DCLCOMS ((* ;;; "This file is the collected record declarations and compile-time necessities for TEDIT.") (* ;; "FROM TEDIT") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))) (* ;; "FROM TEDITSELECTION") (RECORDS SELECTION) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (COPYSELSHADE @@ -83,9 +85,9 @@ SELECTION 8 POINTER) (SELECTION 10 POINTER) (SELECTION 12 POINTER) (SELECTION 14 FULLXPOINTER) (SELECTION 24 POINTER) (SELECTION 26 POINTER) (SELECTION 28 POINTER) (SELECTION 28 ( FLAGBITS . 0)) (SELECTION 30 POINTER) (SELECTION 30 (FLAGBITS . 0)) (SELECTION 32 POINTER))) (QUOTE 34 )) -(RPAQQ TEDITFILES (PCTREE TEXTOFD TEDIT TEDITABBREV TEDITCOMMAND TEDITDCL TEDITFILE TEDITFIND -TEDITFNKEYS TEDITHCPY TEDITHISTORY TEDITLOOKS TEDITMENU TEDITPAGE TEDITSCREEN TEDITSELECTION -TEDITWINDOW)) +(RPAQQ TEDITFILES (TEDIT-PCTREE TEDIT-TEXTOFD TEDIT TEDIT-ABBREV TEDIT-COMMAND TEDIT-DCL TEDIT-FILE +TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-LOOKS TEDIT-MENU TEDIT-PAGE TEDIT-SCREEN +TEDIT-SELECTION TEDIT-WINDOW)) (DATATYPE THISLINE ((* ;; "Cache for line-related character location info, for selection and line-display code to use.") (DESC FULLXPOINTER) (* ; "Line descriptor for the line this describes now") LEN (* ; @@ -160,9 +162,11 @@ NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ; PPARALAST FLAG) (* ; "This piece contains a paragraph break") PPARALOOKS (* ; "Paragraph looks for this piece") (PNEW FLAG) (* ; "This text is new here; used by the tentative edit system, and anyone else interested.") (PFATP FLAG) - (* ; "T if the characters in this piece are FAT -- i.e., are 16 bits each.") (PTREENODE XPOINTER) (* -; "Points to the PCTB tree-node that contains this piece.")) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0 - PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL) + (* ; +"T if the characters in this piece are FAT -- i.e., are 16 bits each. This is trumped for a piece on a file that has its own PEXTERNALFORMAT" +) (PTREENODE XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PEXTERNALFORMAT + POINTER (* ; "The external format of a piece on a file"))) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0 +PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL) (DATATYPE TEXTOBJ ((* ;; "This is where TEdit stores its state information, and internal data about the text being edited.") PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") \INSERTPC (* ; @@ -263,10 +267,10 @@ fetch F4 of DATUM) (REPLACE F4 OF DATUM WITH NEWVALUE)) (* ; "T if the current piece is 16 bit characters.")) (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ ( create TEXTIMAGEDATA)))) (/DECLAREDATATYPE (QUOTE PIECE) (QUOTE (POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER -POINTER FLAG POINTER FLAG FLAG XPOINTER)) (QUOTE ((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4 POINTER -) (PIECE 6 POINTER) (PIECE 8 POINTER) (PIECE 10 FULLXPOINTER) (PIECE 12 POINTER) (PIECE 14 POINTER) ( -PIECE 14 (FLAGBITS . 0)) (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS . 16)) ( -PIECE 18 XPOINTER))) (QUOTE 20)) +POINTER FLAG POINTER FLAG FLAG XPOINTER POINTER)) (QUOTE ((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4 + POINTER) (PIECE 6 POINTER) (PIECE 8 POINTER) (PIECE 10 FULLXPOINTER) (PIECE 12 POINTER) (PIECE 14 +POINTER) (PIECE 14 (FLAGBITS . 0)) (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS . +16)) (PIECE 18 XPOINTER) (PIECE 20 POINTER))) (QUOTE 22)) (/DECLAREDATATYPE (QUOTE TEXTOBJ) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER @@ -457,5 +461,4 @@ QUOTE 22)) (/DECLAREDATATYPE (QUOTE PCTNODE) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE (( PCTNODE 0 POINTER) (PCTNODE 2 POINTER) (PCTNODE 4 POINTER) (PCTNODE 6 POINTER) (PCTNODE 8 POINTER) ( PCTNODE 10 POINTER))) (QUOTE 12)) -(PUTPROPS TEDITDCL COPYRIGHT ("Venue" 1986 1987 1988 1989 1990 1991 1993 1994 2021)) NIL diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE new file mode 100644 index 00000000..4fd6418a --- /dev/null +++ b/library/tedit/TEDIT-FILE @@ -0,0 +1,3505 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "14-Jul-2022 16:55:44"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;1 235680 + + :PREVIOUS-DATE "14-Jul-2022 13:18:18" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;2) + + +(PRETTYCOMPRINT TEDIT-FILECOMS) + +(RPAQQ TEDIT-FILECOMS + ((FILES TEDIT-DCL) + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) + (FILES (LOADCOMP) + TEDIT-DCL)) + (COMS + (* ;; "GETting a file") + + (FNS TEDIT.BUILD.PCTB \TEDIT.CONVERT.FOREIGN.FORMAT TEDIT.FORMATTEDFILEP TEDIT.GET + TEDIT.PARSE.PAGEFRAMES1 \ARBIN \ATMIN \DWIN \STRINGIN \TEDIT.FORMATTEDP1 + \TEDIT.SET.WINDOW TEDIT.GET.PASSWORD)) + (COMS + (* ;; "INCLUDEing a file") + + (FNS TEDIT.INCLUDE TEDIT.RAW.INCLUDE)) + (COMS + (* ;; "PUTting a file:") + + (FNS TEDIT.PUT TEDIT.PUT.PCTB \TEDIT.PUTRESET TEDIT.PUT.PIECE.DESCRIPTOR \ARBOUT + \ATMOUT \DWOUT \STRINGOUT \TEDIT-OPEN-FONT-FILE)) + (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS.LIST + \TEDIT.PUT.SINGLE.CHARLOOKS) + (FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS.LIST + \TEDIT.PUT.SINGLE.PARALOOKS) + (GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) + (INITVARS (TEDIT.INPUT.FORMATS NIL) + (*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) + (* ; + "For consistent reading and writing of info on TEdit files.") + ) + (COMS + (* ;; + "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") + + (FNS TEDIT.BUILD.PCTB2 \TEDIT.GET.CHARLOOKS.LIST2 \TEDIT.GET.SINGLE.CHARLOOKS2 + \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.PUT.SINGLE.CHARLOOKS2 + \TEDIT.GET.PARALOOKS.LIST2 \TEDIT.GET.SINGLE.PARALOOKS2 TEDIT.PUT.PCTB2 + \TEDIT.PUT.CHARLOOKS.LIST2 \TEDIT.PUT.PARALOOKS.LIST2)) + (COMS + (* ;; "For converting incoming old-format files (1/27/85 cutover)") + + (FNS TEDIT.BUILD.PCTB1 TEDIT.GET.PAGEFRAMES1 \TEDIT.GET.CHARLOOKS1 + \TEDIT.GET.PARALOOKS1 TEDIT.GET.OBJECT1)) + (COMS + (* ;; "VERSION 0 Compatibility reading functions") + + (FNS TEDIT.BUILD.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0)))) + +(FILESLOAD TEDIT-DCL) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ \SCRATCHLEN 64) + + +(CONSTANTS (\SCRATCHLEN 64)) +) + + +(FILESLOAD (LOADCOMP) + TEDIT-DCL) +) + + + +(* ;; "GETting a file") + +(DEFINEQ + +(TEDIT.BUILD.PCTB + [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS CLEARGET?) + (* ; "Edited 29-Apr-2021 22:52 by rmk:") + (* ; "Edited 11-Jun-99 14:37 by rmk:") + (* ; "Edited 19-Apr-93 13:46 by jds") + (* ; + "START = 1st char of file to read from, if specified") + (* ; + "END = use this as eofptr of file. For use in reading files within files.") + (PROG (SEL LINES PCTB PC OLDPC PCCOUNT TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN + PIECEINFOCH# CACHE CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP + EXISTINGCHARLOOKS EXLOOK EXISTINGFMTSPECS (*READTABLE* *TEDIT-FILE-READTABLE*) + (*PRINT-BASE* 10) + (CURFILECH# (OR START 0)) + (CURCH# 1) + (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) + LOOKSHASH PARAHASH) + [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND + (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + (T (create FMTSPEC using + TEDIT.DEFAULT.FMTSPEC + ] + (* ; + "Set the default paragraph formatting for filling in piece PPARALOOKS fields") + (COND + (TEXTOBJ (* ; + "If there's a TEXTOBJ behind this, set its TXTFILE field to point to the right place.") + (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT))) + (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (* ; + "Set the default CHARLOOKS, for filling in pieces' PLOOKS fields") + (SETQ TEXT (\CREATEPIECEORSTREAM TEXT DEFAULTLOOKS DEFAULTPARALOOKS START END)) + (* ; + "Grab the file, or a single piece (if the text is a string, or such simple cases)") + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) + (* ; + "Start by assuming no page formatting") + (COND + ((STREAMP TEXT) (* ; + "OK, it wasn't a string, so check for cases where we have to cache the file locally.") + (AND TEXTOBJ (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT)) + (COND + ((OR [AND TEXTOBJ (SETQ CACHE? (TEXTPROP TEXTOBJ 'CACHE] + (NOT (RANDACCESSP TEXT))) (* ; + "If the file device isn't rancom access, cache the file locally.") + (* ; + "Also do this if he asks for a local cache.") + [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (* ; "The cache file") + (COND + ((OR START END) + (COPYBYTES TEXT CACHE (OR START 0) + (OR END -1))) + (T (COPYBYTES TEXT CACHE))) (* ; "Copy the text there") + (SETQ CACHE? T) (* ; "Remember that we cached it!") + + (* ;; "COPYBYTES can only have start/end args of NIL if the file is not random access. So it's impossible to grab out of the middle of a file on an NS server. Sorry.") + + (COND + (CACHE? + + (* ;; "for the folx who don't trust the connections, since all their pcs will point to core, we can close the txtfile connection") + + (CLOSEF TEXT))) + (replace (STREAM EOLCONVENTION) of CACHE with (fetch (STREAM EOLCONVENTION) + of TEXT)) + (* ; + "Remember the EOL convention from the original file, so that we can do a copychars if need be.") + (SETQ TEXT CACHE) (* ; + "And pretend the cache IS the real file from here on") + (SETQ START (SETQ END NIL)) + + (* ;; "Since we only copied the relevant part of the file into the cache, we don't need to remember the limits of interest.") + + )) + (SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END)) + + (* ;; "RMK: Domestic EOL is now LF, so changed from CR") + + (COND + ((AND (NOT PCCOUNT) + (NEQ (fetch (STREAM EOLCONVENTION) of TEXT) + LF.EOLC)) + + (* ;; "This is an UNFORMATTED file, and it has a foreign EOL convention. Convert it, and save the converted copy locally.") + + [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (* ; "Build a cache file") + (COND + ((OR START END) + (COPYCHARS TEXT CACHE (OR START 0) + (OR END -1)) + + (* ;; "mcf: just like before, we have all the relevant portion") + + (SETQ START (SETQ END NIL))) + (T (COPYCHARS TEXT CACHE))) (* ; + "Copy the text, converting from the foreign EOL convention into CR as end of line.") + (SETQ TEXT CACHE) + + (* ;; "And think of THIS as the cache. At this point, we may have cached twice in succession--no need to clip off START and END.") + + (SETQ CACHE? T) (* ; "Remember that we cached the file!") + )) (* ; + "Check to see if this is a formatted file, and find out how may pieces we should allocate for it.") + )) + (AND TEXTOBJ (TEXTPROP TEXTOBJ 'CACHE CACHE?)) (* ; + "REMEMBER THAT THIS TEXT WAS CACHED, SO THAT LATER PUTS DON'T INVALIDATE THE CACHE.") + [COND + [(type? PIECE TEXT) (* ; + "If this isn't a text stream, build a piece table with the one piece in it.") + (COND + ((EQ (fetch (PIECE PLEN) of TEXT) + 0) (* ; + "I hate piece whose length is zero.") + (SETQ PCTB (\MAKEPCTB (SETQ TEXT NIL))) (* INSERT-BRT (CREATEPCNODE 1 + (QUOTE LASTPIECE)) PCTB) + ) + (T (SETQ PCTB (\MAKEPCTB TEXT)) (* INSERT-BRT (CREATEPCNODE + (ADD1 (fetch (PIECE PLEN) of TEXT)) + (QUOTE LASTPIECE)) PCTB) + (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (PIECE PLOOKS) of TEXT) + TEXTOBJ)) + (* ; + "And note the CHARLOOKS and PARALOOKS of this text--as well as filling them in.") + (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) of TEXT) + TEXTOBJ] + (CLEARGET? + + (* ;; "If the user wants an uninterpreted stream onto the file , build a piece table with the one piece in it.") + + (SETQ TEXT (create PIECE + PFILE _ TEXT + PFPOS _ (COND + (START START) + (T 0)) + PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + (COND + (START START) + (T 0))) + PREVPIECE _ NIL + PLOOKS _ DEFAULTLOOKS + PPARALAST _ NIL + PPARALOOKS _ DEFAULTPARALOOKS)) + (* ; + "A single piece to describe the whole file") + (SETQ PCTB (\MAKEPCTB TEXT)) + (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (PIECE PLOOKS) of TEXT) + TEXTOBJ)) + (* ; + "And note the CHARLOOKS and PARALOOKS for later saving. Keep those caches consistent.") + (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) of TEXT) + TEXTOBJ)) + (* INSERT-BRT (CREATEPCNODE + (ADD1 (fetch (PIECE PLEN) of TEXT)) + (QUOTE LASTPIECE)) PCTB) + ) + [(NOT PCCOUNT) (* ; "This is an unformatted file") + (COND + [(SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS + when (SETQ USERTEMP (APPLY* (CAR FILETYPE) + TEXT)) do (RETURN FILETYPE))) + (* ; + "The input file is in a user-sensible format, which he is willing to convert for TEdit's use.") + (* ; "See if there are Bravo headers") + (SETQ PCTB (\TEDIT.CONVERT.FOREIGN.FORMAT (CADR USERFILEFORMAT) + TEXT USERTEMP TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS)) + (* ; + "Convert the foreign format file, and grab its PCTB") + (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] + do (* ; + "Run thru the converted pieces, noting their CHARLOOKS and PARALOOKS for the get/put caches.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (PIECE PLOOKS) of PC) + TEXTOBJ)) + (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) + of PC) + TEXTOBJ)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC] + (T (* ; + "Nope--it's straight unformatted text") + [SETQ PCTB (\MAKEPCTB (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + CURFILECH#) + PREVPIECE _ NIL + PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS + TEXTOBJ) + PPARALAST _ NIL + PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS + DEFAULTPARALOOKS TEXTOBJ] + (* ; + "So create a single piece to describe its contents") + (* INSERT-BRT (CREATEPCNODE + (ADD1 (IDIFFERENCE (OR END + (GETEOFPTR TEXT)) CURFILECH#)) + (QUOTE LASTPIECE)) PCTB) + (* ; "Insert LASTPIECE here") + ] + [(LISTP PCCOUNT) (* ; + "This is an obsolete version of the TEdit file format.") + (SELECTQ (CAR PCCOUNT) + (0 (* ; "VERSION 0") + (SETQ PCTB (TEDIT.BUILD.PCTB0 TEXT TEXTOBJ (CDR PCCOUNT) + START END))) + (1 (* ; + "Version 1; obsoleted at INTERMEZZO release 2/85") + (SETQ PCTB (TEDIT.BUILD.PCTB1 TEXT TEXTOBJ (CDR PCCOUNT) + START END))) + (2 (* ; "Version 2; obsoleted 5/22/85") + (SETQ PCTB (TEDIT.BUILD.PCTB2 TEXT TEXTOBJ (CDR PCCOUNT) + START END))) + (SHOULDNT "File format version incompatible with this version of TEdit.")) + (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] + do (* ; + "Run thru the converted pieces, noting CHARLOOKS and PARALOOKS for the caches.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE + PLOOKS) + of PC) + TEXTOBJ)) + (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) of PC) + TEXTOBJ)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC] + (T (* ; + "This IS a TEdit-format file, so read in all the parts.") + (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) + (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind (OLDPC _ NIL) + (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from 1 + do (SETQ PC NIL) (* ; + "This loop may not really read a piece, so we have to distinguish that case.") + (SETQ PCLEN (\DWIN TEXT)) + (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") + [SELECTC TYPECODE + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ + with (TEDIT.GET.PAGEFRAMES TEXT))) + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorCHARLOOKSLIST (* ; + "This is the list of CHARLOOKSs used in this document.") + (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with ( + \TEDIT.GET.CHARLOOKS.LIST + TEXT)) + (* ; + "Read the list of looks used in this document.") + [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ) + do (SETA LOOKSHASH I LOOKS)) + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + (add I -1)) + (\PieceDescriptorPARALOOKSLIST (* ; + "This is the list of PARALOOKSs used in this document.") + (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with ( + \TEDIT.GET.PARALOOKS.LIST + TEXT TEXTOBJ)) + (* ; + "Read the list of looks used in this document.") + [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) + of TEXTOBJ] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTPARALOOKSLIST) + of TEXTOBJ) + do (SETA PARAHASH I LOOKS)) + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + (add I -1)) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) + (* ; + "Mark the end of the preceding paragraph.") + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) + (* ; + "Get the new set of looks, for use by later pieces.") + (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) + (* ; + "Mark the document as containing paragraph formatting info") + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorLOOKS (* ; + "New character looks. Build a piece to describe those characters.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) + (* ; "Build the new piece") + (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) + (* ; + "Read the character looks for this guy.") + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (add CURFILECH# PCLEN) (* ; + "And note the passing of characters.") + ) + (\PieceDescriptorOBJECT (* ; + "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#) + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + [COND + ((NOT (ZEROP (\BIN TEXT))) (* ; + "There are new character looks for this object. Read them in.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.GET.SINGLE.CHARLOOKS + TEXT))) + (T (* ; + "No new looks; steal them from the prior piece.") + (replace (PIECE PLOOKS) of PC + with (OR (AND OLDPC (fetch (PIECE PLOOKS) of OLDPC)) + DEFAULTLOOKS] + (replace (PIECE PLEN) of PC with 1) + (* ; + "OBJECTs are officially one character long.") + ) + (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." T) + (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) + (\SMALLPIN TEXT] + (COND + (PC (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) + (* ; + "If we created a piece, save it in the table.") + (add CURCH# (fetch (PIECE PLEN) of PC)) + (SETQ OLDPC PC))) finally + + (* ;; "(\\editseta pctb pcn curch#)") + + (* ;; " (\\editseta pctb (add1 pcn) 'lastpiece)") + + (* ;; + "(\\editseta pctb |\\PCTBLastPieceOffset| (add1 pcn)) ") + + (* ;; "(\\editseta pctb |\\PCTBFreePieces| 0)") + (* INSERT-BRT (CREATEPCNODE CURCH# + (QUOTE LASTPIECE)) PCTB) + ] + (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + TEXTOBJ)) (* ; + "And make sure that the default and caret looks are reflected in that list.") + (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + TEXTOBJ)) + (AND DEFAULTLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ)) + (* ; + "And the default looks we used in this function...") + (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) + TEXTOBJ) (* ; + "And make sure the default paralooks are reflected in that list.") + [AND TEXT (bind (CHARLOOKSLIST _ (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) + (PARALOOKSLIST _ (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) + for (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) by (fetch (PIECE NEXTPIECE) of PC) + while [AND PC (NOT (EQ PC 'LASTPIECE] + do (* ; + "Look at every piece, and assure that its CHARLOOKS and PARALOOKS are in the cache.") + [COND + ((FMEMB (fetch (PIECE PLOOKS) of PC) + CHARLOOKSLIST) (* ; + "This piece's CHARLOOKS are known in the cache already. Don't bother doing anything else.") + ) + (T (* ; + "Nope; add these looks to the cache") + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (PIECE PLOOKS) + of PC) + TEXTOBJ] + (COND + ((FMEMB (fetch (PIECE PPARALOOKS) of PC) + PARALOOKSLIST) (* ; + "This piece's PARALOOKS are known in the cache already. Don't bother doing anything else.") + ) + (T (* ; + "Nope; add these looks to the cache") + (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) + of PC) + TEXTOBJ] + (RETURN PCTB]) + +(\TEDIT.CONVERT.FOREIGN.FORMAT + [LAMBDA (CONVERSIONFN FILE PREDICATERESULT TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS) + (* ; "Edited 12-Jun-90 18:16 by mitani") + + (* Perform the conversion from a foreign file format into TEdit-internal form as + an open TextStream.) + + (PROG (TSTREAM TTEXTOBJ SEL WORKINGSTREAM) (* See if there are Bravo headers) + (SETQ WORKINGSTREAM (OPENTEXTSTREAM "")) + (RESETLST + (RESETSAVE (\TEDIT.SET.WINDOW (CONS (TEXTOBJ WORKINGSTREAM) + NIL))) + (SETQ TSTREAM (APPLY* CONVERSIONFN FILE PREDICATERESULT WORKINGSTREAM))) + (COND + (TEXTOBJ + + (* If we're filling in an existing TEXTOBJ, there are fields that need to be + copied.) + + [OR (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) + (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (fetch (TEXTOBJ + TXTPAGEFRAMES) + of (TEXTOBJ TSTREAM] + (* Such as the page formatting, which + the converter may well set.) + )) + (RETURN (fetch (TEXTOBJ PCTB) of (TEXTOBJ TSTREAM]) + +(TEDIT.FORMATTEDFILEP + [LAMBDA (STREAM) (* ; "Edited 19-Apr-93 11:57 by jds") + (* ; + "Test to see if this stream's text would need a TEdit-format file (T) or is just plain text (NIL)") + (PROG ((TEXTOBJ (TEXTOBJ STREAM)) + (FONTFILE 0) + OLDPARALOOKS PC OLDLOOKS PREVPC TENTATIVE) + (SETQ OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) + (SETQ TENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) + (* ; "If edits are to be shown") + (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + 0)) (* ; "First piece in the document") + (COND + ((ATOM PC) (* ; "Empty document") + (RETURN NIL))) + (SETQ OLDLOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + TEDIT.DEFAULT.CHARLOOKS)) + (while PC do [COND + ((fetch (PIECE POBJ) of PC) (* ; + "OBJECTS require the special format") + (SETQ FONTFILE 4)) + ([AND (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; "We just hit a paragraph break.") + (SETQ FONTFILE (IMAX FONTFILE 3))) + ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + (AND TENTATIVE (OR (AND PREVPC (NEQ (fetch (PIECE PNEW) of PREVPC) + (fetch (PIECE PNEW) of PC))) + (AND (NOT PREVPC) + (fetch (PIECE PNEW) of PC)) + (AND PREVPC (NEQ (fetch (PIECE PFATP) of PREVPC) + (fetch (PIECE PFATP) of PC] + (* ; "Change in font, size, etc.") + (SETQ FONTFILE (IMAX FONTFILE 2))) + ((fetch (PIECE PFATP) of PC) (* ; "NS Chars in the piece.") + (SETQ FONTFILE (IMAX FONTFILE 1] + (SETQ PREVPC PC) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + (RETURN (SELECTQ FONTFILE + (0 NIL) + (1 'NSCHARS) + (2 'CHARLOOKS) + (3 'PARALOOKS) + (4 'IMAGEOBJ) + NIL]) + +(TEDIT.GET + [LAMBDA (TEXTOBJ FILE UNFORMATTED?) (* ; "Edited 19-May-2001 11:43 by rmk:") + (* ; "Edited 19-Apr-93 13:12 by jds") + + (* ;; "Get a new file (overwriting the one being edited.)") + + (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) + OFILE OCURSOR LINES USER.CMFILE RESP TITLE FILENAME MENUSTREAM (GETFN (TEXTPROP + TEXTOBJ + 'GETFN)) + (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + (TEDIT.GET.FINISHEDFORMS NIL)) + (COND + ([AND (fetch (TEXTOBJ \DIRTY) of TEXTOBJ) + (PROGN (AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) + (FRESHLINE (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) + (NOT (MOUSECONFIRM "Not saved yet; LEFT go Get anyway." T + (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] + + (* ;; "Only do the GET if he knows he'll zorch himself.") + + (RETURN))) + [SETQ OFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to GET: " + (OR (TEXTPROP TEXTOBJ 'LASTGETFILENAME) + (\TEXTSTREAM.FILENAME TEXTOBJ] + (TEXTPROP TEXTOBJ 'LASTGETFILENAME OFILE) + (COND + [(AND OFILE (OR (OPENP OFILE) + (INFILEP OFILE))) (* ; + "Only if there's a file to load and the file exists.") + (COND + ((AND GETFN (EQ (APPLY* GETFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (FULLNAME OFILE) + 'BEFORE) + 'DON'T)) (* ; + "He doesn't want this document put. Bail out.") + (RETURN))) + (TEXTPROP TEXTOBJ 'LASTGETFILENAME NIL) + (RESETLST + (RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ (fetch (TEXTOBJ PROMPTWINDOW) + of TEXTOBJ) + 'DON'T) + (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) + PROMPTWINDOW))) + (RESETSAVE (CURSOR WAITINGCURSOR)) + (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + NIL NIL) + (\TEXTCLOSEF (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) + (* ; "CLOSE the old files") + [OR (AND (STREAMP FILE) + (OPENP FILE)) + (SETQ OFILE (OPENSTREAM OFILE 'INPUT NIL '((TYPE TEXT] + (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + do (* ; "Remove the previous hardcopyfile") + (WINDOWPROP WINDOW 'HARDCOPYFILE NIL)) + + (* ;; "Open the new one.") + + (SETQ PCTB (replace (TEXTOBJ PCTB) of TEXTOBJ with (TEDIT.BUILD.PCTB + OFILE TEXTOBJ NIL NIL + (fetch (TEXTOBJ + DEFAULTCHARLOOKS) + of TEXTOBJ) + (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ) + UNFORMATTED?))) + (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)) + (* ; + "Do any necessary cleanup for outside packages") + (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) + (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL) + (for FIRSTLINE inside LINES do (replace (LINEDESCRIPTOR NEXTLINE) of FIRSTLINE + with NIL)) + (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) + + (* ;; "The old cached piece is no longer valid--keep people from stepping on it, to prevent lost type-in and smashing other docuemnts to which it has been moved...") + + (* ;; "(replace TEXTLEN of TEXTOBJ with (SUB1 (\EDITELT PCTB (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)))))") + + (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (fetch (BTREENODE TOTLEN) of PCTB)) + (replace (SELECTION CH#) of SEL with (replace (SELECTION CHLIM) of SEL with 1)) + (replace (SELECTION DCH) of SEL with 0) + (replace (SELECTION POINT) of SEL with 'LEFT) + (replace (SELECTION SET) of SEL with T) + (replace (SELECTION SET) of (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) with NIL) + (replace (SELECTION SET) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) with NIL) + (replace (SELECTION SET) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) with NIL) + (replace (SELECTION SET) of TEDIT.SELECTION with NIL) + (replace (SELECTION SET) of TEDIT.SHIFTEDSELECTION with NIL) + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ + SEL)) + (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINE inside LINES + do (* ; + "Fill the edit window (s) with the new text") + (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) + LINE TEXTOBJ NIL WINDOW)) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL NIL T) + (SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* ; "find and set the title") + (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL)) + (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) + (COND + ((AND MENUSTREAM (type? LITATOM TITLE)) (* ; + "if we have a filename then put it in the GET and PUT fields of the menu") + (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE)) + (MBUTTON.SET.FIELD MENUSTREAM 'Get FILENAME) + (MBUTTON.SET.FIELD MENUSTREAM 'Put FILENAME))) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ (\TEDIT.PRIMARYW TEXTOBJ)) + (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT + THACTION _ 'Get))) + (AND GETFN (APPLY* GETFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (FULLNAME (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) + 'AFTER] + (OFILE (TEDIT.PROMPTPRINT TEXTOBJ "[File not found.]") + (TEXTPROP TEXTOBJ 'LASTGETFILENAME OFILE)(* ; + "Remember the file name he tried for, so we offer it next time.") + ) + (T (TEDIT.PROMPTPRINT TEXTOBJ "[Get aborted.]" T]) + +(TEDIT.PARSE.PAGEFRAMES1 + [LAMBDA (PAGELIST PARENT) (* ; "Edited 2-Jan-87 12:21 by jds") + (* Take an external pageframe and + internalize it.) + (PROG (FRAMETYPE PAGEFRAME) + (COND + ((type? PAGEREGION PAGELIST) + (RETURN PAGELIST)) + ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) + [SETQ PAGEFRAME (create PAGEREGION + REGIONFILLMETHOD _ FRAMETYPE + REGIONTYPE _ (pop PAGELIST) + REGIONLOCALINFO _ (pop PAGELIST) + REGIONSPEC _ (for VAL + in (OR (pop PAGELIST) + (LIST 0 0 0 0)) + collect (\TEDIT.SCALE VAL + (CONSTANT (FQUOTIENT 1 35.27778] + (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) + collect (TEDIT.PARSE.PAGEFRAMES1 ALIST + PAGEFRAME))) + (RETURN PAGEFRAME)) + (T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC + NIL]) + +(\ARBIN + [LAMBDA (STREAM) (* jds "13-Nov-86 20:21") + (* ; + "Read an arbitrary object from a file, parse it, and return it.") + (PROG ((LEN (\SMALLPIN STREAM)) + USERSTR) + (COND + ((NOT (ZEROP LEN)) + (SETQ USERSTR (OPENSTRINGSTREAM (\STRINGIN STREAM LEN) + 'INPUT)) + (RETURN (PROG1 (READ USERSTR *TEDIT-FILE-READTABLE*) + (CLOSEF? USERSTR]) + +(\ATMIN + [LAMBDA (STREAM) (* jds " 3-Apr-84 10:41") + (PROG ((LEN (\SMALLPIN STREAM))) + (RETURN (COND + ((ZEROP LEN) + NIL) + (T (PACK (for I from 1 to LEN collect (CHARACTER (\BIN STREAM]) + +(\DWIN + [LAMBDA (FILE) (* jds " 3-JAN-83 16:08") + (IPLUS (LLSH (\BIN FILE) + 24) + (LLSH (\BIN FILE) + 16) + (LLSH (\BIN FILE) + 8) + (\BIN FILE]) + +(\STRINGIN + [LAMBDA (STREAM SETLEN) (* ; "Edited 20-Apr-88 19:54 by jds") + + (* Read a string in length-contents form%: One word for the length, and one byte + per character contained. However, the length may be specified by the caller + instead of being read from the file.) + + (PROG ((LEN (OR SETLEN (\SMALLPIN STREAM))) + STR) + (SETQ STR (ALLOCSTRING LEN)) + [OR (ZEROP LEN) + (for I from 1 to LEN do (RPLCHARCODE STR I (READCCODE STREAM] + (RETURN STR]) + +(\TEDIT.FORMATTEDP1 + [LAMBDA (FILE LEN) (* ; "Edited 12-Feb-88 11:43 by jds") + (* ; + "Checks for a version-1 formatted file") + + (* ;; "Returns NIL if it isn't a formatted file, or the # of pieces needed if it is; leaves file at start of text or of piece descriptions, resp.") + + (SETQ LEN (OR LEN (GETEOFPTR FILE))) + (PROG (DESCPTR NPIECES PASSWORD) + (COND + ((ILEQ LEN 8) (* ; "Too short to be formatted.") + (RETURN NIL)) + (T (SETFILEPTR FILE (IDIFFERENCE LEN 8)) (* ; + "Move to start of FILEPTR to descriptions") + (SETQ DESCPTR (\DWIN FILE)) (* ; + "Read the file pos of the descriptions") + (SETQ NPIECES (\SMALLPIN FILE)) + (SETQ PASSWORD (\SMALLPIN FILE)) + (COND + ((IEQP PASSWORD 31418) (* ; + "Version 3 TEdit format; instituted on 5/22/85") + (SETFILEPTR FILE DESCPTR) + (RETURN NPIECES)) + ((IEQP PASSWORD 31417) + + (* ;; "Version 2 format. Obsoleted 5/22/85 to permit revision of looks in the future without loss of compatibility") + + (SETFILEPTR FILE DESCPTR) + (RETURN (CONS 2 NPIECES))) + ((IEQP PASSWORD 31416) (* ; "VERSION 1 TEDIT FORMAT") + (SETFILEPTR FILE DESCPTR) + (RETURN (CONS 1 NPIECES))) + ((IEQP PASSWORD 31415) (* ; "VERSION 0 TEDIT FORMAT") + (SETFILEPTR FILE DESCPTR) + (RETURN (CONS 0 NPIECES))) + (T (* ; "NOT A FORMATTED FILE") + (SETFILEPTR FILE 0) + (RETURN NIL]) + +(\TEDIT.SET.WINDOW + [LAMBDA (TOWIND) (* ; "Edited 12-Jun-90 18:16 by mitani") + (* USED IN RESETSAVES TO NULL OUT A + TEXTSTREAM'S WINDOW BRIEFLY.) + (PROG1 (CONS (CAR TOWIND) + (fetch (TEXTOBJ \WINDOW) of (CAR TOWIND))) + (replace (TEXTOBJ \WINDOW) of (CAR TOWIND) with (CDR TOWIND)))]) + +(TEDIT.GET.PASSWORD + [LAMBDA (FILE LEN) (* ; "Edited 20-Jun-2022 12:04 by rmk") + + (* ;; "Returns the TEDIT password of FILE, if it is a TEDIT formatted file") + + (LET (DESCPTR NPIECES PASSWORD) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (CL:UNLESS LEN + (SETQ LEN (GETEOFPTR STREAM))) + (CL:WHEN (IGREATERP LEN 8) + (SETFILEPTR STREAM (IDIFFERENCE LEN 8)) (* ; + "Move to start of FILEPTR to descriptions") + (SETQ DESCPTR (\DWIN STREAM)) (* ; + "Read the file pos of the descriptions") + (SETQ NPIECES (\SMALLPIN STREAM)) + [CAR (MEMB (\SMALLPIN STREAM) + '(31415 31416 31417 31418 31419])]) +) + + + +(* ;; "INCLUDEing a file") + +(DEFINEQ + +(TEDIT.INCLUDE + [LAMBDA (STREAM FILE START END SAFE) (* ; "Edited 19-May-2001 11:43 by rmk:") + (* ; + "Edited 1-Jun-93 11:31 by sybalsky:mv:envos") + + (* ;; "Obtain a file name, and include that file's contents at the place where the caret is.") + + (* ;; "Returns T if the insertion happened, NIL if there was no place to put it.") + + (SETQ STREAM (TEXTOBJ STREAM)) + (PROG ((SEL (fetch (TEXTOBJ SEL) of STREAM)) + PCTB TEXTLEN NFILE NNFILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN PCCOUNT NSTREAM + START-OF-PIECE) + (DECLARE (SPECVARS START-OF-PIECE)) + (COND + ((fetch (TEXTOBJ TXTREADONLY) of STREAM) (* ; "This is read-only.") + ) + ((fetch (SELECTION SET) of SEL) (* ; + "There is a place to do the include.") + [SETQ NFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT STREAM + "Name of the file to load: "] + (COND + ((NOT NFILE) (* ; + "If no file was given, don't bother INCLUDEing.") + (TEDIT.PROMPTPRINT STREAM "[Include aborted.]" T) + (RETURN)) + ((STREAMP NFILE)) + ((NOT (INFILEP NFILE)) (* ; + "Can't find the file. Put out a message.") + (TEDIT.PROMPTPRINT STREAM "[File not found.]") + (RETURN))) + (COND + ((NOT SAFE) + + (* ;; "If the caller sets SAFE, we don't need to do any of this copying, because he's guaranteeing that the files'll be there until we don't need 'em any more.") + + [SETQ NFILE (COND + ((OPENP NFILE) + (SETQ WASOPEN T) + NFILE) + (T (* ; + "Wasn't open -- need to open it for input...") + (OPENSTREAM NFILE 'INPUT NIL '((TYPE TEXT] + + (* ;; "Create the holding file") + + (SETQ NNFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT 'NEW)) + + (* ;; "And copy the file-section into it.") + + (* ;; "Have to explicitly fill in 0 and EOFPTR, because if the file was open already, NILs would only copy from current fileptr to EOF.") + + (* ;; + "Use COPYBYTES for formatted files, otherwise allow natural EOL conversion to take place") + + [IF (\TEDIT.FORMATTEDP1 NFILE) + THEN [COPYBYTES NFILE NNFILE (OR START 0) + (OR END (GETFILEINFO NFILE 'LENGTH] + ELSE (COPYCHARS NFILE NNFILE (OR START 0) + (OR END (GETFILEINFO NFILE 'LENGTH] + (OR WASOPEN (CLOSEF NFILE)) (* ; + "If the file didn't come to us open, close it.") + (CLOSEF NNFILE) + (SETQ NFILE NNFILE) + (SETQ START (SETQ END NIL)) (* ; "Then pretend nothing happened.") + )) + (TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* ; "Delete any text, if need be") + (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of STREAM)) + (* ; + "We need the POST-deletion text length for later, so this must come after the b-p-d.") + (\SHOWSEL SEL NIL NIL) (* ; + "Turn off SELs before we go any further") + [SETQ NFILE (TEXTOBJ (SETQ NSTREAM (OPENTEXTSTREAM (OPENSTREAM NFILE 'INPUT) + NIL NIL NIL (LIST 'FONT ( + \TEDIT.GET.INSERT.CHARLOOKS + STREAM SEL) + 'PARALOOKS + (fetch (TEXTOBJ FMTSPEC) + of STREAM] + + (* ;; "Get a textobj to describe the include source file (need NSTREAM so that if we have to convert it to formatted, we won't have lost the textstream--and thus smash the free list.)") + + (COND + ((AND (fetch (TEXTOBJ FORMATTEDP) of NFILE) + (NOT (fetch (TEXTOBJ FORMATTEDP) of STREAM))) + (* ; + "If the includED text is formatted but this file isn't, let's format it!") + (\TEDIT.CONVERT.TO.FORMATTED STREAM)) + ((AND (fetch (TEXTOBJ FORMATTEDP) of STREAM) + (NOT (fetch (TEXTOBJ FORMATTEDP) of NFILE))) + + (* ;; "The TARGET document is formatted, but the INCLUDEd text isn't. Better format it before completing the include.") + + (\TEDIT.CONVERT.TO.FORMATTED NFILE))) + (SETQ PCTB (fetch (TEXTOBJ PCTB) of STREAM)) (* ; + "HERE, because the conversion to formatted will lengthen the pctb") + [SETQ INSERTCH# (COND + ((EQ (fetch (SELECTION POINT) of SEL) + 'LEFT) + (fetch (SELECTION CH#) of SEL)) + (T (fetch (SELECTION CHLIM) of SEL] + (* ; + "Find the place to make the insertion.") + (SETQ INSPC (\CHTOPC INSERTCH# PCTB T)) (* ; + "The piece to make the insertion in") + [COND + ((NEQ INSPC 'LASTPIECE) + (COND + ((IGREATERP INSERTCH# START-OF-PIECE) (* ; "Must split the piece.") + (SETQ INSPC (\SPLITPIECE INSPC INSERTCH# STREAM INSPC#)) + (SETQ PCTB (fetch (TEXTOBJ PCTB) of STREAM)) + (* ; "Refresh the PCTB in case it grew.") + ] + (SETQ PCLST (fetch (TEXTOBJ PCTB) of NFILE)) (* ; + "A temporary pctb, holding the pieces which describe the INCLUDEd text") + (SETQ LEN (fetch (BTREENODE TOTLEN) of PCLST)) + (\TEDIT.INSERT.PIECES STREAM INSERTCH# (SETQ PCLST (\GETBASEPTR (\FIRSTNODE PCLST) + 0)) + LEN INSPC INSPC# NIL) + [COND + ((AND (fetch (TEXTOBJ FORMATTEDP) of STREAM) + (NOT (fetch (TEXTOBJ FORMATTEDP) of NFILE))) + (* ; + "If the includED text is formatted but this file isn't, let's format it!") + (\TEDIT.CONVERT.TO.FORMATTED STREAM INSERTCH# (IPLUS INSERTCH# LEN] + (\TEDIT.HISTORYADD STREAM (create TEDITHISTORYEVENT + THACTION _ 'Include + THCH# _ INSERTCH# + THLEN _ LEN + THFIRSTPIECE _ PCLST)) + (* ; + "Remember that we did this, so it can be undone.") + (replace (TEXTOBJ TEXTLEN) of STREAM with (IPLUS TEXTLEN LEN)) + (* ; + "Inserting the pieces didn't fix up things like the length of the document, so do it now.") + (AND (fetch (TEXTOBJ \WINDOW) of STREAM) + (\FIXILINES STREAM SEL INSERTCH# LEN TEXTLEN)) + (* ; "Mark any changed lines dirty.") + (replace (SELECTION CHLIM) of SEL with (IPLUS (replace (SELECTION CH#) of SEL + with INSERTCH#) + LEN)) + (* ; + "Now fix up the selection to be the included text, point_left, character selection grain.") + (replace (SELECTION DCH) of SEL with LEN) + (replace (SELECTION DX) of SEL with 0) + (replace (SELECTION POINT) of SEL with 'RIGHT) (* ; + "So that several things INCLUDED in sequence fall in sequence.") + (replace (SELECTION SELKIND) of SEL with 'CHAR) + (replace (SELECTION SELOBJ) of SEL with NIL) + (COND + ((fetch (TEXTOBJ \WINDOW) of STREAM) (* ; + "We're displaying; update the display and the selection's line references") + (TEDIT.UPDATE.SCREEN STREAM) + (\FIXSEL SEL STREAM) + (\SHOWSEL SEL NIL T))) + (replace (TEXTOBJ \DIRTY) of STREAM with T) (* ; "Mark the document changed") + (\SETUPGETCH (IPLUS -1 INSERTCH# LEN) + STREAM) (* ; + "Set the fileptr to the end of the insertion.") + T) + (T (TEDIT.PROMPTPRINT STREAM "Please choose the place for the INCLUDE first." T]) + +(TEDIT.RAW.INCLUDE + [LAMBDA (STREAM INFILE START END) (* ; "Edited 11-Jun-99 15:05 by rmk:") + (* ; "Edited 11-Jun-99 15:05 by rmk:") + (* ; "Edited 11-Jun-99 14:49 by rmk:") + (* ; "Edited 11-Jun-99 14:41 by rmk:") + (* ; + "Edited 27-May-93 16:36 by sybalsky:mv:envos") + + (* ;; "takes a text stream and an OPEN stream to include. Note: Start and End are inclusive ptrs, unlike in copybytes and friends") + + (* ;; + "no interpretation (alternate file type e.g. Bravo) takes place. Simply include the characters") + + (* ;; "Default character and paragraph looks are applied") + + (LET* ((TEXTOBJ (TEXTOBJ STREAM)) + (START START) + (END END) + (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + [HOLDING.FILE (OR (fetch (TEXTOBJ TXTRAWINCLUDESTREAM) of TEXTOBJ) + (replace (TEXTOBJ TXTRAWINCLUDESTREAM) of TEXTOBJ + with (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + PCTB TEXTLEN INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN HOLDSTART HOLDLEN START-OF-PIECE + ) + (COND + ((NOT (fetch (SELECTION SET) of SEL)) + (SHOULDNT "\TEDIT.RAW.INCLUDE called with no selection set")) + ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (* ; "Not allowed to change it.") + NIL) + (T (* ; + "There is a place to do the include.") + (\SHOWSEL SEL NIL NIL) (* ; + "Turn any pre-existing selection off") + (COND + (END + (* ;; "This is the copy-part-of-a-file case, with file liable to be volatile. Copy it to core for protection") + + [SETQ INFILE (COND + ((OPENP INFILE) + (SETQ WASOPEN T) + INFILE) + (T (OPENSTREAM INFILE 'INPUT NIL '((TYPE TEXT] + (* ; + "And copy the file-section into it.") + (SETFILEPTR HOLDING.FILE (SETQ HOLDSTART (GETEOFPTR HOLDING.FILE))) + (* ; + "Move to the end of the pre-existing part of the file.") + (COPYBYTES INFILE HOLDING.FILE START END) + (* ; + "must be copychars to respect eol conventions") + (SETQ HOLDLEN (IDIFFERENCE (OR END (GETEOFPTR INFILE)) + START)) + (COND + ((NOT WASOPEN) (* ; + "Close the input file if it wasn't open when we got here.") + (CLOSEF INFILE))) + (SETQ INFILE HOLDING.FILE) + (SETQ START (SETQ END NIL)) (* ; "Then pretend nothing happened.") + )) + (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + (SETQ INSERTCH# (TEDIT.GETPOINT NIL SEL)) (* ; + "Find the place to make the insertion.") + (SETQ INSPC (OR (\CHTOPC INSERTCH# PCTB T) + (LASTPIECE PCTB))) (* ; + "The piece to make the insertion in") + [COND + ((NEQ INSPC 'LASTPIECE) + (COND + ((IGREATERP INSERTCH# START-OF-PIECE) (* ; "Must split the piece.") + (SETQ INSPC (\SPLITPIECE INSPC (- INSERTCH# START-OF-PIECE) + TEXTOBJ INSPC#)) + (add INSPC# 1) + (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + (* ; "Refresh the PCTB in case it grew.") + ] + (SETQ PCLST (create PIECE + PFILE _ INFILE + PFPOS _ (OR HOLDSTART START 0) + PLEN _ + [OR HOLDLEN (IDIFFERENCE + [COND + (END END) + (T (* ; "get the eof pointer") + (COND + ((OPENP INFILE) + (GETEOFPTR INFILE)) + (T [OPENSTREAM INFILE 'INPUT NIL + '((TYPE TEXT] + (PROG1 (GETEOFPTR INFILE) + (CLOSEF INFILE] + (COND + (START START) + (T 0] + PREVPIECE _ NIL + NEXTPIECE _ NIL + PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT + DEFAULTFONT) + TEXTOBJ) + PPARALAST _ NIL + PPARALOOKS _ (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC))) + (SETQ LEN (fetch (PIECE PLEN) of PCLST)) + (\TEDIT.INSERT.PIECES TEXTOBJ INSERTCH# PCLST LEN INSPC INSPC# NIL) + (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS TEXTLEN LEN)) + (AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + (\FIXILINES TEXTOBJ SEL INSERTCH# LEN TEXTLEN)) + (replace (SELECTION CHLIM) of SEL with (IPLUS (replace (SELECTION CH#) of SEL + with INSERTCH#) + LEN)) + (* ; + "Now fix up the selection to be the included text, point_left, character selection grain.") + (replace (SELECTION DCH) of SEL with LEN) + (replace (SELECTION DX) of SEL with 0) + (replace (SELECTION POINT) of SEL with 'RIGHT) + (* ; + "So that several things INCLUDED in sequence fall in sequence.") + (replace (SELECTION SELKIND) of SEL with 'CHAR) + (replace (SELECTION SELOBJ) of SEL with NIL) + (COND + ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + (TEDIT.UPDATE.SCREEN TEXTOBJ) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL NIL T))) + (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "Mark the document changed") + (\SETUPGETCH (create EDITMARK + PC _ INSPC + PCOFF _ 0 + PCNO _ NIL) + TEXTOBJ) (* ; + "Set the fileptr to the end of the insertion.") + T]) +) + + + +(* ;; "PUTting a file:") + +(DEFINEQ + +(TEDIT.PUT + [LAMBDA (STREAM FILE FORCENEW UNFORMATTED? OLDFORMAT?) (* ; "Edited 21-Jun-99 19:02 by rmk:") + (* ; "Edited 21-Jun-99 18:58 by rmk:") + (* ; "Edited 11-Jun-99 15:05 by rmk:") + (* ; "Edited 19-Apr-93 13:04 by jds") + + (* ;; "If the guy was editing a file, make a new updated version; else, ask for a file name") + + (* ;; "If FILE is specd, it's used; else the user must give us one") + + (* ;; "Returns an open stream on the file you PUT to.") + + (PROG ((TEXTOBJ (TEXTOBJ STREAM)) + (TEDIT.PUT.FINISHEDFORMS NIL) + (TEDIT.GET.FINISHEDFORMS NIL) + (OUTPUT.FILE.WRITTEN NIL) + OCURSOR OFILE FONTFILEUSED PROPS WINDOW PUTFN CACHE MENUSTREAM FILENAME TITLE CH#S PC) + [COND + (FILE (* ; "We were given a file to use.") + (SETQ OFILE FILE)) + [FORCENEW (* ; + "He insists on a new file. (without giving us one NIL)") + (SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: "] + (T (* ; "Get a file to put the text into") + (SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: " + (\TEXTSTREAM.FILENAME TEXTOBJ] + (SETQ PUTFN (TEXTPROP TEXTOBJ 'PUTFN)) + (SETQ CACHE (TEXTPROP TEXTOBJ 'CACHE)) + (COND + ((NOT OFILE) (* ; + "There's no file to put to; don't bother.") + (RETURN)) + ((AND PUTFN (EQ (APPLY* PUTFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (FULLNAME OFILE) + 'BEFORE) + 'DON'T)) (* ; + "He doesn't want this document put. Bail out.") + (RETURN))) + (RESETLST + [RESETSAVE [SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW + (COND + [UNFORMATTED? (* ; + "If the user forced no formatting, respect his wish.") + '((TYPE TEXT] + [(TEDIT.FORMATTEDFILEP TEXTOBJ) + (* ; + "If this file has objects, para looks, or font changes, then we need a binary file.") + '((TYPE BINARY] + [(AND NIL (EQL (U-CASE (FILENAMEFIELD OFILE + 'EXTENSION)) + 'TEDIT)) + (* ; "If file extension is TEDIT, then we presume that it really is a tedit file, thus making it a binary file. BUT: rmk we really prefer TYPE TEXT even for a file with extension tedit.") + '((TYPE BINARY] + (T (* ; + "Otherwise, we can get by with a text file") + '((TYPE TEXT] + '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] + [RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS) + 'DON'T] + (replace DESC of (fetch (TEXTOBJ THISLINE) of TEXTOBJ) with NIL) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "PUTting file " (fetch (STREAM FULLNAME) + of OFILE) + "...") + T) + [COND + ((IGREATERP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + 0) + (SETQ FONTFILEUSED (COND + (OLDFORMAT? (TEDIT.PUT.PCTB2 TEXTOBJ OFILE UNFORMATTED?)) + (T (TEDIT.PUT.PCTB TEXTOBJ OFILE UNFORMATTED?] + (CLOSEF OFILE) (* ; + "Close the file, to free it up. And re-open it for INPUT only") + [COND + ((NOT CACHE) (* ; + "CSLI if caching do not need to reopen the output file anyway") + + (* ;; "Declare as type text, even if it hasn't been specified as a binary file--could simply be an unformatted stream.") + + (SETQ OFILE (OPENSTREAM (fetch (STREAM FULLFILENAME) of OFILE) + 'INPUT NIL '((TYPE TEXT](* ; + "changed TEMPORary for ns filing with caching. may not work in general") + (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (* ; "Close the old text file") + (replace (TEXTOBJ TXTFILE) of TEXTOBJ with OFILE) + (* ; + "And remember the new one for next time.") + (* ; + "We can safely QUIT now without losing anything.") + (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL)) + (SETQ CH#S (REVERSE (CDR FONTFILEUSED))) (* ; + "The true filepos's of the pieces in the output file.") + [COND + ((AND (NOT CACHE) + (RANDACCESSP OFILE) + (EQ CR.EOLC (fetch (STREAM EOLCONVENTION) of OFILE))) + + (* ;; "If we've cached this file, DON'T go thru and fill in the real file's location, because the EOL convention may well be wrong.") + + (* ;; "(SETQ PC (ELT (fetch PCTB of TEXTOBJ) (ADD1 \FirstPieceOffset)))") + + (UNINTERRUPTABLY + (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + 0)) + (while (AND PC CH#S) do + (* ;; + "Run thru the pieces in the PCTB, pointing them to the new file and their new locations.") + + (COND + ((fetch (PIECE POBJ) of PC)) + (T (replace (PIECE PFPOS) of PC with (pop CH#S)) + (CLOSEF? (fetch (PIECE PFILE) of PC)) + (* ; + "If this is a piece on an open file, close it, since we're never going to read from it again.") + (replace (PIECE PFILE) of PC with OFILE) + (replace (PIECE PSTR) of PC with NIL))) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))))] + (TEDIT.PROMPTPRINT TEXTOBJ "done.") (* ; "Tell him we're finished.") + (SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* ; "find and set the title") + (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL)) + (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) + (COND + ((AND MENUSTREAM (type? LITATOM TITLE)) (* ; + "if we have a filename then put it in the GET and PUT fields of the menu") + (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE)) + (MBUTTON.SET.FIELD MENUSTREAM 'Get FILENAME) + (MBUTTON.SET.FIELD MENUSTREAM 'Put FILENAME))) + (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) + (* ; "Make sure any new insertions happen for real, and not as appends. Since all the pieces now point to the file rather than the strings.") + (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with NIL) + + (* ;; "make sure that TEDIT doesn't try to just add to the \INSERTPC since it will now have a pfile property") + + (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT + THACTION _ 'Put + THCH# _ 0 + THLEN _ 0 + THFIRSTPIECE _ NIL)) + (* ; "Remember we did this.") + (AND PUTFN (APPLY* PUTFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) + 'AFTER)) (* ; + "CSLI changed to not presume ofile is the txtfile anymore") + (RETURN OFILE]) + +(TEDIT.PUT.PCTB + [LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 30-Apr-2021 14:46 by rmk:") + (* ; "Edited 19-May-99 21:58 by rmk:") + (* ; + "Edited 27-May-93 16:00 by sybalsky:mv:envos") + + (* ;; "Put a representation of the piece table onto OFILE, preserving font changes and paragraph looks. UNFORMATTED? means write no font or formatting info.") + + (PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + (*READTABLE* *TEDIT-FILE-READTABLE*) + (*PRINT-BASE* 10) + OLDCH# CURCH# PREVPC FONTFILE (PCCOUNT 0) + TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL) + (EDITSTENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) + (PARALOOKSSEEN NIL) + (FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ)) + (CACHE (TEXTPROP TEXTOBJ 'CACHE)) + CH#S PREVFATP PARAHASH LOOKSHASH PREVPREVPC) + (replace (STREAM LINELENGTH) of OFILE with MAX.SMALLP) + (* ; + "Prevent spurious carriage-returns in the piece descriptions.") + + (* ;; "(SETQ PC (\EDITELT (fetch PCTB of TEXTOBJ) (ADD1 \FirstPieceOffset)))") + + (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + 0)) (* ; "First piece in the document") + (SETQ OLDLOOKS (OR (AND (type? PIECE PC) + (fetch (PIECE PLOOKS) of PC)) + (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks") + + (* ;; "RMK: CHANGED DEFAULT FROM CR TO LF") + + (COND + ((NEQ (fetch (STREAM EOLCONVENTION) of OFILE) + LF.EOLC) (* ; + "This file is on a non-LF host; make a note to cache it") + (SETQ TRUEFILE OFILE) (* ; + "Remember where the file should wind up.") + [SETQ OFILE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (* ; + "And open a temp file to write it to.") + (replace (STREAM LINELENGTH) of OFILE with MAX.SMALLP) + (* ; + "Prevent spurious carriage-returns in the piece descriptions.") + )) + [SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE] + (COND + ((fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) (* ; + "There is layout info for this file. Save it") + (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) + (* ; + "Open a font-info file if one is needed.") + (TEDIT.PUT.PAGEFRAMES FONTFILE (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ)) + (add PCCOUNT 1))) + (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* ; + "Run thru the lists of char & para looks and remove any that aren't in use") + (COND + ([AND (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) + (OR (IGREATERP (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) + 1) + (NOT (EQFMTSPEC (CAR (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) + TEDIT.DEFAULT.FMTSPEC] + + (* ;; "There are paragraph looks in this document that don't match the default -- save the list of them for later retrieval.") + + (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) + (* ; + "Open a font-info file if one is needed.") + (SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST FONTFILE (fetch (TEXTOBJ TXTPARALOOKSLIST) + of TEXTOBJ))) + (SETQ PARALOOKSSEEN T))) + [COND + ((OR PARALOOKSSEEN FORMATTINGLEVEL) + + (* ;; "There are character looks in this document that don't match the default (or paragraph formatting, which forces looks to be saved) -- save the list for later retrieval.") + + (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) + (* ; + "Open a font-info file if one is needed.") + (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + [while PC + do (COND + ([AND (NOT (ZEROP (fetch (PIECE PLEN) of PC))) + (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; + "The last piece ended a paragraph, so send out new para looks") + (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) + (* ; + "Open a font-info file if one is needed.") + (COND + ((NEQ CURCH# OLDCH#) (* ; + "There were prior characters that hadn't been described in a piece yet. Describe them") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE + LOOKSHASH PREVFATP) + (add PCCOUNT 1) + (SETQ OLDCH# CURCH#) (* ; + "And now we've described all the characters up to the current one.") + )) + (\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH) + (SETQ PARALOOKSSEEN T) (* ; + "Remember that we've seen a foreign paralooks, and must henceforth note para boundaries") + (add PCCOUNT 1))) + (COND + [(fetch (PIECE POBJ) of PC) (* ; + "It's an object -- go use its PUTFN") + (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) + (* ; + "Open a font-info file if one is needed.") + (COND + ((AND (NEQ CURCH# OLDCH#) + PREVPC) (* ; + "There were prior characters that hadn't been described in a piece yet. Describe them") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE + LOOKSHASH PREVFATP) + (add PCCOUNT 1) + (SETQ OLDCH# CURCH#) (* ; + "And now we've described all the characters up to the current one.") + )) (* ; + "If the prior thing was text, send along its descriptor.") + (* ; "Send out the object") + (IF UNFORMATTED? + THEN (CL:WHEN (AND PREVPC (fetch (PIECE PFATP) of PREVPC)) + + (* ;; "Last piece was FAT, but object doesn't know that. Start it out thin. The stream must also be thin after the PRIN1 of the object's preprint string. Setting PREVPC to NIL means that no comparisons will be done (which asserts THIN among other things), but that's OK because we aren't doing formatting anyway.") + + (BOUT OFILE 255) + (BOUT OFILE 0) + (add CURCH# 2) + (SETQ PREVPC NIL)) + (LET [(FN (IMAGEOBJPROP (fetch (PIECE POBJ) of PC) + 'PREPRINTFN] + (PRIN1 (IF FN + THEN (PROG1 (APPLY* FN (fetch (PIECE POBJ) of PC)) + + (* ;; "Insure thin") + + (CHARSET OFILE 0)) + ELSE "[UNPRINTABLE OBJECT]") + OFILE) + (add CURCH# 1 (IDIFFERENCE (GETEOFPTR OFILE) + CURCH#))) + ELSE (add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#))) + (add PCCOUNT 1) + (SETQ OLDCH# CURCH#) + (COND + ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + (NEQ (fetch (PIECE PFATP) of PC) + (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) + [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) + (AND PREVPC (fetch (PIECE PNEW) of PREVPC] + (AND (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; + "The OBJECT has different ooks from before") + (\BOUT FONTFILE 1) + (\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch (PIECE PLOOKS) of PC)) + (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + (T (* ; + "No differences. Don't write any charlooks, and mark that fact") + (\BOUT FONTFILE 0) (* ; + "MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS GETS ITS OWN LOOKS") + ] + ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) (* ; "It's not an object.") + + (* ;; "For 0-length pieces, don't even acknowledge their existence!!") + + (* ;; "So only do this processing if there's text in the piece.") + + [COND + ([OR [NEQ (fetch (PIECE PFATP) of PC) + (SETQ PREVFATP (AND PREVPC (fetch (PIECE PFATP) of PREVPC] + (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) + (AND PREVPC (fetch (PIECE PNEW) of PREVPC] + (AND (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; "We have a piece with new looks.") + (* ; + "The PREVFATP clause needs to come first, so that PREVFATP gets set for later use.") + (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) + (* ; + "Open a font-info file if one is needed.") + (COND + ((NOT (IEQP OLDCH# CURCH#)) (* ; + "If there were looks past, and if the run was not empty, save a piece for its looks") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST + FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC + EDITSTENTATIVE LOOKSHASH PREVFATP) + (add PCCOUNT 1))) + (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC)) + (SETQ OLDCH# CURCH#) + (COND + [PREVFATP (COND + ((fetch (PIECE PFATP) of PC)) + (T (* ; "Switching from FAT to thin") + (BOUT OFILE 255) + (BOUT OFILE 0) + (add CURCH# 2] + ((fetch (PIECE PFATP) of PC) (* ; "Switching from thin to fat") + (BOUT OFILE 255) + (BOUT OFILE 255) + (BOUT OFILE 0) + (add CURCH# 3] (* ; + "Now dump out the non-object contents of the piece.") + [COND + [(SETQ PFILE (fetch (PIECE PFILE) of PC)) + (* ; "It's on a file. Copy it.") + [OR (OPENP PFILE) + (replace (PIECE PFILE) of PC with (SETQ PFILE (\TEDIT.REOPEN.STREAM + TEXTOBJ PFILE] + (* ; "Make sure the file is open.") + (COPYBYTES PFILE OFILE (fetch (PIECE PFPOS) of PC) + (IPLUS (fetch (PIECE PFPOS) of PC) + (COND + ((fetch (PIECE PFATP) of PC) + (* ; + "For fat file pieces, copy twice as many bytes as characters.") + (UNFOLD (fetch (PIECE PLEN) of PC) + 2)) + (T (fetch (PIECE PLEN) of PC] + ((SETQ PSTR (fetch (PIECE PSTR) of PC)) + (* ; "It's in a string. Just print it.") + + (* ;; + "RMK: BOUT ptimizations would miss external formats and EOL conventions") + + (for I from 1 to (fetch (PIECE PLEN) of PC) as CH instring PSTR + do (\OUTCHAR OFILE CH)) (* (COND ((fetch (PIECE PFATP) of PC) + (* ; + "The string is fat: Copy twice as many bytes as chars.") + (for I from 1 to (fetch + (PIECE PLEN) of PC) as CH instring + PSTR do (\BOUT OFILE + (\CHARSET CH)) (\BOUT OFILE + (\CHAR8CODE CH)))) (T + (* ; + "The string is thin. Just copy it to the file.") + (for I from 1 to (fetch + (PIECE PLEN) of PC) as CH instring + PSTR do (\BOUT OFILE CH))))) + ] + [COND + ((AND (NOT CACHE) + (RANDACCESSP OFILE)) (* ; + "CSLI leave the pieces and the pctb alone and just write the file if its cached or not randomaccess") + (push CH#S (SUB1 CURCH#] + [COND + ((fetch (PIECE PFATP) of PC) + (add CURCH# (UNFOLD (fetch (PIECE PLEN) of PC) + 2))) + (T (add CURCH# (fetch (PIECE PLEN) of PC] + (* ; + "Keep running track of where in the file we are.") + )) + (COND + ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) + + (* ;; "Only remember this piece if it's not zero-length!") + + (SETQ PREVPREVPC PREVPC) + (SETQ PREVPC PC))) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + finally (* ; + "Put out a piece describing the last characters in the file.") + (COND + ((AND FONTFILE (NEQ OLDCH# CURCH#)) (* ; + "Only if there WERE characters, and only if there's a need for font information") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE + LOOKSHASH PREVPREVPC) (* ; + "Put out a description of the characters") + (add PCCOUNT 1))) + (COND + ((AND PARALOOKSSEEN (fetch (PIECE PPARALAST) of PREVPC)) + (* ; + "The last piece contained the end of a paragraph. Make sure it gets noted.") + (\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH) + + (* ;; "Write out a dummy paragraph-looks piece, so that we protect the PPARALAST of the final piece in the document.") + + (\DWOUT FONTFILE 0) + (\SMALLPOUT FONTFILE \PieceDescriptorPARA) + (\SMALLPOUT FONTFILE 1) + + (* ;; "This adds a total of 2 pieces to the file:") + + (add PCCOUNT 2] + (for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM)) + (* ; "Do any user-specific cleanup") + (COND + (TRUEFILE (* ; + "This file needs to be converted to the right convention") + (COND + ((AND FONTFILE (NOT UNFORMATTED?) + (NOT SEPARATEFORMAT)) (* ; + "Formatted file: Copy without converting.") + (COPYBYTES OFILE TRUEFILE 0 -1)) + (T (* ; + "Go ahead and convert the EOLCONVENTION, this is a plain-text file") + (COPYCHARS OFILE TRUEFILE 0 -1))) + (SETQ OFILE TRUEFILE))) + [COND + ((AND (OPENP OFILE) + FONTFILE) (* ; "We need to write format info.") + (\DWOUT FONTFILE (GETFILEPTR OFILE)) (* ; + "So remember the end of the plain-text part of the file") + (\SMALLPOUT FONTFILE PCCOUNT) (* ; + "# OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE") + (\SMALLPOUT FONTFILE 31418) (* ; + "Now the password for NEW format files: 31416") + (COND + ((AND (NOT UNFORMATTED?) + (NOT SEPARATEFORMAT)) + + (* ;; "Only write fmtg info at the end if we want it there--not if we want plain text or want it kept separate.") + + (COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE)) + (* ; + "Copy the font information to the file trailer") + ) + (T)) + (CLOSEF FONTFILE) + (COND + ((NOT SEPARATEFORMAT) (* ; + "Unless we want the formatting info separately, delete the file") + (* ; + "(since FONTFILE is a stream, we should not need to delete it at all) (DELFILE FONTFILE)") + ] + (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (TEXTOBJ DEFAULTCHARLOOKS) + of TEXTOBJ) + TEXTOBJ)) + (* ; + "Re-add the default and caret looks's to the lists, since they may not have been really saved.") + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + TEXTOBJ)) + (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ + FMTSPEC) + of TEXTOBJ) + TEXTOBJ)) + (RETURN (CONS (COND + (UNFORMATTED? NIL) + (T FONTFILE)) + CH#S]) + +(\TEDIT.PUTRESET + [LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38") + (CONS (CAR PROC&VALUE) + (PROCESSPROP (CAR PROC&VALUE) + 'BEFOREEXIT + (CDR PROC&VALUE]) + +(TEDIT.PUT.PIECE.DESCRIPTOR + [LAMBDA (FILE CH1 CHLIM LOOKS) (* ; "Edited 30-May-91 20:25 by jds") + (* Put a description of LOOKS into + FILE. LOOKS apply to characters CH1 + thru CHLIM-1) + (* (PROG ((FONT (fetch + (CHARLOOKS CLFONT) of LOOKS)) STR) + (SETQ STR (CONCAT "(FONTCREATE " + (KWOTE (FONTPROP FONT + (QUOTE FAMILY))) " " + (FONTPROP FONT (QUOTE SIZE)) " " + (KWOTE (FONTPROP FONT + (QUOTE FACE))) " )")) + (\DWOUT FILE (IDIFFERENCE CHLIM CH1)) + (* The length of this run of looks) + (\SMALLPOUT FILE (NCHARS STR)) + (* The length of the description which + follows) (PRIN1 STR FILE) + (* Print the form which can EVAL to + re-create the font information) + (\BOUT FILE (LOGOR (COND + ((fetch (CHARLOOKS CLPROTECTED) of + LOOKS) 8) (T 0)) (COND + ((fetch (CHARLOOKS CLINVISIBLE) of + LOOKS) NIL 4) (T 0)) + (COND ((fetch (CHARLOOKS CLSELHERE) of + LOOKS) 2) (T 0)) (COND + ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) + 1) (T 0)))))) + (HELP]) + +(\ARBOUT + [LAMBDA (STREAM ITEM) (* ; "Edited 20-Apr-88 19:55 by jds") + (* ; + "Write an arbitrary MKSTRING-able thing in length-contents form.") + (LET ((SIZE (AND ITEM (NCHARS ITEM T *TEDIT-FILE-READTABLE*))) + (FPTR) + (END-FPTR)) + (\SMALLPOUT STREAM (OR SIZE 0)) + (SETQ FPTR (GETFILEPTR STREAM)) + (OR (NOT ITEM) + (ZEROP SIZE) + (PRIN2 ITEM STREAM *TEDIT-FILE-READTABLE*)) + + (* ;; "Because of NS chars, you gotta back up and really count bytes.") + (* (SETQ END-FPTR (GETFILEPTR STREAM)) + (SETFILEPTR STREAM FPTR) + (\SMALLPOUT STREAM (- + END-FPTR FPTR)) (SETFILEPTR STREAM + END-FPTR)) + NIL]) + +(\ATMOUT + [LAMBDA (STREAM ATOM) (* jds "30-Jan-85 14:46") + (* Write an atom's characters in + length-contents form.) + (\SMALLPOUT STREAM (COND + (ATOM (NCHARS ATOM)) + (T 0))) + (OR (NOT ATOM) + (ZEROP (NCHARS ATOM)) + (for CH inatom ATOM do (\BOUT STREAM CH]) + +(\DWOUT + [LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30") + (\BOUT FILE (LOGAND 255 (LRSH NUMBER 24))) + (\BOUT FILE (LOGAND 255 (LRSH NUMBER 16))) + (\BOUT FILE (LOGAND 255 (LRSH NUMBER 8))) + (\BOUT FILE (LOGAND 255 NUMBER]) + +(\STRINGOUT + [LAMBDA (STREAM STRING LEN) (* jds " 1-May-84 11:58") + + (* Write a string on a file in length-contents form; + one word for the length, and one byte per character contained.) + + (SETQ LEN (OR LEN (NCHARS STRING))) + (\SMALLPOUT STREAM LEN) + (OR (ZEROP LEN) + (for CH instring STRING as I from 1 to LEN do (\BOUT STREAM CH]) + +(\TEDIT-OPEN-FONT-FILE + [LAMBDA (EXISTING-FONTFILE-IF-ANY) (* ; "Edited 23-Sep-87 12:31 by jds") + + (* ;; " Open a font-information file for TEDIT PUT operation, if one doesn't exist already. Also set its linelength to effective infinity, so that we don't get spurious CRs in the middle of formatting info.") + + (* ;; "The calling form must be (SETQ FOO (\TEDIT-OPEN-FONT-FILE FOO)), to preserve information.") + + (COND + ((NOT EXISTING-FONTFILE-IF-ANY) (* ; + "Create the font-info file if it doesn't exist yet") + (SETQ EXISTING-FONTFILE-IF-ANY (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) + (replace (STREAM LINELENGTH) of EXISTING-FONTFILE-IF-ANY with MAX.SMALLP) + (* ; + "Prevent spurious carriage-returns in the piece descriptions.") + )) + EXISTING-FONTFILE-IF-ANY]) +) +(DEFINEQ + +(\TEDIT.GET.CHARLOOKS.LIST + [LAMBDA (FILE) (* jds "28-Jan-85 17:50") + (* Read the list of CHARLOOKSs from + the file.) + (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE]) + +(\TEDIT.GET.SINGLE.CHARLOOKS + [LAMBDA (FILE) (* ; "Edited 20-Feb-2022 12:42 by larry") + (* ; "Edited 30-May-91 20:25 by jds") + (* Read a set of CHARLOOKS from FILE) + (PROG* ((LOOKS (create CHARLOOKS)) + (FILEPOS (GETFILEPTR FILE)) + (LOOKSLEN (\SMALLPIN FILE)) + FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) + (SETQ NAME (\ARBIN FILE)) (* The font name) + (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) + (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) + (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) + 0)) + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) + (SETQ PROPS (\SMALLPIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] + [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] + [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + [replace (CHARLOOKS CLFONT) of LOOKS with (COND + ((LISTP NAME) + (* This was a font class. + Restore it.) + (FONTCLASS (pop NAME) + NAME)) + ((AND NAME (NOT (ZEROP SIZE))) + (FONTCREATE NAME SIZE + (COND + ((AND (fetch (CHARLOOKS CLBOLD) + of LOOKS) + (fetch (CHARLOOKS CLITAL) + of LOOKS)) + 'BOLDITALIC) + ((fetch (CHARLOOKS CLBOLD) + of LOOKS) + 'BOLD) + ((fetch (CHARLOOKS CLITAL) + of LOOKS) + 'ITALIC)) + NIL NIL T NIL] + (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)) + (RETURN LOOKS]) + +(\TEDIT.PUT.CHARLOOKS.LIST + [LAMBDA (FILE LOOKSLIST) (* jds " 5-Mar-85 15:58") + (* Write the list of CHARLOOKSs into + the font file.) + + (* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' + position in the list we wrote on the file. + Those position numbers are then written in the individual looks descriptions, and + are used to reconstruct the piece looks when the file is read back in.) + + (PROG ((LOOKSHASH (HASHARRAY 50))) + (\DWOUT FILE 0) (* No characters are described by this + pseudo-piece entry.) + (\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of + CHARLOOKSs) + (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in + the list) + (for I from 1 as LOOKS in LOOKSLIST do (* Write each charlooks, in the order + they appear in the list.) + (\TEDIT.PUT.SINGLE.CHARLOOKS FILE LOOKS) + (* Write out the description) + (PUTHASH LOOKS I LOOKSHASH) + (* And save it in the hash table so + people can find its index.)) + (RETURN LOOKSHASH]) + +(\TEDIT.PUT.SINGLE.CHARLOOKS + [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:26 by jds") + (* Put out a single CHARLOOKS + description.) + (PROG ((FILEPOS (GETFILEPTR FILE)) + (FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) + STR LEN) + (\SMALLPOUT FILE 0) (* Reserve space for the length of + this looks) + [COND + ((type? FONTCLASS FONT) (* For font classes, we need to save a + list of device-FD sets) + (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) + (T (* For FONTDESCRIPTORs, do it the easy + way) + (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* The font family) + (\SMALLPOUT FILE (OR (FONTPROP FONT 'SIZE) + 0)) (* Size of the type, in points) + (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0)) (* Super/subscripting distance) + (COND + ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) + (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] + (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) + (T (\SMALLPOUT FILE 0))) + (COND + ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) + (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) + (T (\SMALLPOUT FILE 0))) + [\SMALLPOUT FILE (LOGOR (COND + ((fetch (CHARLOOKS CLLEADER) of LOOKS) + (* Dotted-leader; relevant only to + TABs) + 2048) + (T 0)) + (COND + ((fetch (CHARLOOKS CLINVERTED) of LOOKS) + (* Inverse-video) + 1024) + (T 0)) + (COND + ((fetch (CHARLOOKS CLBOLD) of LOOKS) + 512) + (T 0)) + (COND + ((fetch (CHARLOOKS CLITAL) of LOOKS) + 256) + (T 0)) + (COND + ((fetch (CHARLOOKS CLULINE) of LOOKS) + 128) + (T 0)) + (COND + ((fetch (CHARLOOKS CLOLINE) of LOOKS) + 64) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) + 32) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) + 16) + (T 0)) + (COND + ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) + 8) + (T 0)) + (COND + ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) + NIL 4) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSELHERE) of LOOKS) + 2) + (T 0)) + (COND + ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) + 1) + (T 0] + + (* * Now go fill in the length field at the front of the LOOKS. + (ALL looks info should be written out BEFORE this comment.)) + + (SETQ LEN (IDIFFERENCE (GETFILEPTR FILE) + FILEPOS)) (* The length of this set of looks) + (SETFILEPTR FILE FILEPOS) (* Go write the length field) + (\SMALLPOUT FILE LEN) + (SETFILEPTR FILE -1) (* And back to the end of the file) + ]) +) +(DEFINEQ + +(\TEDIT.GET.PARALOOKS.LIST + [LAMBDA (FILE TEXTOBJ) (* jds "13-Jun-85 11:14") + (* Read the list of CHARLOOKSs from + the file.) + (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ]) + +(\TEDIT.GET.SINGLE.PARALOOKS + [LAMBDA (FILE TEXTOBJ) (* ; + "Edited 2-Jul-93 21:31 by sybalskY:MV:ENVOS") + (* ; + "Read a paragraph format spec from the FILE, and return it for later use.") + (PROG ((LOOKS (create FMTSPEC)) + (FILEPOS (GETFILEPTR FILE)) + (LOOKSLEN (\SMALLPIN FILE)) + TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC TABTYPE QUAD) + (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* ; + "Left margin for the first line of the paragraph") + (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* ; + "Left margin for the rest of the paragraph") + (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) + (* ; "Right margin for the paragraph") + (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) + (* ; "Leading before the paragraph") + (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) + (* ; "Lead after the paragraph") + (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) + (* ; "inter-line leading") + (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) + (* ; "Will be tab specs") + (SETQ TABFLG (\BIN FILE)) + (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (SETQ QUAD (\BIN FILE)) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (SHOULDNT))) + (COND + ((NOT (ZEROP (LOGAND TABFLG 1))) (* ; "There are tabs to read") + (SETQ DEFAULTTAB (\SMALLPIN FILE)) + (SETQ TABCOUNT (\BIN FILE)) + [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (SETQ TABTYPE + (\BIN FILE)) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (4 'DOTTEDLEFT) + (5 'DOTTEDRIGHT) + (6 'DOTTEDCENTERED) + (7 'DOTTEDDECIMAL) + (SHOULDNT] + (OR (ZEROP DEFAULTTAB) + (RPLACA TABSPEC DEFAULTTAB)) + (RPLACD TABSPEC TABS))) + [COND + ((NOT (ZEROP (LOGAND TABFLG 2))) (* ; + "There are other paragraph parameters to be read.") + (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) + (* ; + "Special X location on page for this paragraph") + (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) + (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) + (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) + (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTHEADINGKEEP) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTKEEP) of LOOKS with (\ARBIN FILE)) + [COND + ((ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (replace (FMTSPEC FMTBASETOBASE) of LOOKS with (\ARBIN FILE] + [COND + ((ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (replace (FMTSPEC FMTREVISED) of LOOKS with (\ARBIN FILE] + [COND + ((ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (replace (FMTSPEC FMTCOLUMN) of LOOKS with (\ARBIN FILE] + (COND + ((ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE] + [COND + ((ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) (* ; + "There is more PARALOOKS info in this piece -- we probably lost data.") + (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T) + (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN] + (RETURN LOOKS]) + +(\TEDIT.PUT.PARALOOKS.LIST + [LAMBDA (FILE LOOKSLIST) (* ; "Edited 1-Sep-87 20:34 by jds") + (* ; + "Write the list of FMTSPECs into the font file.") + (PROG ((LOOKSHASH (HASHARRAY 50))) + (\DWOUT FILE 0) + (\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST) + (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) + (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS FILE LOOKS) + (* ; "Write out the description") + (PUTHASH LOOKS I LOOKSHASH) + (* ; + "And save it in the hash table so people can find its index.") + ) + (RETURN LOOKSHASH]) + +(\TEDIT.PUT.SINGLE.PARALOOKS + [LAMBDA (FILE LOOKS) (* ; + "Edited 2-Jul-93 21:30 by sybalskY:MV:ENVOS") + + (* ;; "Put a description of LOOKS into FILE.") + + (PROG ((FILEPOS (GETFILEPTR FILE)) + DEFAULTTAB TABSPECS OUTPUTFORMAT LEN) + (\SMALLPOUT FILE 0) (* ; + "Reserve space for the length of this looks") + (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) + (* ; + "Left margin for the first line of the paragraph") + (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) + (* ; + "Left margin for the rest of the paragraph") + (\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) + (* ; "Right margin for the paragraph") + (\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) + (* ; "Leading before the paragraph") + (\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) + (* ; "Lead after the paragraph") + (\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS)) + (* ; "inter-line leading") + (SETQ DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (COND + ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) + (OR DEFAULTTAB TABSPECS)) (* ; + "There are tab specs to save, or there is a default tab setting to save") + (\BOUT FILE 3)) + (T (* ; + "There are no tab looks. Just let him go.") + (\BOUT FILE 2))) + (\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) + (LEFT 1) + (RIGHT 2) + ((CENTER CENTERED) + 3) + ((JUST JUSTIFIED) + 4) + (SHOULDNT))) + [COND + ((OR TABSPECS DEFAULTTAB) (* ; "There are tab specs to save.") + (COND + (DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB)) + (T (\SMALLPOUT FILE 0))) + (COND + ((IGREATERP (LENGTH TABSPECS) + 255) + (SHOULDNT "Paragraph has more than 255 TABs set--can't be saved."))) + (\BOUT FILE (LENGTH TABSPECS)) + (COND + (TABSPECS (* ; "# of tab settings <256!") + (for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX of TAB)) + (* ; "And setting.") + (\BOUT FILE (SELECTQ (fetch TABKIND of TAB) + (LEFT 0) + (RIGHT 1) + (CENTERED 2) + (DECIMAL 3) + (DOTTEDLEFT 4) + (DOTTEDRIGHT 5) + (DOTTEDCENTERED + 6) + (DOTTEDDECIMAL 7) + (SHOULDNT))) + (* ; "Tab type")] + (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) + 0)) + (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) + 0)) + (\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS)) + (\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS)) + (\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTHEADINGKEEP) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTKEEP) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTBASETOBASE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTREVISED) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTCOLUMN) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) + +(* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)") + + (SETQ LEN (IDIFFERENCE (GETFILEPTR FILE) + FILEPOS)) (* ; "The length of this set of looks") + (SETFILEPTR FILE FILEPOS) (* ; "Go write the length field") + (\SMALLPOUT FILE LEN) + (SETFILEPTR FILE -1) (* ; "And back to the end of the file") + ]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) +) + +(RPAQ? TEDIT.INPUT.FORMATS NIL) + +(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) + + + +(* ;; "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") + +(DEFINEQ + +(TEDIT.BUILD.PCTB2 + [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS) (* ; "Edited 4-May-93 16:27 by jds") + + (* ;; "READ OBSOLETE FORMATS OF TEDIT FILE") + + (* ;; "START = 1st char of file to read from, if specified") + + (* ;; "END = use this as eofptr of file. For use in reading files within files.") + + (PROG (SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE + CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP EXISTINGCHARLOOKS EXLOOK + EXISTINGFMTSPECS (CURFILECH# (OR START 0)) + (CURCH# 1) + (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) + LOOKSHASH PARAHASH) (* ; + "Get the number of pieces needed (if AN formatted file), otherwise PCCOUNT will be NIL") + [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND + (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + (T (create FMTSPEC using + TEDIT.DEFAULT.FMTSPEC + ] + (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) + (* ; + "Start by assuming no page formatting") + (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) + (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind (OLDPC _ NIL) + (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from + \FirstPieceOffset + by \EltsPerPiece + do (SETQ PC NIL) (* ; + "This loop may not really read a piece, so we have to distinguish that case.") + (SETQ PCLEN (\DWIN TEXT)) + (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") + (SELECTC TYPECODE + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with ( + TEDIT.GET.PAGEFRAMES + TEXT))) + (add PCN (IMINUS \EltsPerPiece)) (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorCHARLOOKSLIST (* ; + "This is the list of CHARLOOKSs used in this document.") + (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with ( + \TEDIT.GET.CHARLOOKS.LIST2 + TEXT)) + (* ; + "Read the list of looks used in this document.") + [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) + do (SETA LOOKSHASH I LOOKS)) + (add PCN (IMINUS \EltsPerPiece)) (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + (add I -1)) + (\PieceDescriptorPARALOOKSLIST (* ; + "This is the list of PARALOOKSs used in this document.") + (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with ( + \TEDIT.GET.PARALOOKS.LIST2 + TEXT)) + (* ; + "Read the list of looks used in this document.") + [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) + of TEXTOBJ] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) + do (SETA PARAHASH I LOOKS)) + (add PCN (IMINUS \EltsPerPiece)) (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + (add I -1)) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) + (* ; + "Mark the end of the preceding paragraph.") + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) + (* ; + "Get the new set of looks, for use by later pieces.") + (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) + (* ; + "Mark the document as containing paragraph formatting info") + (add PCN (IMINUS \EltsPerPiece)) (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorLOOKS (* ; + "New character looks. Build a piece to describe those characters.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) (* ; "Build the new piece") + (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) + (* ; + "Read the character looks for this guy.") + (COND + [OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC) + (COND + ((AND (fetch (PIECE PFATP) of PC) + (NOT (fetch (PIECE PFATP) of OLDPC))) + (* ; + "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") + (add (fetch (PIECE PFPOS) of PC) + 3) + (add CURFILECH# -3)) + ((AND (fetch (PIECE PFATP) of OLDPC) + (NOT (fetch (PIECE PFATP) of PC))) + (* ; + "Switching from fat to not-fat. Add 3 bytes for the 255-0") + (add (fetch (PIECE PFPOS) of PC) + 2] + ((fetch (PIECE PFATP) of PC) (* ; + "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") + (add (fetch (PIECE PFPOS) of PC) + 3) + (add CURFILECH# -3))) + (add CURFILECH# PCLEN) (* ; + "And note the passing of characters.") + ) + (\PieceDescriptorOBJECT (* ; + "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#) + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + [COND + ((NOT (ZEROP (\BIN TEXT))) (* ; + "There are new character looks for this object. Read them in.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT))) + (T (* ; + "No new looks; steal them from the prior piece.") + (replace (PIECE PLOOKS) of PC with (OR (AND OLDPC (fetch (PIECE PLOOKS + ) + of OLDPC)) + DEFAULTLOOKS] + (replace (PIECE PLEN) of PC with 1) (* ; + "OBJECTs are officially one character long.") + ) + (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) + (COND + (PC (* ; + "If we created a piece, save it in the table.") + (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) + (add CURCH# (fetch (PIECE PLEN) of PC)) + (SETQ OLDPC PC))) finally (* INSERT-BRT (CREATEPCNODE CURCH# + (QUOTE LASTPIECE)) PCTB)) + (RETURN PCTB]) + +(\TEDIT.GET.CHARLOOKS.LIST2 + [LAMBDA (FILE) (* jds "22-May-85 14:28") + (* Read the list of CHARLOOKSs from + the file.) + (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE]) + +(\TEDIT.GET.SINGLE.CHARLOOKS2 + [LAMBDA (FILE) (* ; "Edited 30-May-91 20:26 by jds") + (* Read a set of CHARLOOKS from FILE) + (PROG* ((LOOKS (create CHARLOOKS)) + FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) + (SETQ NAME (\ARBIN FILE)) (* The font name) + (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) + (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) + (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) + 0)) + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) + (SETQ PROPS (\SMALLPIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] + [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] + [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + [replace (CHARLOOKS CLFONT) of LOOKS with (COND + ((LISTP NAME) + (* This was a font class. + Restore it.) + (FONTCLASS (pop NAME) + NAME)) + ((AND NAME (NOT (ZEROP SIZE))) + (FONTCREATE NAME SIZE + (COND + ((AND (fetch (CHARLOOKS CLBOLD) + of LOOKS) + (fetch (CHARLOOKS CLITAL) + of LOOKS)) + 'BOLDITALIC) + ((fetch (CHARLOOKS CLBOLD) + of LOOKS) + 'BOLD) + ((fetch (CHARLOOKS CLITAL) + of LOOKS) + 'ITALIC] + (RETURN LOOKS]) + +(\TEDIT.PUT.SINGLE.PARALOOKS2 + [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:33 by jds") + (* Put a description of LOOKS into + FILE. LOOKS apply to characters CH1 + thru CHLIM-1) + (PROG (DEFAULTTAB TABSPECS OUTPUTFORMAT LEN) + (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) + (* Left margin for the first line of + the paragraph) + (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) + (* Left margin for the rest of the + paragraph) + (\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) + (* Right margin for the paragraph) + (\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) + (* Leading before the paragraph) + (\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) + (* Lead after the paragraph) + (\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS)) + (* inter-line leading) + (SETQ DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (COND + ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) + (OR DEFAULTTAB TABSPECS)) + + (* There are tab specs to save, or there is a default tab setting to save) + + (\BOUT FILE 3)) + (T (* There are no tab looks. + Just let him go.) + (\BOUT FILE 2))) + (\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) + (LEFT 1) + (RIGHT 2) + ((CENTER CENTERED) + 3) + ((JUST JUSTIFIED) + 4) + (SHOULDNT))) + [COND + ((OR TABSPECS DEFAULTTAB) (* There are tab specs to save.) + (COND + (DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB)) + (T (\SMALLPOUT FILE 0))) + (\BOUT FILE (LENGTH TABSPECS)) + (COND + (TABSPECS (* %# of tab settings <256!) + (for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX of TAB)) + (* And setting.) + (\BOUT FILE (SELECTQ (fetch TABKIND of TAB) + (LEFT 0) + (RIGHT 1) + (CENTERED 2) + (DECIMAL 3) + (SHOULDNT))) + (* Tab type)] + (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) + 0)) + (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) + 0)) + (\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS)) + (\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS)) + (\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS)) + (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS]) + +(\TEDIT.PUT.SINGLE.CHARLOOKS2 + [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:26 by jds") + (* Put out a single CHARLOOKS + description.) + (PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) + STR LEN) + [COND + ((type? FONTCLASS FONT) (* For font classes, we need to save a + list of device-FD sets) + (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) + (T (* For FONTDESCRIPTORs, do it the easy + way) + (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* The font family) + (\SMALLPOUT FILE (OR (FONTPROP FONT 'SIZE) + 0)) (* Size of the type, in points) + (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0)) (* Super/subscripting distance) + (COND + ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) + (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] + (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) + (T (\SMALLPOUT FILE 0))) + (COND + ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) + (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) + (T (\SMALLPOUT FILE 0))) + (\SMALLPOUT FILE (LOGOR (COND + ((fetch (CHARLOOKS CLLEADER) of LOOKS) + (* Dotted-leader; relevant only to + TABs) + 2048) + (T 0)) + (COND + ((fetch (CHARLOOKS CLINVERTED) of LOOKS) + (* Inverse-video) + 1024) + (T 0)) + (COND + ((fetch (CHARLOOKS CLBOLD) of LOOKS) + 512) + (T 0)) + (COND + ((fetch (CHARLOOKS CLITAL) of LOOKS) + 256) + (T 0)) + (COND + ((fetch (CHARLOOKS CLULINE) of LOOKS) + 128) + (T 0)) + (COND + ((fetch (CHARLOOKS CLOLINE) of LOOKS) + 64) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) + 32) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) + 16) + (T 0)) + (COND + ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) + 8) + (T 0)) + (COND + ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) + NIL 4) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSELHERE) of LOOKS) + 2) + (T 0)) + (COND + ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) + 1) + (T 0]) + +(\TEDIT.GET.PARALOOKS.LIST2 + [LAMBDA (FILE) (* jds "22-May-85 14:28") + (* Read the list of CHARLOOKSs from + the file.) + (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE]) + +(\TEDIT.GET.SINGLE.PARALOOKS2 + [LAMBDA (FILE) (* ; "Edited 30-May-91 20:33 by jds") + (* Read a paragraph format spec from + the FILE, and return it for later use.) + (PROG ((LOOKS (create FMTSPEC)) + TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) + (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Left margin for the first line of + the paragraph) + (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Left margin for the rest of the + paragraph) + (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Right margin for the paragraph) + (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) + (* Leading before the paragraph) + (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) + (* Lead after the paragraph) + (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) + (* inter-line leading) + (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) + (* Will be tab specs) + (SETQ TABFLG (\BIN FILE)) + (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (\BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (SHOULDNT))) + (COND + ((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read) + (SETQ DEFAULTTAB (\SMALLPIN FILE)) + (SETQ TABCOUNT (\BIN FILE)) + [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (\BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (SHOULDNT] + (OR (ZEROP DEFAULTTAB) + (RPLACA TABSPEC DEFAULTTAB)) + (RPLACD TABSPEC TABS))) + [COND + ((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph + parameters to be read.) + (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) + (* Special X location on page for this + paragraph) + (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) + (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) + (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) + (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE] + (RETURN LOOKS]) + +(TEDIT.PUT.PCTB2 + [LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 11-Jun-99 15:03 by rmk:") + (* ; "Edited 11-Jun-99 15:03 by rmk:") + (* ; "Edited 11-Jun-99 14:31 by rmk:") + (* ; "Edited 11-Jun-99 14:29 by rmk:") + (* ; "Edited 30-May-91 20:24 by jds") + + (* ;; "Put a representation of the piece table onto OFILE, preserving font changes and paragraph looks. UNFORMATTED? means write no font or formatting info.") + + (PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + OLDCH# CURCH# PREVPC (FONTFILE NIL) + (PCCOUNT 0) + TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL) + (EDITSTENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) + (PARALOOKSSEEN NIL) + (FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ)) + (CACHE (TEXTPROP TEXTOBJ 'CACHE)) + CH#S PREVFATP PREVPREVPC LOOKSHASH PARAHASH) + (SETQ PC (\EDITELT (fetch (TEXTOBJ PCTB) of TEXTOBJ) + (ADD1 \FirstPieceOffset))) (* ; "First piece in the document") + (SETQ OLDLOOKS (OR (AND (type? PIECE PC) + (fetch (PIECE PLOOKS) of PC)) + (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks") + (COND + ((NEQ (fetch (STREAM EOLCONVENTION) of OFILE) + CR.EOLC) (* ; + "This file is on a non-CR host; make a note to cache it") + (SETQ TRUEFILE OFILE) (* ; + "Remember where the file should wind up.") + [SETQ OFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (* ; + "And open a temp file to write it to.") + )) + [SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE] + (COND + ((fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) (* ; + "There is layout info for this file. Save it") + [SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (TEDIT.PUT.PAGEFRAMES FONTFILE (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ)) + (add PCCOUNT 1))) + (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* ; + "Run thru the lists of char & para looks and remove any that aren't in use") + (COND + ([AND (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) + (OR (IGREATERP (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) + 1) + (NOT (EQFMTSPEC (CAR (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) + TEDIT.DEFAULT.FMTSPEC] + + (* ;; "There are paragraph looks in this document that don't match the default -- save the list of them for later retrieval.") + + [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (* ; + "Create the font-info file if it doesn't exist yet") + (SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST2 FONTFILE (fetch (TEXTOBJ TXTPARALOOKSLIST) + of TEXTOBJ))) + (SETQ PARALOOKSSEEN T))) + [COND + ((OR PARALOOKSSEEN FORMATTINGLEVEL) + + (* ;; "There are character looks in this document that don't match the default (or paragraph formatting, which forces looks to be saved) -- save the list for later retrieval.") + + [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] + (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST2 FONTFILE (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + [while PC do (COND + ([AND (NOT (ZEROP (fetch (PIECE PLEN) of PC))) + (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) + of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; + "The last piece ended a paragraph, so send out new para looks") + [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW + '((TYPE TEXT] + (* ; + "Create the formatting-info file, if it didn't exist before.") + (COND + ((NEQ CURCH# OLDCH#) (* ; + "There were prior characters that hadn't been described in a piece yet. Describe them") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST + FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC + EDITSTENTATIVE LOOKSHASH PREVFATP) + (add PCCOUNT 1) + (SETQ OLDCH# CURCH#) (* ; + "And now we've described all the characters up to the current one.") + )) + (\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH) + (SETQ PARALOOKSSEEN T) (* ; + "Remember that we've seen a foreign paralooks, and must henceforth note para boundaries") + (add PCCOUNT 1))) + (COND + [(fetch (PIECE POBJ) of PC) (* ; + "It's an object -- go use its PUTFN") + [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW + '((TYPE TEXT] + (* ; + "Create the font-info file, if need be.") + (COND + ((AND (NEQ CURCH# OLDCH#) + PREVPC) (* ; + "There were prior characters that hadn't been described in a piece yet. Describe them") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST + FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC + EDITSTENTATIVE LOOKSHASH PREVFATP) + (add PCCOUNT 1) + (SETQ OLDCH# CURCH#) (* ; + "And now we've described all the characters up to the current one.") + )) (* ; + "If the prior thing was text, send along its descriptor.") + (add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#)) + (* ; "Send out the object") + (add PCCOUNT 1) + (SETQ OLDCH# CURCH#) + (COND + ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + (NEQ (fetch (PIECE PFATP) of PC) + (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) + [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) + (AND PREVPC (fetch (PIECE PNEW) + of PREVPC] + (AND (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; + "The OBJECT has different ooks from before") + (\BOUT FONTFILE 1) + (\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch (PIECE PLOOKS) + of PC)) + (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + (T (* ; + "No differences. Don't write any charlooks, and mark that fact") + (\BOUT FONTFILE 0) (* ; + "MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS GETS ITS OWN LOOKS") + ] + (T (* ; "It's not an object.") + [COND + ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) + (NEQ (fetch (PIECE PFATP) of PC) + (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) + [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) + (AND PREVPC (fetch (PIECE PNEW) + of PREVPC] + (AND (OR (NOT PREVPC) + (fetch (PIECE PPARALAST) of PREVPC)) + (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (* ; "We have a piece with new looks.") + [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH + 'NEW + '((TYPE TEXT] + (COND + ((NOT (IEQP OLDCH# CURCH#)) + (* ; + "If there were looks past, and if the run was not empty, save a piece for its looks") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST + FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC + EDITSTENTATIVE LOOKSHASH PREVFATP) + (add PCCOUNT 1))) + (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC)) + (SETQ OLDCH# CURCH#) + (COND + [PREVFATP (COND + ((fetch (PIECE PFATP) of PC)) + (T (* ; "Switching from FAT to thin") + (BOUT OFILE 255) + (BOUT OFILE 0) + (add CURCH# 2] + ((fetch (PIECE PFATP) of PC) + (* ; "Switching from thin to fat") + (BOUT OFILE 255) + (BOUT OFILE 255) + (BOUT OFILE 0) + (add CURCH# 3))) + (SETQ PREVFATP (fetch (PIECE PFATP) of PC] + (* ; + "Now dump out the non-object contents of the piece.") + [COND + [(SETQ PFILE (fetch (PIECE PFILE) of PC)) + (* ; "It's on a file. Copy it.") + [OR (OPENP PFILE) + (replace (PIECE PFILE) of PC + with (SETQ PFILE (OPENSTREAM (fetch (STREAM FULLNAME) + of PFILE) + 'INPUT NIL '((TYPE TEXT] + (* ; "Make sure the file is open.") + (COPYBYTES PFILE OFILE (fetch (PIECE PFPOS) of PC) + (IPLUS (fetch (PIECE PFPOS) of PC) + (COND + ((fetch (PIECE PFATP) of PC) + (* ; + "For fat file pieces, copy twice as many bytes as characters.") + (UNFOLD (fetch (PIECE PLEN) of PC) + 2)) + (T (fetch (PIECE PLEN) of PC] + ((SETQ PSTR (fetch (PIECE PSTR) of PC)) + (* ; "It's in a string. Just print it.") + (COND + [(fetch (PIECE PFATP) of PC) + (* ; + "The string is fat: Copy twice as many bytes as chars.") + (for I from 1 to (fetch (PIECE PLEN) of PC) as CH instring + PSTR + do (\BOUT OFILE (\CHARSET CH)) + (\BOUT OFILE (\CHAR8CODE CH] + (T (* ; + "The string is thin. Just copy it to the file.") + (for I from 1 to (fetch (PIECE PLEN) of PC) as CH instring + PSTR + do (\BOUT OFILE CH] + [COND + ((AND (NOT CACHE) + (RANDACCESSP OFILE)) (* ; + "CSLI leave the pieces and the pctb alone and just write the file if its cached or not randomaccess") + (push CH#S (SUB1 CURCH#] + [COND + ((fetch (PIECE PFATP) of PC) + (add CURCH# (UNFOLD (fetch (PIECE PLEN) of PC) + 2))) + (T (add CURCH# (fetch (PIECE PLEN) of PC] + (* ; + "Keep running track of where in the file we are.") + )) + (SETQ PREVPREVPC PREVPC) + (SETQ PREVPC PC) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + finally (* ; + "Put out a piece describing the last characters in the file.") + (COND + ((AND FONTFILE (NEQ OLDCH# CURCH#)) (* ; + "Only if there WERE characters, and only if there's a need for font information") + [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE + (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE + LOOKSHASH PREVPREVPC) (* ; + "Put out a description of the characters") + (add PCCOUNT 1))) + (COND + ((AND PARALOOKSSEEN (fetch (PIECE PPARALAST) of PREVPC)) + (* ; + "The last piece contained the end of a paragraph. Make sure it gets noted.") + (\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH) + (add PCCOUNT 1] + (for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM)) + (* ; "Do any user-specific cleanup") + (COND + (TRUEFILE (* ; + "This file needs to be converted to the right convention") + (COND + ((AND FONTFILE (NOT UNFORMATTED?) + (NOT SEPARATEFORMAT)) (* ; + "Formatted file: Copy without converting.") + (COPYBYTES OFILE TRUEFILE 0 -1)) + (T (* ; + "Go ahead and convert the EOLCONVENTION, this is a plain-text file") + (COPYCHARS OFILE TRUEFILE 0 -1))) + (SETQ OFILE TRUEFILE))) + [COND + ((AND (OPENP OFILE) + FONTFILE) (* ; "We need to write format info.") + (\DWOUT FONTFILE (GETEOFPTR OFILE)) (* ; + "So remember the end of the plain-text part of the file") + (\SMALLPOUT FONTFILE PCCOUNT) (* ; + "# OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE") + (\SMALLPOUT FONTFILE 31417) (* ; + "Now the password for NEW format files: 31416") + (COND + ((AND (NOT UNFORMATTED?) + (NOT SEPARATEFORMAT)) + + (* ;; "Only write fmtg info at the end if we want it there--not if we want plain text or want it kept separate.") + + (COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE)) + (* ; + "Copy the font information to the file trailer") + ) + (T)) + (CLOSEF FONTFILE) + (COND + ((NOT SEPARATEFORMAT) (* ; + "Unless we want the formatting info separately, delete the file") + (* ; + "(since FONTFILE is a stream, we should not need to delete it at all) (DELFILE FONTFILE)") + ] + (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (TEXTOBJ DEFAULTCHARLOOKS) + of TEXTOBJ) + TEXTOBJ)) + (* ; + "Re-add the default and caret looks's to the lists, since they may not have been really saved.") + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + TEXTOBJ)) + (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ + FMTSPEC) + of TEXTOBJ) + TEXTOBJ)) + (RETURN (CONS (COND + (UNFORMATTED? NIL) + (T FONTFILE)) + CH#S]) + +(\TEDIT.PUT.CHARLOOKS.LIST2 + [LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:12") + (* Write the list of CHARLOOKSs into + the font file.) + + (* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' + position in the list we wrote on the file. + Those position numbers are then written in the individual looks descriptions, and + are used to reconstruct the piece looks when the file is read back in.) + + (PROG ((LOOKSHASH (HASHARRAY 50))) + (\DWOUT FILE 0) (* No characters are described by this + pseudo-piece entry.) + (\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of + CHARLOOKSs) + (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in + the list) + (for I from 1 as LOOKS in LOOKSLIST do (* Write each charlooks, in the order + they appear in the list.) + (\TEDIT.PUT.SINGLE.CHARLOOKS2 FILE LOOKS) + (* Write out the description) + (PUTHASH LOOKS I LOOKSHASH) + (* And save it in the hash table so + people can find its index.)) + (RETURN LOOKSHASH]) + +(\TEDIT.PUT.PARALOOKS.LIST2 + [LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:09") + (* Write the list of FMTSPECs into the + font file.) + (PROG ((LOOKSHASH (HASHARRAY 50))) + (\DWOUT FILE 0) + (\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST) + (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) + (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS2 FILE LOOKS) + (* Write out the description) + (PUTHASH LOOKS I LOOKSHASH) + (* And save it in the hash table so + people can find its index.)) + (RETURN LOOKSHASH]) +) + + + +(* ;; "For converting incoming old-format files (1/27/85 cutover)") + +(DEFINEQ + +(TEDIT.BUILD.PCTB1 + [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS) (* ; "Edited 22-May-92 18:00 by jds") + +(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") + + (* ;; "START = 1st char of file to read from, if specified") + + (* ;; "END = use this as eofptr of file. For use in reading files within files.") + + (PROG [SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE + CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP EXISTINGCHARLOOKS EXLOOK + EXISTINGFMTSPECS (CURFILECH# (OR START 0)) + (CURCH# 1) + (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] + + (* ;; "Get the number of pieces needed (if AN formatted file), otherwise PCCOUNT will be NIL") + + [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND + (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + (T (create FMTSPEC using + TEDIT.DEFAULT.FMTSPEC + ] + (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) + (* ; + "Start by assuming no page formatting") + (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind (OLDPC _ NIL) + (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from + \FirstPieceOffset + by \EltsPerPiece + do (SETQ PC NIL) (* ; + "This loop may not really read a piece, so we have to distinguish that case.") + (SETQ PCLEN (\DWIN TEXT)) + (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") + (SELECTC TYPECODE + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with ( + TEDIT.GET.PAGEFRAMES1 + TEXT))) + (add PCN (IMINUS \EltsPerPiece)) (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) + (* ; + "Mark the end of the preceding paragraph.") + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS1 TEXT)) + (* ; + "Get the new set of looks, for use by later pieces.") + (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) + (* ; + "Mark the document as containing paragraph formatting info") + (add PCN (IMINUS \EltsPerPiece)) (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorLOOKS (* ; + "New character looks. Build a piece to describe those characters.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) (* ; "Build the new piece") + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (\TEDIT.GET.CHARLOOKS1 PC TEXT) (* ; + "Read the character looks for this guy.") + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + (* ; + "And note the passing of characters.") + ) + (\PieceDescriptorOBJECT (* ; + "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (TEDIT.GET.OBJECT1 TEXTSTREAM PC TEXT CURFILECH#) + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + [COND + ((NOT (ZEROP (\BIN TEXT))) (* ; + "There are new character looks for this object. Read them in.") + (\DWIN TEXT) + (\WIN TEXT) (* ; + "Skip over the piece-type code we know has to be here.") + (\TEDIT.GET.CHARLOOKS1 PC TEXT)) + (T (* ; + "No new looks; steal them from the prior piece.") + (replace (PIECE PLOOKS) of PC with (OR (AND OLDPC (fetch (PIECE PLOOKS + ) + of OLDPC)) + DEFAULTLOOKS] + (replace (PIECE PLEN) of PC with 1) (* ; + "OBJECTs are officially one character long.") + ) + (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) + (COND + (PC (* ; + "If we created a piece, save it in the table.") + [COND + ((SETQ EXLOOK (for LOOK in EXISTINGCHARLOOKS + thereis (EQCLOOKS (fetch (PIECE PLOOKS) of PC) + LOOK))) + (* ; + "These charlooks are a duplicate of pre-existing ones. Re-use the old one.") + (replace (PIECE PLOOKS) of PC with EXLOOK)) + (T (push EXISTINGCHARLOOKS (fetch (PIECE PLOOKS) of PC] + [COND + ((SETQ EXLOOK (for LOOK in EXISTINGFMTSPECS + thereis (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) + LOOK))) + (* ; + "These paralooks are a duplicate of pre-existing ones. Re-use the old one.") + (replace (PIECE PPARALOOKS) of PC with EXLOOK)) + (T (push EXISTINGFMTSPECS (fetch (PIECE PPARALOOKS) of PC] + (INSERT-BRT (CREATEPCNODE CURCH# PC) + PCTB) + (add CURCH# (fetch (PIECE PLEN) of PC)) + (SETQ OLDPC PC))) finally (INSERT-BRT (CREATEPCNODE CURCH# 'LASTPIECE) + PCTB)) + (RETURN PCTB]) + +(TEDIT.GET.PAGEFRAMES1 + [LAMBDA (FILE) (* jds " 1-Feb-85 14:55") + (* Read a bunch of page frames from + the file, and return it.) + (TEDIT.PARSE.PAGEFRAMES1 (READ FILE]) + +(\TEDIT.GET.CHARLOOKS1 + [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:26 by jds") + (* Read a description of PC's + CHARLOOKS from FILE.) + (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS))) + (replace (PIECE PLOOKS) of PC with LOOKS) + (SETQ NAME (\ARBIN FILE)) (* The font name) + (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) + (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) + (SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance) + (OR (ZEROP SUB) + (SETQ SUPER (IMINUS SUB))) + + (* If this is an old file, it'll have a subscript value not zero. + Let those past and do the right thing.) + + (COND + ((NOT (ZEROP (\BIN FILE))) (* This text is NEW. + Mark it so.) + (replace (PIECE PNEW) of PC with T))) + [COND + ((NOT (ZEROP (\BIN FILE))) (* There is style or user information + to be read) + (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) + 0)) + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE] + (SETQ PROPS (\SMALLPIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + (replace (CHARLOOKS CLFONT) of LOOKS with (COND + ((LISTP NAME) + (* This was a font class. + Restore it.) + (FONTCLASS (pop NAME) + NAME)) + ((AND NAME (NOT (ZEROP SIZE))) + (FONTCREATE NAME SIZE + (COND + ((AND (fetch (CHARLOOKS CLBOLD) + of LOOKS) + (fetch (CHARLOOKS CLITAL) + of LOOKS)) + 'BOLDITALIC) + ((fetch (CHARLOOKS CLBOLD) + of LOOKS) + 'BOLD) + ((fetch (CHARLOOKS CLITAL) + of LOOKS) + 'ITALIC]) + +(\TEDIT.GET.PARALOOKS1 + [LAMBDA (FILE) (* ; "Edited 30-May-91 20:34 by jds") + (* Read a paragraph format spec from + the FILE, and return it for later use.) + (PROG ((LOOKS (create FMTSPEC)) + TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) + (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Left margin for the first line of + the paragraph) + (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Left margin for the rest of the + paragraph) + (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Right margin for the paragraph) + (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) + (* Leading before the paragraph) + (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) + (* Lead after the paragraph) + (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) + (* inter-line leading) + (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) + (* Will be tab specs) + (SETQ TABFLG (\BIN FILE)) + (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (\BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (SHOULDNT))) + (COND + ((NOT (ZEROP (LOGAND TABFLG 1))) (* There are tabs to read) + (SETQ DEFAULTTAB (\SMALLPIN FILE)) + (SETQ TABCOUNT (\BIN FILE)) + [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (\BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (SHOULDNT] + (OR (ZEROP DEFAULTTAB) + (RPLACA TABSPEC DEFAULTTAB)) + (RPLACD TABSPEC TABS))) + [COND + ((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph + parameters to be read.) + (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) + (* Special X location on page for this + paragraph) + (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) + (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) + (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) + (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) + (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE] + (RETURN LOOKS]) + +(TEDIT.GET.OBJECT1 + [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 18:17 by mitani") + (* Get an object from the file) + + (* CURCH# = fileptr within the text section of the file where the object's text + starts.) + + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + FILEPTRSAVE NAMELEN GETFN OBJ) + (SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of IMAGEOBJ) + (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the + building of the object) + (SETFILEPTR FILE CURCH#) + (SETQ OBJ (READIMAGEOBJ FILE GETFN)) + (SETFILEPTR FILE FILEPTRSAVE) + (replace (PIECE POBJ) of PIECE with OBJ) + (replace (PIECE PFILE) of PIECE with NIL) + (replace (PIECE PSTR) of PIECE with NIL) + [replace (PIECE PLOOKS) of PIECE with (COND + ((fetch (PIECE PREVPIECE) of PIECE) + (fetch (PIECE PLOOKS) of (fetch (PIECE PREVPIECE) + of PIECE))) + (T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) + of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS ( + CHARLOOKS.FROM.FONT + DEFAULTFONT) + TEXTOBJ] + (RETURN (fetch (PIECE POBJ) of PIECE]) +) + + + +(* ;; "VERSION 0 Compatibility reading functions") + +(DEFINEQ + +(TEDIT.BUILD.PCTB0 + [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 22-May-92 18:01 by jds") + +(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") + + (PROG [SEL LINES PCTB PC OLDPC TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN PIECEINFOCH# CACHE + TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0)) + (CURCH# 1) + (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] + (* ; + "Get the number of pieces needed (if AN formatted file), otherwise PCCOUNT will be NIL") + [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND + (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + (T (create FMTSPEC using + TEDIT.DEFAULT.FMTSPEC + ] + (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind (OLDPC _ NIL) for I from 1 to PCCOUNT as PCN from \FirstPieceOffset by \EltsPerPiece + do (SETQ PC (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ (SETQ PCLEN (\DWIN TEXT)) + PREVPIECE _ OLDPC + PPARALOOKS _ DEFAULTPARALOOKS)) + [COND + (OLDPC (replace (PIECE NEXTPIECE) of OLDPC with PC) + (replace (PIECE PPARALOOKS) of PC with (fetch (PIECE PPARALOOKS) + of OLDPC] + (SETQ TYPECODE (\SMALLPIN TEXT)) + (SELECTC TYPECODE + (\PieceDescriptorLOOKS + (TEDIT.GET.CHARLOOKS0 PC TEXT) + (add CURFILECH# (fetch (PIECE PLEN) of PC))) + (\PieceDescriptorOBJECT + (TEDIT.GET.OBJECT0 TEXTSTREAM PC TEXT CURFILECH#) + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + (replace (PIECE PLEN) of PC with 1) (* ; + "Only object--can't be followed by either ot the others.") + ) + (\PieceDescriptorPARA + (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) + (TEDIT.GET.PARALOOKS0 PC TEXT) + (replace (PIECE PLEN) of PC with (\DWIN TEXT)) + (* ; + "Set this piece's length from the character looks.") + (\SMALLPIN TEXT) (* ; + "Skip the piece-type code, since we know what's next") + (TEDIT.GET.CHARLOOKS0 PC TEXT) (* ; "This document is 'formatted' .") + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T))) + (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) + (SETQ OLDPC PC) + (INSERT-BRT (CREATEPCNODE CURCH# PC) + PCTB) + (add CURCH# (fetch (PIECE PLEN) of PC)) finally (INSERT-BRT (CREATEPCNODE + CURCH# + 'LASTPIECE) + PCTB)) + (RETURN PCTB]) + +(TEDIT.GET.CHARLOOKS0 + [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:26 by jds") + (* Put a description of LOOKS into + FILE. LOOKS apply to characters CH1 + thru CHLIM-1) + (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS))) + (replace (PIECE PLOOKS) of PC with LOOKS) + (SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description which + follows) + [SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE] + (* The font name) + (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) + (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) + (SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance) + (OR (ZEROP SUB) + (SETQ SUPER (IMINUS SUB))) + + (* If this is an old file, it'll have a subscript value not zero. + Let those past and do the right thing.) + + (COND + ((NOT (ZEROP (\BIN FILE))) (* This text is NEW. + Mark it so.) + (replace (PIECE PNEW) of PC with T))) + [COND + ((NOT (ZEROP (\BIN FILE))) (* There is style or user information + to be read) + (SETQ STYLESTR (\STRINGIN FILE)) + (SETQ USERSTR (\STRINGIN FILE)) + (COND + ((NOT (ZEROP (NCHARS STYLESTR))) (* There IS style info) + (replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR))) + (T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0))) + (COND + ((NOT (ZEROP (NCHARS USERSTR))) (* There IS user info) + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR] + (SETQ PROPS (\SMALLPIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + (replace (CHARLOOKS CLFONT) of LOOKS with (AND NAME (NOT (ZEROP SIZE)) + (FONTCREATE NAME SIZE + (COND + ((AND (fetch (CHARLOOKS CLBOLD) + of LOOKS) + (fetch (CHARLOOKS CLITAL) + of LOOKS)) + 'BOLDITALIC) + ((fetch (CHARLOOKS CLBOLD) + of LOOKS) + 'BOLD) + ((fetch (CHARLOOKS CLITAL) + of LOOKS) + 'ITALIC]) + +(TEDIT.GET.OBJECT0 + [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 18:17 by mitani") + (* Get an object from the file) + + (* CURCH# = fileptr within the text section of the file where the object's text + starts.) + + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + FILEPTRSAVE NAMELEN GETFN OBJ) + (SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of IMAGEOBJ) + (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the + building of the object) + (SETFILEPTR FILE CURCH#) + (SETQ OBJ (READIMAGEOBJ FILE GETFN)) + (SETFILEPTR FILE FILEPTRSAVE) + (replace (PIECE POBJ) of PIECE with OBJ) + (replace (PIECE PFILE) of PIECE with NIL) + (replace (PIECE PSTR) of PIECE with NIL) + [replace (PIECE PLOOKS) of PIECE with (COND + ((fetch (PIECE PREVPIECE) of PIECE) + (fetch (PIECE PLOOKS) of (fetch (PIECE PREVPIECE) + of PIECE))) + (T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) + of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS ( + CHARLOOKS.FROM.FONT + DEFAULTFONT) + TEXTOBJ] + (RETURN (fetch (PIECE POBJ) of PIECE]) + +(TEDIT.GET.PARALOOKS0 + [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:34 by jds") + (* Put a description of LOOKS into + FILE. LOOKS apply to characters CH1 + thru CHLIM-1) + (PROG ((LOOKS (create FMTSPEC)) + TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) + (replace (PIECE PPARALOOKS) of PC with LOOKS) + (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Left margin for the first line of + the paragraph) + (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Left margin for the rest of the + paragraph) + (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) + (* Right margin for the paragraph) + (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) + (* Leading before the paragraph) + (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) + (* Lead after the paragraph) + (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) + (* inter-line leading) + (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS NIL NIL))) + (* Will be tab specs) + (SETQ TABFLG (\BIN FILE)) + (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (\BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (SHOULDNT))) + (COND + ((NOT (ZEROP TABFLG)) (* There are tabs to read) + (SETQ DEFAULTTAB (\SMALLPIN FILE)) + (SETQ TABCOUNT (\BIN FILE)) + [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (\BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (SHOULDNT] + (OR (ZEROP DEFAULTTAB) + (RPLACA TABSPEC DEFAULTTAB)) + (RPLACD TABSPEC TABS]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2979 55273 (TEDIT.BUILD.PCTB 2989 . 34712) (\TEDIT.CONVERT.FOREIGN.FORMAT 34714 . 36294 +) (TEDIT.FORMATTEDFILEP 36296 . 39508) (TEDIT.GET 39510 . 47992) (TEDIT.PARSE.PAGEFRAMES1 47994 . +49700) (\ARBIN 49702 . 50318) (\ATMIN 50320 . 50645) (\DWIN 50647 . 50921) (\STRINGIN 50923 . 51527) ( +\TEDIT.FORMATTEDP1 51529 . 53786) (\TEDIT.SET.WINDOW 53788 . 54299) (TEDIT.GET.PASSWORD 54301 . 55271) +) (55309 74867 (TEDIT.INCLUDE 55319 . 66091) (TEDIT.RAW.INCLUDE 66093 . 74865)) (74901 116749 ( +TEDIT.PUT 74911 . 84872) (TEDIT.PUT.PCTB 84874 . 110430) (\TEDIT.PUTRESET 110432 . 110674) ( +TEDIT.PUT.PIECE.DESCRIPTOR 110676 . 113320) (\ARBOUT 113322 . 114473) (\ATMOUT 114475 . 114986) ( +\DWOUT 114988 . 115267) (\STRINGOUT 115269 . 115705) (\TEDIT-OPEN-FONT-FILE 115707 . 116747)) (116750 +128178 (\TEDIT.GET.CHARLOOKS.LIST 116760 . 117161) (\TEDIT.GET.SINGLE.CHARLOOKS 117163 . 120962) ( +\TEDIT.PUT.CHARLOOKS.LIST 120964 . 122901) (\TEDIT.PUT.SINGLE.CHARLOOKS 122903 . 128176)) (128179 +142455 (\TEDIT.GET.PARALOOKS.LIST 128189 . 128598) (\TEDIT.GET.SINGLE.PARALOOKS 128600 . 135237) ( +\TEDIT.PUT.PARALOOKS.LIST 135239 . 136246) (\TEDIT.PUT.SINGLE.PARALOOKS 136248 . 142453)) (142763 +200061 (TEDIT.BUILD.PCTB2 142773 . 155573) (\TEDIT.GET.CHARLOOKS.LIST2 155575 . 155978) ( +\TEDIT.GET.SINGLE.CHARLOOKS2 155980 . 159457) (\TEDIT.PUT.SINGLE.PARALOOKS2 159459 . 163958) ( +\TEDIT.PUT.SINGLE.CHARLOOKS2 163960 . 168476) (\TEDIT.GET.PARALOOKS.LIST2 168478 . 168881) ( +\TEDIT.GET.SINGLE.PARALOOKS2 168883 . 173506) (TEDIT.PUT.PCTB2 173508 . 197122) ( +\TEDIT.PUT.CHARLOOKS.LIST2 197124 . 199063) (\TEDIT.PUT.PARALOOKS.LIST2 199065 . 200059)) (200138 +221240 (TEDIT.BUILD.PCTB1 200148 . 210066) (TEDIT.GET.PAGEFRAMES1 210068 . 210424) ( +\TEDIT.GET.CHARLOOKS1 210426 . 214588) (\TEDIT.GET.PARALOOKS1 214590 . 219206) (TEDIT.GET.OBJECT1 +219208 . 221238)) (221300 235657 (TEDIT.BUILD.PCTB0 221310 . 225660) (TEDIT.GET.CHARLOOKS0 225662 . +230090) (TEDIT.GET.OBJECT0 230092 . 232122) (TEDIT.GET.PARALOOKS0 232124 . 235655))))) +STOP diff --git a/library/TEDITFILE.LCOM b/library/tedit/TEDIT-FILE.LCOM similarity index 98% rename from library/TEDITFILE.LCOM rename to library/tedit/TEDIT-FILE.LCOM index 562bba777395c3767aa6818126f1c71c905b8a1e..74e0ee7e8d47ba8cebbe7e794fcf428cd46205ea 100644 GIT binary patch delta 413 zcmaEPpLx|i<_X~~bcT zF{;&#nw+0okeQR3qL5lq zP*kjHrI43jl98F0u8^6hpyU?nXbCnm4ULqnHMulE);b5dIszSm zrV8kEQ!5h_pv~1T!QQntnC=h5;(i4qV^cE=0|l#qAlEQY|IlDv7ogb+To}Hxurjnz zQov<253TYg* Rk;Mko@%~*hi=U?t7XV0ec<%rJ delta 620 zcmaiyPiosh7{zH#x==$_!L+-tf*5IGF&ZnWW)fl)Nw(FhmMY1Ax^!wSTqlx{Z3u*r zE41hqfvj?m9-&>7;*>&8&_!oNNKI?#=ErQ_``&xZ)tAbTua%F3ZH(%#7D*i=j6uZ| z?NOwCnm*s^&EkA^I2~mtqvX&n?jF@HBinMKmgCyWenSRP)&D3lrm9XgO$6aMkKd=K z+2kZ1LwuIyvmFYhQfb?f;u~Q&@B#}a35czp>%yvyq9`JaM{_3q*S<-2RZ$isp1=%j zgPDT3Efh( zJ6G|&hr`?G_68mwoh@l3< zI8V>OO!F+wNApRVh@cX^!J%>Na_n)ukaplan>Local>medley3.5>lispcore>library>TEDITFIND.;2 40100 - changes to%: (FNS TEDIT.FIND) +(FILECREATED "14-Jul-2022 16:55:46"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FIND.;1 37798 - previous date%: "25-Aug-94 10:53:52" -{DSK}kaplan>Local>medley3.5>lispcore>library>TEDITFIND.;1) + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-FIND.;2) -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 by Venue & Xerox Corporation. All rights reserved. -") +(PRETTYCOMPRINT TEDIT-FINDCOMS) -(PRETTYCOMPRINT TEDITFINDCOMS) - -(RPAQQ TEDITFINDCOMS - ((FILES TEDITDCL) +(RPAQQ TEDIT-FINDCOMS + ((FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE] (COMS (* Read-table Utilities) (FNS \TEDIT.SEARCH.CODETABLE) @@ -27,7 +22,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b \TEDIT.PACK.TARGETLIST \TEDIT.PARSE.SEARCHSTRING \TEDIT.SUBST.FN1 \TEDIT.SUBST.FN2 TEDIT.SUBSTITUTE))) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -39,7 +34,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -53,16 +48,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (DEFINEQ (\TEDIT.SEARCH.CODETABLE - (LAMBDA NIL (* jds "23-OCT-83 00:58") - (* Build the 16-bit-item "syntax class" - table for searching) + [LAMBDA NIL (* jds "23-OCT-83 00:58") + (* Build the 16-bit-item "syntax class" + table for searching) (PROG ((CODETBL (ARRAY 256 'SMALLP 0 0))) - (for I from 0 to 255 do (SETA CODETBL I I)) - - (* Default is that a char maps to itself, and is punctuation.) - + (for I from 0 to 255 do (SETA CODETBL I I)) (* Default is that a char maps to + itself, and is punctuation.) (for CH - in (CHARCODE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k + in (CHARCODE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z)) do (SETA CODETBL CH (IPLUS \AlphaNumericFlag \AlphaFlag CH))) (for CH in (CHARCODE (0 1 2 3 4 5 6 7 8 9)) do (SETA CODETBL CH (IPLUS \AlphaNumericFlag CH @@ -71,7 +64,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b in (LIST \OneCharPattern \AnyStringPattern \OneAlphaPattern \OneNonAlphaPattern \AnyAlphaPattern \AnyNonAlphaPattern \LeftBracketPattern \RightBracketPattern) do (SETA CODETBL CH CODE)) - (RETURN CODETBL)))) + (RETURN CODETBL]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -80,7 +73,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (DEFINEQ (\TEDIT.BASICFIND - [LAMBDA (TEXTOBJ STRING CH# CHLIM) (* ; "Edited 30-May-91 20:56 by jds") + [LAMBDA (TEXTOBJ STRING CH# CHLIM) (* ; "Edited 30-May-91 20:56 by jds") (* ;; "Search thru TEXTOBJ, starting where the caret is, for the string STRING, exact match only for now. (Optionally, start the search at character ch#.)") @@ -93,22 +86,22 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b CH1 ANCHOR PCH# OANCHOR CH) (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "2/12/85 JDS: I don't understand WHY this is here, but I'll assume it's right for now.") + "2/12/85 JDS: I don't understand WHY this is here, but I'll assume it's right for now.") (* ; - "Prohibit future insertions in the current piece.") + "Prohibit future insertions in the current piece.") (COND - ((OR CH# (fetch (SELECTION SET) of SEL))(* ; - "There must be a well-defined starting point.") + ((OR CH# (fetch (SELECTION SET) of SEL)) (* ; + "There must be a well-defined starting point.") (RETURN (PROG NIL (SETQ CH1 (OR CH# (SELECTQ (fetch (SELECTION POINT) of SEL) (LEFT (fetch (SELECTION CH#) of SEL)) (RIGHT (fetch (SELECTION CHLIM) of SEL)) NIL))) (* ; - "Find the starting point for the search") + "Find the starting point for the search") (* ; "DO THE SEARCH") (COND ((IGREATERP CH1 TEXTLIM) (* ; - "Starting the search past the last possible starting point. Just punt.") + "Starting the search past the last possible starting point. Just punt.") (RETURN NIL))) (SETQ ANCHOR (SUB1 CH1)) RETRY @@ -116,31 +109,30 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b TEXTOBJ) [for old ANCHOR from (ADD1 ANCHOR) to TEXTLIM do (SETQ CH (\BIN TEXTSTREAM)) - (COND - ((EQ CH CH#1) - (RETURN] + (COND + ((EQ CH CH#1) + (RETURN] (COND ((IGREATERP ANCHOR TEXTLIM) (RETURN NIL))) (* ; - "No starting character found before end of string") + "No starting character found before end of string") (SETQ OANCHOR ANCHOR) (SETQ FOUND T) - [for old CH1 from (ADD1 ANCHOR) to TEXTLIM as PCH# - from 2 to (NCHARS STRING) - do (SETQ CH (\BIN TEXTSTREAM)) - (COND - ((NEQ CH (NTHCHARCODE STRING PCH#)) - (SETQ FOUND NIL) - (RETURN] + [for old CH1 from (ADD1 ANCHOR) to TEXTLIM as PCH# from 2 + to (NCHARS STRING) do (SETQ CH (\BIN TEXTSTREAM)) + (COND + ((NEQ CH (NTHCHARCODE STRING PCH#)) + (SETQ FOUND NIL) + (RETURN] (COND (FOUND (RETURN ANCHOR)) (T (GO RETRY]) (TEDIT.FIND - [LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 6-May-2018 17:34 by rmk:") - (* ; "Edited 30-May-91 20:56 by jds") + [LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 6-May-2018 17:34 by rmk:") + (* ; "Edited 30-May-91 20:56 by jds") - (* ;; "If WILDCARDS? is NIL then TEDIT.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection") + (* ;; "If WILDCARDS? is NIL then TEDIT.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection") (LET* [(TEXTOBJ (TEXTOBJ TEXTOBJ)) @@ -149,23 +141,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) - (* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit by adding the find event (given that the history is not a list, just a single event (TEDITHISTORY)") + (* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit by adding the find event (given that the history is not a list, just a single event (TEDITHISTORY)") (AND NIL (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ 'Find THAUXINFO _ TARGETSTRING))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Any FIND invalidates the type-in cache.") + (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; + "Any FIND invalidates the type-in cache.") (COND - [WILDCARDS? (* ; - "will return a list of start and end of selection or nil if not found") + [WILDCARDS? (* ; + "will return a list of start and end of selection or nil if not found") (PROG (TARGETLIST SEL RESULT RESULT1) (RETURN (COND - ((OR START# (AND (fetch (SELECTION SET) of (SETQ SEL - (fetch (TEXTOBJ - SEL) - of TEXTOBJ))) + ((OR START# (AND (fetch (SELECTION SET) of (SETQ SEL (fetch (TEXTOBJ SEL) + of TEXTOBJ))) (LEQ (SETQ START# (SELECTQ (fetch (SELECTION POINT) of SEL) (LEFT (fetch (SELECTION CH#) @@ -173,25 +162,25 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (RIGHT (fetch (SELECTION CHLIM) of SEL)) NIL)) - REAL-END#))) (* ; "START# better be >= to END#") + REAL-END#))) (* ; "START# better be >= to END#") (COND ((AND (for X in [SETQ TARGETLIST - (\TEDIT.PARSE.SEARCHSTRING - (for X in (CHCON TARGETSTRING) - collect (MKSTRING (CHARACTER X] - collect X when (LITATOM X)) + (\TEDIT.PARSE.SEARCHSTRING + (for X in (CHCON TARGETSTRING) + collect (MKSTRING (CHARACTER X] collect X + when (LITATOM X)) (SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST START# REAL-END#))) - (* ; - "If there are atoms, they are tedit wildcard chars") + (* ; + "If there are atoms, they are tedit wildcard chars") (\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 REAL-END#)) - (T (* ; "no wildcards but bounded search") + (T (* ; "no wildcards but bounded search") (COND ((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST) START# REAL-END# NIL)) (LIST RESULT (SUB1 (IPLUS RESULT (NCHARS (CAR TARGETLIST] - (T (* ; - "will return just the number of the start char or nil if not found") + (T (* ; + "will return just the number of the start char or nil if not found") (LET ((RESULT (\TEDIT.BASICFIND TEXTOBJ TARGETSTRING START# REAL-END#))) (COND ((NULL REAL-END#) @@ -203,26 +192,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (T RESULT]) (TEDIT.NEW.FIND - [LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 23-Feb-88 11:13 by jds") - - (* ;; "If WILDCARDS? is NIL then TEDIT.NEW.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection") - - (* ;; "(PROG ((TEXTSTREAM (fetch STREAMHINT of TEXTOBJ)) PATTERN FIRSTPAT PATTERNSTACK POSNSTACK FIRSTCHAR1 FIRSTCHAR2 FIRSTPATNORMAL PATTERNLEN FOUND PATTERNPOS TEXTPOS) (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) (SETQ PATTERN (\TEDIT.NEW.PARSE.SEARCHSTRING TARGETSTRING)) (OR PATTERN (RETURN)) (SETQ PATTERNLEN (FLENGTH PATTERN)) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ (QUOTE Find) THAUXINFO _ TARGETSTRING)) (COND ((ZEROP (LOGAND \SpecialPattern (SETQ FIRSTPAT (CAR PATTERN)))) (* The pattern starts with an easy first character) (SETQ FIRSTPATNORMAL T) (SETQ FIRSTCHAR1 (LOGAND \CHARMASK FIRSTPAT)) (COND ((ZEROP (LOGAND \AlphaFlag FIRSTPAT)) (* Not alphabetic) (SETQ FIRSTCHAR2 FIRSTCHAR1)) (T (* Is alphabetic) (SETQ FIRSTCHAR2 (LOGAND FIRSTCHAR1 223)))))) (bind (CH# _ START#) while (ILEQ CH# END#) first (\SETUPGETCH START# TEXTOBJ) do (COND (FIRSTPATNORMAL (* The pattern starts with an easy first character) (COND ((AND (NEQ (SETQ CH (\BIN TEXTSTREAM)) FIRSTCHAR1) (NEW CH FIRSTCHAR2)) (GO $$ITERATE))) (SETQ PATTERNPOS 1) (SETQ CH (\BIN TEXTSTREAM))) (T (SETQ PATTERNPOS 0))) (SETQ TEXTPOS (\TEXTMARK TEXTOBJ)) (COND ((IGEQ PATTERNPOS PATTERNLEN) (SETQ FOUND T) (RETURN)))))") + [LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 23-Feb-88 11:13 by jds") + + (* ;; "If WILDCARDS? is NIL then TEDIT.NEW.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection") + + (* ;; "(PROG ((TEXTSTREAM (fetch STREAMHINT of TEXTOBJ)) PATTERN FIRSTPAT PATTERNSTACK POSNSTACK FIRSTCHAR1 FIRSTCHAR2 FIRSTPATNORMAL PATTERNLEN FOUND PATTERNPOS TEXTPOS) (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) (SETQ PATTERN (\TEDIT.NEW.PARSE.SEARCHSTRING TARGETSTRING)) (OR PATTERN (RETURN)) (SETQ PATTERNLEN (FLENGTH PATTERN)) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ (QUOTE Find) THAUXINFO _ TARGETSTRING)) (COND ((ZEROP (LOGAND \SpecialPattern (SETQ FIRSTPAT (CAR PATTERN)))) (* The pattern starts with an easy first character) (SETQ FIRSTPATNORMAL T) (SETQ FIRSTCHAR1 (LOGAND \CHARMASK FIRSTPAT)) (COND ((ZEROP (LOGAND \AlphaFlag FIRSTPAT)) (* Not alphabetic) (SETQ FIRSTCHAR2 FIRSTCHAR1)) (T (* Is alphabetic) (SETQ FIRSTCHAR2 (LOGAND FIRSTCHAR1 223)))))) (bind (CH# _ START#) while (ILEQ CH# END#) first (\SETUPGETCH START# TEXTOBJ) do (COND (FIRSTPATNORMAL (* The pattern starts with an easy first character) (COND ((AND (NEQ (SETQ CH (\BIN TEXTSTREAM)) FIRSTCHAR1) (NEW CH FIRSTCHAR2)) (GO $$ITERATE))) (SETQ PATTERNPOS 1) (SETQ CH (\BIN TEXTSTREAM))) (T (SETQ PATTERNPOS 0))) (SETQ TEXTPOS (\TEXTMARK TEXTOBJ)) (COND ((IGEQ PATTERNPOS PATTERNLEN) (SETQ FOUND T) (RETURN)))))") (HELP]) (TEDIT.NEXT - [LAMBDA (STREAM) (* ; "Edited 30-May-91 20:57 by jds") + [LAMBDA (STREAM) (* ; "Edited 30-May-91 20:57 by jds") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) TARGET SEL OPTION FIELDSEL) (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T)) - (* find the first >>delimited<< - field) + (* find the first >>delimited<< field) (SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch (SELECTION CH#) of SEL))) - (* find the first menu-type - insertion field, usually delimited - with {}) + (* find the first menu-type insertion + field, usually delimited with {}) [SETQ OPTION (COND [(AND TARGET FIELDSEL) (* take the first one) (COND @@ -239,11 +226,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (\SHOWSEL SEL NIL NIL) (replace (SELECTION CH#) of SEL with (CAR TARGET)) (* Set up SELECTION to be the found - text) + text) (replace (SELECTION CHLIM) of SEL with (ADD1 (CADR TARGET))) - (replace (SELECTION DCH) of SEL with (IDIFFERENCE - (ADD1 (CADR TARGET)) - (CAR TARGET))) + (replace (SELECTION DCH) of SEL with (IDIFFERENCE (ADD1 (CADR TARGET)) + (CAR TARGET))) (replace (SELECTION POINT) of SEL with 'RIGHT) (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* Always selected normally) (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) @@ -253,18 +239,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (\SHOWSEL SEL NIL T) (* And get it into the window) ) (FIELD (* Replace the selection for this - textobj with the scratch sel - returned from - MBUTTON.FIND.NEXT.FIELD) + textobj with the scratch sel returned + from MBUTTON.FIND.NEXT.FIELD) (\SHOWSEL SEL NIL NIL) - (replace (SELECTION CH#) of SEL with (fetch (SELECTION CH#) - of FIELDSEL)) + (replace (SELECTION CH#) of SEL with (fetch (SELECTION CH#) of FIELDSEL)) (* Set up SELECTION to be the found - text) - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CHLIM) - of FIELDSEL)) - (replace (SELECTION DCH) of SEL with (fetch (SELECTION DCH) - of FIELDSEL)) + text) + (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CHLIM) of FIELDSEL)) + (replace (SELECTION DCH) of SEL with (fetch (SELECTION DCH) of FIELDSEL)) (replace (SELECTION POINT) of SEL with 'LEFT) (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) @@ -279,16 +261,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (SEL (* There really IS a selection made here, so set up the charlooks for it - properly.) + properly.) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with ( - \TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL]) + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ + SEL]) (\TEDIT.FIND.WC - [LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 9-Dec-88 09:56 by jds") + [LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 9-Dec-88 09:56 by jds") (* ; - "\TEDIT.FIND.WC returns the end char # of the TARGETLIST which may contain wildcards") + "\TEDIT.FIND.WC returns the end char # of the TARGETLIST which may contain wildcards") (PROG (RESULT RESULT1) (RETURN (COND ((SETQ RESULT (\TEDIT.FIND.WC1 TEXTOBJ TARGETLIST START# END#)) @@ -301,11 +282,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 END#]) (\TEDIT.FIND.WC1 - [LAMBDA (TEXTOBJ TARGETLIST TRIALEND# END#) (* ; "Edited 9-Dec-88 09:52 by jds") + [LAMBDA (TEXTOBJ TARGETLIST TRIALEND# END#) (* ; "Edited 9-Dec-88 09:52 by jds") (* ; - "TRIALEND# is where the next char string should go") + "TRIALEND# is where the next char string should go") (* ; - "\TEDIT.FIND.WC1 should return the lastchar# of selection") + "\TEDIT.FIND.WC1 should return the lastchar# of selection") (PROG (RESULT RESULT1) (RETURN (COND ((NULL TARGETLIST) (* ; "DONE!") @@ -324,22 +305,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b '(%#)) (* ; "fixed width wildcard") (COND ((OR (NULL (CDR TARGETLIST)) - (EQUAL (CAR (TEDIT.FIND TEXTOBJ (CONCATLIST ( - \TEDIT.PACK.TARGETLIST - (CDR TARGETLIST))) + (EQUAL (CAR (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST + (CDR TARGETLIST))) (ADD1 TRIALEND#) END# T)) (ADD1 TRIALEND#))) (* ; - "If the next start after a fixed char is the char after it, OK. else return nil") + "If the next start after a fixed char is the char after it, OK. else return nil") (\TEDIT.FIND.WC1 TEXTOBJ (CDR TARGETLIST) (ADD1 TRIALEND#) END#] (T (* ; "variable width wildcard") (COND ((CDR TARGETLIST) - (SETQ RESULT1 (TEDIT.FIND TEXTOBJ (CONCATLIST ( - \TEDIT.PACK.TARGETLIST - (CDR TARGETLIST))) + (SETQ RESULT1 (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST + (CDR TARGETLIST))) TRIALEND# END# T)) (AND RESULT1 (CADR RESULT1))) (T (* ; "last element of search") @@ -347,7 +326,6 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (\TEDIT.PACK.TARGETLIST [LAMBDA (TARGETLIST) (* ; "Edited 24-Sep-87 09:54 by jds") - (COND ((NULL TARGETLIST) NIL) @@ -360,26 +338,25 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (CONS (CAR TARGETLIST) (\TEDIT.PACK.TARGETLIST (CDR TARGETLIST] (T (* ; "wildcard") - (CONS (MKSTRING (CAR TARGETLIST)) (\TEDIT.PACK.TARGETLIST (CDR TARGETLIST]) (\TEDIT.PARSE.SEARCHSTRING - (LAMBDA (LST RESULT) (* jds "31-Jan-84 13:26") - (PROG ((TEDIT.WILDCARD.CHARACTERS '("#" "*"))) + [LAMBDA (LST RESULT) (* jds "31-Jan-84 13:26") + (PROG [(TEDIT.WILDCARD.CHARACTERS '("#" "*"] (RETURN (COND - ((NULL LST) + [(NULL LST) (COND - (RESULT (LIST RESULT)))) - ((MEMBER (CAR LST) + (RESULT (LIST RESULT] + [(MEMBER (CAR LST) TEDIT.WILDCARD.CHARACTERS) (COND - ((NULL RESULT) + [(NULL RESULT) (CONS (MKATOM (CAR LST)) - (\TEDIT.PARSE.SEARCHSTRING (CDR LST)))) + (\TEDIT.PARSE.SEARCHSTRING (CDR LST] (T (APPEND (LIST RESULT (MKATOM (CAR LST))) - (\TEDIT.PARSE.SEARCHSTRING (CDR LST)))))) - ((AND (EQUAL (CAR LST) + (\TEDIT.PARSE.SEARCHSTRING (CDR LST] + [(AND (EQUAL (CAR LST) "'") (LISTP (CDR LST)) (MEMBER (CADR LST) @@ -388,28 +365,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (COND ((NULL RESULT) (MKSTRING (CADR LST))) - (T (CONCAT RESULT (MKSTRING (CADR LST))))))) + (T (CONCAT RESULT (MKSTRING (CADR LST] (T (\TEDIT.PARSE.SEARCHSTRING (CDR LST) (COND ((NULL RESULT) (CAR LST)) - (T (CONCAT RESULT (CAR LST))))))))))) + (T (CONCAT RESULT (CAR LST]) (\TEDIT.SUBST.FN1 [LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 3-Sep-87 11:38 by jds") (* ;  "returns the char location that would match the beginning element of a targetlist") - (PROG (RESULT) (SETQ RESULT (\TEDIT.SUBST.FN2 TEXTOBJ TARGETLIST START# END#)) (RETURN (AND RESULT (IGEQ RESULT START#) RESULT]) (\TEDIT.SUBST.FN2 - [LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* ; "Edited 9-Dec-88 09:54 by jds") + [LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* ; "Edited 9-Dec-88 09:54 by jds") (* ;; - "will return the start char of a wildcarded selection. returns NIL if selection is beyond bounds") + "will return the start char of a wildcarded selection. returns NIL if selection is beyond bounds") (* ;; "TARGETLIST is (what)?") @@ -428,7 +404,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b END#)) (SUB1 SUB-FIND-RESULT))) (T (* ; - "variable width wildcard, so forget them") + "variable width wildcard, so forget them") (\TEDIT.SUBST.FN2 TEXTOBJ (CDR TARGETLIST) TRIALSTART# END#] (T (* ; "it's a string") @@ -436,7 +412,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b TRIALSTART# END# NIL]) (TEDIT.SUBSTITUTE - [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 30-Mar-94 16:04 by jds") + [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 30-Mar-94 16:04 by jds") (* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.") @@ -451,7 +427,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b 'TEDIT.LAST.SUBSTITUTE.STRING) (CHARCODE (EOL LF ESC] (* ; - "If the search pattern is empty, bail out.") + "If the search pattern is empty, bail out.") (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]") (RETURN))) [SETQ REPLACESTRING (OR REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:" @@ -462,142 +438,134 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b ((STRINGP REPLACESTRING) (SETQ REPLACE-LEN (NCHARS REPLACESTRING))) ((LISTP REPLACESTRING) (* ; - "It's a list of pieces, meaning insert these pieces as the replacement.") - (SETQ REPLACE-LEN (for PC in REPLACESTRING sum (fetch (PIECE PLEN) - of PC] + "It's a list of pieces, meaning insert these pieces as the replacement.") + (SETQ REPLACE-LEN (for PC in REPLACESTRING sum (fetch (PIECE PLEN) of PC] (SETQ CRSEEN (AND REPLACESTRING (STRINGP REPLACESTRING) (STRPOS (CHARACTER (CHARCODE CR)) REPLACESTRING))) [COND (PATTERN (* ; - "If a pattern is specd in the call, use the caller's confirm flag.") + "If a pattern is specd in the call, use the caller's confirm flag.") (SETQ CONFIRMFLG CONFIRM?)) (T (* ; "Otherwise, ask for one.") (SETQ CONFIRMFLG (MEMBER (TEDIT.GETINPUT TEXTOBJ "Ask before each replace?" "No" (CHARCODE (EOL SPACE ESCAPE LF TAB))) YESLIST] (TEDIT.PROMPTPRINT TEXTOBJ "Substituting..." T) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))(* ; - "STARTCHAR# and ENDCHAR# are the bound of the search") + (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (* ; + "STARTCHAR# and ENDCHAR# are the bound of the search") (\SHOWSEL SEL NIL NIL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; - "Turn off any blue pending delete") + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "Turn off any blue pending delete") (SETQ BEGINCHAR# (SETQ STARTCHAR# (fetch (SELECTION CH#) of SEL))) [SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (fetch (SELECTION DCH) of SEL] (while (AND (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T)) - (NOT ABORTFLG)) + (NOT ABORTFLG)) do [PROG (PENDING.SEL CHOICE) - (COND - [CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE) - (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE))) - 'RIGHT T)) - (\SHOWSEL PENDING.SEL NIL NIL) - (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL) - (\SHOWSEL PENDING.SEL NIL T) - [SETQ CHOICE (TEDIT.GETINPUT TEXTOBJ "OK to replace? ['q' quits]" - "Yes" (CHARCODE (EOL SPACE ESCAPE LF TAB] - (COND - ((MEMBER CHOICE '("Q" "q")) - (SETQ ABORTFLG T) - (GO L1)) - ((NOT (MEMBER CHOICE YESLIST)) + (COND + [CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE) + (IDIFFERENCE (CADR RANGE) + (SUB1 (CAR RANGE))) + 'RIGHT T)) + (\SHOWSEL PENDING.SEL NIL NIL) + (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL) + (\SHOWSEL PENDING.SEL NIL T) + [SETQ CHOICE (TEDIT.GETINPUT TEXTOBJ "OK to replace? ['q' quits]" + "Yes" (CHARCODE (EOL SPACE ESCAPE LF TAB] + (COND + ((MEMBER CHOICE '("Q" "q")) + (SETQ ABORTFLG T) + (GO L1)) + ((NOT (MEMBER CHOICE YESLIST)) (* ; "turn off selection") - (TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL) - (GO L1)) - (T (* ; "OK to replace") - (TEDIT.DELETE TEXTSTREAM PENDING.SEL) + (TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL) + (GO L1)) + (T (* ; "OK to replace") + (TEDIT.DELETE TEXTSTREAM PENDING.SEL) (* ; "make the replacement") (* ;;;; "This is just wrong in this clause: (COND ((AND REPLACESTRING (NOT (EQUAL REPLACESTRING %"%"))) (* ; %"If the replacestring is nothing, why bother to add nothing%") (TEDIT.INSERT TEXTSTREAM REPLACESTRING (CAR RANGE)) (SETQ ENDCHAR# (IPLUS ENDCHAR# (IDIFFERENCE (NCHARS REPLACESTRING) (IDIFFERENCE (CADR RANGE) (SUB1 (CAR RANGE)))))) (add REPLACEDFLG 1)))") - [AND REPLACESTRING - (OR (IEQP REPLACE-LEN 0) - (COND - ((LISTP REPLACESTRING) + [AND REPLACESTRING + (OR (IEQP REPLACE-LEN 0) + (COND + ((LISTP REPLACESTRING) (* ; "INSERT A RUN OF PIECES") - (\TEDIT.INSERT.PIECES - TEXTOBJ - (CAR RANGE) - (for PC in REPLACESTRING - collect (\TEDIT.COPY.PIECEMAPFN PC - TEXTOBJ TEXTOBJ TEXTOBJ - )) - REPLACE-LEN NIL NIL T NIL T) - (add (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) - REPLACE-LEN)) - (T (TEDIT.INSERT TEXTSTREAM REPLACESTRING - (CAR RANGE] - [SETQ ENDCHAR# (IPLUS ENDCHAR# - (IDIFFERENCE - (OR (AND REPLACESTRING REPLACE-LEN) - 0) - (IDIFFERENCE (CADR RANGE) + (\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE) + (for PC in REPLACESTRING + collect (\TEDIT.COPY.PIECEMAPFN PC + TEXTOBJ TEXTOBJ TEXTOBJ)) + REPLACE-LEN NIL NIL T NIL T) + (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + REPLACE-LEN)) + (T (TEDIT.INSERT TEXTSTREAM REPLACESTRING + (CAR RANGE] + [SETQ ENDCHAR# (IPLUS ENDCHAR# + (IDIFFERENCE (OR (AND REPLACESTRING + REPLACE-LEN) + 0) + (IDIFFERENCE (CADR RANGE) + (SUB1 (CAR RANGE] + (add REPLACEDFLG 1] + (T (* ; + "No confirmation required. Do the substitutions without showing intermediate work") + [replace (TEXTOBJ CARETLOOKS) of TEXTOBJ + with (fetch (PIECE PLOOKS) of (\CHTOPC (CAR RANGE) + (fetch (TEXTOBJ PCTB) + of TEXTOBJ] + (SETQ PC# (\DELETECH (CAR RANGE) + (ADD1 (CADR RANGE)) + (ADD1 (IDIFFERENCE (CADR RANGE) + (CAR RANGE))) + TEXTOBJ)) + (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) + SEL + (CAR RANGE) + (ADD1 (CADR RANGE)) + TEXTOBJ) + [SETQ ENDCHAR# (IDIFFERENCE ENDCHAR# (IDIFFERENCE (CADR RANGE) (SUB1 (CAR RANGE] - (add REPLACEDFLG 1] - (T (* ; - "No confirmation required. Do the substitutions without showing intermediate work") - [replace (TEXTOBJ CARETLOOKS) of TEXTOBJ - with (fetch (PIECE PLOOKS) - of (\CHTOPC (CAR RANGE) - (fetch (TEXTOBJ PCTB) of TEXTOBJ - ] - (SETQ PC# (\DELETECH (CAR RANGE) - (ADD1 (CADR RANGE)) - (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE))) - TEXTOBJ)) - (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) - SEL - (CAR RANGE) - (ADD1 (CADR RANGE)) - TEXTOBJ) - [SETQ ENDCHAR# (IDIFFERENCE ENDCHAR# (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE] (* ; - "Take the length of what we're removing off the end-location, so we don't search too far.") + "Take the length of what we're removing off the end-location, so we don't search too far.") + (COND + ((AND REPLACESTRING (NOT (EQUAL REPLACESTRING ""))) + (* ; + "If the replacestring is nothing, why bother to add nothing") + (\FIXILINES TEXTOBJ SEL (CAR RANGE) + REPLACE-LEN + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (COND - ((AND REPLACESTRING (NOT (EQUAL REPLACESTRING ""))) + [CRSEEN (for ACHAR instring REPLACESTRING as NCH# + from (CAR RANGE) by 1 + do (SELCHARQ ACHAR + (CR (\INSERTCR ACHAR NCH# TEXTOBJ)) + (\INSERTCH ACHAR NCH# TEXTOBJ] + ((LISTP REPLACESTRING) (* ; "INSERT A RUN OF PIECES") + (\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE) + (for PC in REPLACESTRING + collect (\TEDIT.COPY.PIECEMAPFN PC TEXTOBJ TEXTOBJ + TEXTOBJ)) + REPLACE-LEN NIL NIL T NIL T) + (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + REPLACE-LEN)) + (T (\INSERTCH REPLACESTRING (CAR RANGE) + TEXTOBJ))) + (SETQ ENDCHAR# (IPLUS ENDCHAR# REPLACE-LEN)) (* ; - "If the replacestring is nothing, why bother to add nothing") - (\FIXILINES TEXTOBJ SEL (CAR RANGE) - REPLACE-LEN - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (COND - [CRSEEN (for ACHAR instring REPLACESTRING as - NCH# - from (CAR RANGE) by 1 - do (SELCHARQ ACHAR - (CR (\INSERTCR ACHAR NCH# TEXTOBJ)) - (\INSERTCH ACHAR NCH# TEXTOBJ] - ((LISTP REPLACESTRING)(* ; "INSERT A RUN OF PIECES") - (\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE) - (for PC in REPLACESTRING - collect (\TEDIT.COPY.PIECEMAPFN PC TEXTOBJ - TEXTOBJ TEXTOBJ)) - REPLACE-LEN NIL NIL T NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - REPLACE-LEN)) - (T (\INSERTCH REPLACESTRING (CAR RANGE) - TEXTOBJ))) - (SETQ ENDCHAR# (IPLUS ENDCHAR# REPLACE-LEN)) - (* ; - "Now add the length of the replacement string into the ending position, so we go far enough.") - )) - (add REPLACEDFLG 1))) - [SETQ STARTCHAR# (COND - (REPLACESTRING (IPLUS (CAR RANGE) - REPLACE-LEN)) - (T (CAR RANGE] - (RETURN) - L1 + "Now add the length of the replacement string into the ending position, so we go far enough.") + )) + (add REPLACEDFLG 1))) + [SETQ STARTCHAR# (COND + (REPLACESTRING (IPLUS (CAR RANGE) + REPLACE-LEN)) + (T (CAR RANGE] + (RETURN) + L1 - (* ;; - "12/12/88 Should only look at REPLACESTRING when there has been a replacement.") + (* ;; + "12/12/88 Should only look at REPLACESTRING when there has been a replacement.") - (SETQ STARTCHAR# (ADD1 (CAR RANGE] (* ; - "start looking where you left off")) + (SETQ STARTCHAR# (ADD1 (CAR RANGE] (* ; "start looking where you left off") + ) (* ;; "Save the search & replacement strings to offer for next time:") @@ -620,17 +588,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (COND ((AND (NOT CONFIRMFLG) (NOT (ZEROP REPLACEDFLG))) (* ; - "There WERE replacements, and they were not confirmed.") + "There WERE replacements, and they were not confirmed.") (replace (SELECTION CHLIM) of SEL with (ADD1 ENDCHAR#)) (* ; - "account for the changes in selection length due to replacements") + "account for the changes in selection length due to replacements") (replace (SELECTION CH#) of SEL with BEGINCHAR#) (* ; "And remember where it started") - (replace (SELECTION DCH) of SEL with (IDIFFERENCE (fetch (SELECTION - CHLIM) - of SEL) - (fetch (SELECTION CH#) - of SEL))) + (replace (SELECTION DCH) of SEL with (IDIFFERENCE (fetch (SELECTION CHLIM) of SEL) + (fetch (SELECTION CH#) of SEL))) (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (fetch (SELECTION CH#) of SEL) (fetch (SELECTION CHLIM) of SEL)) (TEDIT.UPDATE.SCREEN TEXTOBJ) @@ -638,12 +603,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1994, 2018 b (\SHOWSEL SEL NIL T))) (RETURN REPLACEDFLG]) ) -(PUTPROPS TEDITFIND COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1994 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1472 2819 (\TEDIT.SEARCH.CODETABLE 1482 . 2817)) (2894 39960 (\TEDIT.BASICFIND 2904 . -6485) (TEDIT.FIND 6487 . 11084) (TEDIT.NEW.FIND 11086 . 12716) (TEDIT.NEXT 12718 . 17715) ( -\TEDIT.FIND.WC 17717 . 18692) (\TEDIT.FIND.WC1 18694 . 21673) (\TEDIT.PACK.TARGETLIST 21675 . 22370) ( -\TEDIT.PARSE.SEARCHSTRING 22372 . 23949) (\TEDIT.SUBST.FN1 23951 . 24438) (\TEDIT.SUBST.FN2 24440 . -25816) (TEDIT.SUBSTITUTE 25818 . 39958))))) + (FILEMAP (NIL (1329 2662 (\TEDIT.SEARCH.CODETABLE 1339 . 2660)) (2737 37775 (\TEDIT.BASICFIND 2747 . +6376) (TEDIT.FIND 6378 . 10740) (TEDIT.NEW.FIND 10742 . 12344) (TEDIT.NEXT 12346 . 16787) ( +\TEDIT.FIND.WC 16789 . 17770) (\TEDIT.FIND.WC1 17772 . 20589) (\TEDIT.PACK.TARGETLIST 20591 . 21284) ( +\TEDIT.PARSE.SEARCHSTRING 21286 . 22831) (\TEDIT.SUBST.FN1 22833 . 23319) (\TEDIT.SUBST.FN2 23321 . +24705) (TEDIT.SUBSTITUTE 24707 . 37773))))) STOP diff --git a/library/TEDITFIND.LCOM b/library/tedit/TEDIT-FIND.LCOM similarity index 60% rename from library/TEDITFIND.LCOM rename to library/tedit/TEDIT-FIND.LCOM index 731d038b2bc0b0e4621d9cabce2bd0a25d961bc7..78906c0dedf02d13ca9ece361b39c4d2d130c11f 100644 GIT binary patch delta 762 zcmZ4PcieY^dp#GIhMT94t8FYKlUBo`RABSG7y9cdbonacWVqU3OwYPGX*2PJVJ?j$LkQN=|B}v7V`2d45rL zW?s53M8qy9GpQ)CsM4+^H6^pe4rrHWh_0Jwy`PJowV@`Oy~b9CmR1JlKzovkQsFkI zRumK!t6C}K<(Fgt4OYkmy2LHi$43F#&3bxzN(w27KwGexX=tRRiQ?gUG*v(!n_8Ke zQPGEB4=Na&n_F5aSOo;RhI#sj2J5;2LtBAM$uI*sxDBlgEUXL+DY85-wH!5sLG~MI za!r<36=zkjakM)>6I~Es@_1> zOVwmUF0i?J!J$sUA)X+ za^u2<$WMTT#0@0+030~*0GxOTcmpJMlT-zcT)r8P=I8rn$6uT8TW|KJh^;kDLw5|V zZB&85QlaTh3MC#(z{?7*C?(7Q%XGt&s2}(}2nWCbdQo-vU+x^bhU2RHnr&(=)wFcY zRGUWCG&(}DteOqi)-A^%&aR_59hLNNv}=u4wYXj4NE5lBMe&r3;(5T5!ed1!F>pjD z1)DwS4*)SuzZduuApM{=4gzo|!*DzTES|G07K;q@ybmk=R78=1rKF)B57j4L6nF#G47*;Sp3FH=NkM-Yb;H;v&Qa{elfNVZ5_wFdbRTBNUZl!7h+_X~KO7I|j7dU=DU}P___!d8fO(}XC}pyQv;F=r8O))F z$t-^(qf{kyT2J3fr_gDTc|^^(i_wKNVw3tMEqS$an?ydX{LG|K@^F1065q~lUb#aR=~mMv3wCVn;9w#2EDG%WvX=6b*~aco zU=ckw7g*EMXsOLDYLXutMtV*;o7~H_$e39^n|#bQiT5klrDOAJ*~L4$w02Qe)lCj1 zuk)4Xh_w&fwqx1Lag+q;mfdk0d-XQC-~0Yx>_Z+N_;L6Q^e~RX*cWV;r4~|2vhKYUy4L|2i diff --git a/library/TEDITFNKEYS b/library/tedit/TEDIT-FNKEYS similarity index 67% rename from library/TEDITFNKEYS rename to library/tedit/TEDIT-FNKEYS index 55d7a95e..00471620 100644 --- a/library/TEDITFNKEYS +++ b/library/tedit/TEDIT-FNKEYS @@ -1,26 +1,21 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 8-Aug-2021 21:28:17"  -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITFNKEYS.;2 30663 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS TEDITFNKEYSCOMS) +(FILECREATED "14-Jul-2022 16:55:47"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FNKEYS.;1 29919 - previous date%: " 6-May-2018 17:15:13" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITFNKEYS.;1) + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-FNKEYS.;2) -(* ; " -Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-FNKEYSCOMS) -(PRETTYCOMPRINT TEDITFNKEYSCOMS) - -(RPAQQ TEDITFNKEYSCOMS - ((FILES TEDITDCL) +(RPAQQ TEDIT-FNKEYSCOMS + ((FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (COMS - (* ;; "Functions that actually implement the commands for the function keys:") + (* ;; "Functions that actually implement the commands for the function keys:") (FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV \TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL \TEDIT.FIND @@ -30,14 +25,14 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio \TEDIT.UNDERLINE.SEL.ON \TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL)) (COMS - (* ;; "Auxiliary functions used in the above main functions:") + (* ;; "Auxiliary functions used in the above main functions:") (FNS \TEDIT.BOLD.CARET.OFF \TEDIT.BOLD.CARET.ON \TEDIT.ITALIC.CARET.OFF \TEDIT.ITALIC.CARET.ON \TEDIT.LARGER.CARET \TEDIT.SMALLER.CARET \TEDIT.SUBSCRIPT.CARET \TEDIT.SUPERSCRIPT.CARET \TEDIT.UNDERLINE.CARET.OFF \TEDIT.UNDERLINE.CARET.ON \TEDIT.STRIKEOUT.CARET.OFF \TEDIT.STRIKEOUT.CARET.ON)) - (COMS (* ; - "little selection utilities etc., for building hacks") + (COMS (* ; + "little selection utilities etc., for building hacks") (FNS \SEL.LIMIT \SEL.LINEDESC \TK.DESCRIBEFONT \PARAS.IN.SEL)) [VARS (TEDIT.FNKEY.VERBOSE T) (\TEDIT.KEYS '(("Function,^D" UNDO) @@ -88,12 +83,12 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY] - (* ; "Original was %"(FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))%".") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + (* ; "Original was %"(FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))%".") + (* ; + "Changed by yabu.fx, for SUNLOADUP without DWIM.") )) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -105,7 +100,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) @@ -115,23 +110,25 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (DEFINEQ (\TEDIT.BOLD.SEL.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 6-Nov-87 11:00 by jds") - - (* ;; "Turn boldness off for the selected characters, and for future type-in.") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 6-Nov-87 11:00 by jds") + + (* ;; "Turn boldness off for the selected characters, and for future type-in.") (\TEDIT.BOLD.CARET.OFF TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(WEIGHT MEDIUM) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(WEIGHT MEDIUM) + SEL]) (\TEDIT.BOLD.SEL.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-Nov-87 11:00 by jds") - - (* ;; "Turn boldness on for selected characters and for future type-in.") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-Nov-87 11:00 by jds") + + (* ;; "Turn boldness on for selected characters and for future type-in.") (\TEDIT.BOLD.CARET.ON TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(WEIGHT BOLD) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(WEIGHT BOLD) + SEL]) (\TEDIT.CENTER.SEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") (* ;; "makes the current paragraph centered") @@ -139,19 +136,19 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (SAVEDCH (fetch (SELECTION DCH) of SEL))) (for PARA in (\PARAS.IN.SEL SEL TEXTOBJ) do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA)) - (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) - [SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT JUSTIFIED CENTERED LEFT] - (LISTPUT LOOKS 'QUAD NEWQUAD) - (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) - (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) - (push NEWQUADS NEWQUAD)) + (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) + [SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT JUSTIFIED CENTERED LEFT] + (LISTPUT LOOKS 'QUAD NEWQUAD) + (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) + (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) + (push NEWQUADS NEWQUAD)) (TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH) (COND (TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS) T]) (\TEDIT.CENTER.SEL.REV - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") (* ;; "acts like center.sel but cycles in the opposite direction") @@ -159,21 +156,21 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (SAVEDCH (fetch (SELECTION DCH) of SEL))) (for PARA in (\PARAS.IN.SEL SEL TEXTOBJ) do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA)) - (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) - [SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT CENTERED JUSTIFIED LEFT] - (LISTPUT LOOKS 'QUAD NEWQUAD) - (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) - (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) - (push NEWQUADS NEWQUAD)) + (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) + [SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT CENTERED JUSTIFIED LEFT] + (LISTPUT LOOKS 'QUAD NEWQUAD) + (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) + (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) + (push NEWQUADS NEWQUAD)) (TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH) (COND (TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS) T]) (\TEDIT.DEFAULTS.CARET - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24") (PROGN (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS)) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL)))) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.DEFAULTSSEL [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:12 by jds") @@ -182,21 +179,21 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio SEL]) (\TEDIT.SETDEFAULT.FROM.SEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 8-Nov-85 15:22") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 8-Nov-85 15:22") (* Set the defaults from the current  selection.) (PROG ((LOOKS (TEDIT.GET.LOOKS TEXTSTREAM SEL))) - (SETQ TEDIT.DEFAULT.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS))))) + (SETQ TEDIT.DEFAULT.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS]) (\TEDIT.FIND - [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 6-May-2018 17:14 by rmk:") - (* ; "Edited 30-May-91 21:05 by jds") - (* just calls the normal tedit.find - starting at the right of the current - selection) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 6-May-2018 17:14 by rmk:") + (* ; "Edited 30-May-91 21:05 by jds") + (* just calls the normal tedit.find + starting at the right of the current + selection) (PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - SEL CH W) (* Case sensitive search, with * and - %# wildcards) + SEL CH W) (* Case sensitive search, with * and + %# wildcards) [SETQ W (CAR (MKLIST (fetch (TEXTOBJ \WINDOW) of TEXTOBJ] (CL:WHEN AGAIN (SETQ TARGET (WINDOWPROP W 'TEDIT.LAST.FIND.STRING))) @@ -211,56 +208,54 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING TARGET) NIL NIL T)) (COND - (CH (* We found the target text.) + (CH (* We found the target text.) (TEDIT.PROMPTPRINT TEXTOBJ "Done.") (replace (SELECTION CH#) of SEL with (CAR CH)) - (* Set up SELECTION to be the found - text) + (* Set up SELECTION to be the found + text) (replace (SELECTION CHLIM) of SEL with (ADD1 (CADR CH))) - [replace (SELECTION DCH) of SEL with - (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] + [replace (SELECTION DCH) of SEL with (ADD1 (IDIFFERENCE (CADR CH) + (CAR CH] (replace (SELECTION POINT) of SEL with 'RIGHT) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with ( - \TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS + TEXTOBJ SEL)) (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (* And never pending a deletion.) + (* And never pending a deletion.) (\FIXSEL SEL TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ) (\SHOWSEL SEL NIL T) (WINDOWPROP W 'TEDIT.LAST.FIND.STRING TARGET) - (* And get it into the window) + (* And get it into the window) ) (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") (\SHOWSEL SEL NIL T] (replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with -1]) (\TEDIT.FINDAGAIN - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 17:12 by rmk:") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 17:12 by rmk:") (\TEDIT.FIND TEXTSTREAM TEXTOBJ SEL T]) (\TEDIT.ITALIC.SEL.OFF [LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 20-Oct-87 10:43 by jds") - (\TEDIT.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(SLOPE REGULAR) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(SLOPE REGULAR) + SEL]) (\TEDIT.ITALIC.SEL.ON [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 10:43 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(SLOPE ITALIC) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(SLOPE ITALIC) + SEL]) (\TEDIT.LARGERSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") (COND ((SHIFTDOWNP 'META) (\TEDIT.LARGER.CARET TEXTSTREAM TEXTOBJ SEL)) (T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT 2) - SEL))))) + SEL]) (\TEDIT.LCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") + [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") (* ;; "LOWER-CASEs the selection") @@ -272,21 +267,20 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (TEDIT.INSERT STREAM (L-CASE STR)) (TEDIT.SETSEL STREAM POS LEN POINT) (TEDIT.NORMALIZECARET TEXTOBJ) - (replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) - of TEXTOBJ) with 'LowerCase]) + (replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) + with 'LowerCase]) (\TEDIT.SHOWCARETLOOKS - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:09 by jds") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:09 by jds") (* * comment) (PROG ((LOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ))) (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\TK.DESCRIBEFONT (fetch (CHARLOOKS CLFONT) - of LOOKS)) + of LOOKS)) (COND ((AND (fetch (CHARLOOKS CLOFFSET) of LOOKS) - (NEQ (fetch (CHARLOOKS CLOFFSET) - of LOOKS) + (NEQ (fetch (CHARLOOKS CLOFFSET) of LOOKS) 0)) (CONCAT " offset " (fetch (CHARLOOKS CLOFFSET) of LOOKS))) @@ -303,27 +297,25 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (RETURN]) (\TEDIT.SMALLERSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") (COND ((SHIFTDOWNP 'META) (\TEDIT.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL)) (T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT -2) - SEL))))) + SEL]) (\TEDIT.SUBSCRIPTSEL [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:12 by jds") - (TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT -2) SEL]) (\TEDIT.SUPERSCRIPTSEL [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:13 by jds") - (TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT 2) SEL]) (\TEDIT.UCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") + [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") (* ; "uppercasifies the selection") (PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL)) (POS (fetch (SELECTION CH#) of SEL)) @@ -333,31 +325,31 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (TEDIT.INSERT STREAM (U-CASE STR)) (TEDIT.SETSEL STREAM POS LEN POINT) (TEDIT.NORMALIZECARET TEXTOBJ) - (replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) - of TEXTOBJ) with 'UpperCase]) + (replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) + with 'UpperCase]) (\TEDIT.UNDERLINE.SEL.OFF [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:26 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE OFF) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE OFF) + SEL]) (\TEDIT.UNDERLINE.SEL.ON [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE ON) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE ON) + SEL]) (\TEDIT.STRIKEOUT.SEL.ON [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT ON) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT ON) + SEL]) (\TEDIT.STRIKEOUT.SEL.OFF [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT OFF) SEL]) + (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT OFF) + SEL]) (\TEDIT.SELECT.ALL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:") (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ)) 'LEFT]) ) @@ -369,7 +361,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (DEFINEQ (\TEDIT.BOLD.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT MEDIUM) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -378,7 +370,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.BOLD.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT BOLD) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -387,7 +379,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.ITALIC.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE REGULAR) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -396,7 +388,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.ITALIC.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE ITALIC) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -405,7 +397,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.LARGER.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT 2) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -414,7 +406,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.SMALLER.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT -2) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -423,7 +415,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.SUBSCRIPT.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT -2) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -432,7 +424,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.SUPERSCRIPT.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT 2) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -441,7 +433,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.UNDERLINE.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE OFF) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -450,7 +442,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.UNDERLINE.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE ON) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -459,7 +451,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.STRIKEOUT.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT OFF) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -468,7 +460,7 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.STRIKEOUT.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT ON) (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) TEXTOBJ))) @@ -484,10 +476,10 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (DEFINEQ (\SEL.LIMIT - [LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds") + [LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds") (* returns the character that delimits this selection. - The first char if the point is left else the last) + The first char if the point is left else the last) (COND ((EQ (fetch (SELECTION POINT) of SEL) @@ -496,10 +488,10 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (T (SUB1 (fetch (SELECTION CHLIM) of SEL]) (\SEL.LINEDESC - [LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds") + [LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds") (* returns the first line descriptor - if the point is left, otherwise the - last) + if the point is left, otherwise the + last) (COND [(EQ (fetch (SELECTION POINT) of SEL) 'LEFT) @@ -507,57 +499,54 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (T (CAR (MKLIST (fetch (SELECTION LN) of SEL]) (\TK.DESCRIBEFONT - (LAMBDA (FONT) (* gbn "15-Dec-84 17:54") - - (* * returns a string which describes a font - (in short. If it's not italic then no mention is made of slope, etc.)) + [LAMBDA (FONT) (* gbn "15-Dec-84 17:54") + + (* * returns a string which describes a font + (in short. If it's not italic then no mention is made of slope, etc.)) (CONCAT (L-CASE (FONTPROP FONT 'FAMILY)) " " (FONTPROP FONT 'SIZE) (COND - ((NEQ (FONTPROP FONT 'WEIGHT) + [(NEQ (FONTPROP FONT 'WEIGHT) 'MEDIUM) - (CONCAT " " (L-CASE (FONTPROP FONT 'WEIGHT)))) + (CONCAT " " (L-CASE (FONTPROP FONT 'WEIGHT] (T "")) (COND - ((NEQ (FONTPROP FONT 'SLOPE) + [(NEQ (FONTPROP FONT 'SLOPE) 'REGULAR) - (CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE)))) - (T ""))))) + (CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE] + (T ""]) (\PARAS.IN.SEL - [LAMBDA (SEL TEXTOBJ) (* ; "Edited 30-May-91 21:06 by jds") + [LAMBDA (SEL TEXTOBJ) (* ; "Edited 30-May-91 21:06 by jds") - (* returns a list which contains one character number for each paragraph - included in the selection) + (* returns a list which contains one character number for each paragraph included + in the selection) (PROG ((PARAS) PARAENDED PCS (POS (fetch (SELECTION CH#) of SEL))) (COND ((ZEROP (fetch (SELECTION DCH) of SEL)) - (* there are not really any pieces in this selection, however, effect the - change to the para containing this selection by starting the selection one - character earlier. This is not the right soln, but TEdit has no looks on the - empty last para as yet.) + (* there are not really any pieces in this selection, however, effect the change + to the para containing this selection by starting the selection one character + earlier. This is not the right soln, but TEdit has no looks on the empty last + para as yet.) - (replace (SELECTION CH#) of SEL with (IDIFFERENCE (fetch (SELECTION - CH#) - of SEL) - 1)) + (replace (SELECTION CH#) of SEL with (IDIFFERENCE (fetch (SELECTION CH#) of SEL) + 1)) (replace (SELECTION DCH) of SEL with 1) (\FIXSEL SEL TEXTOBJ))) (SETQ PCS (TEDIT.SELECTED.PIECES TEXTOBJ SEL)) (* to include the first char) (SETQ PARAENDED T) (for PC in PCS do (COND - (PARAENDED (* the last piece ended a paragraph, - so include this character in the - list) - (SETQ PARAENDED NIL) - (push PARAS POS))) - (SETQ PARAENDED (fetch (PIECE PPARALAST) of PC)) - (add POS (fetch (PIECE PLEN) of PC))) + (PARAENDED (* the last piece ended a paragraph, + so include this character in the list) + (SETQ PARAENDED NIL) + (push PARAS POS))) + (SETQ PARAENDED (fetch (PIECE PPARALAST) of PC)) + (add POS (fetch (PIECE PLEN) of PC))) (RETURN (DREVERSE PARAS]) ) @@ -625,22 +614,21 @@ Copyright (c) 1985-1987, 1990-1991, 1994, 2018, 2021 by Venue & Xerox Corporatio (* ; "Changed by yabu.fx, for SUNLOADUP without DWIM.") -(PUTPROPS TEDITFNKEYS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1991 1994 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5854 18888 (\TEDIT.BOLD.SEL.OFF 5864 . 6203) (\TEDIT.BOLD.SEL.ON 6205 . 6534) ( -\TEDIT.CENTER.SEL 6536 . 7591) (\TEDIT.CENTER.SEL.REV 7593 . 8673) (\TEDIT.DEFAULTS.CARET 8675 . 8959) - (\TEDIT.DEFAULTSSEL 8961 . 9284) (\TEDIT.SETDEFAULT.FROM.SEL 9286 . 9725) (\TEDIT.FIND 9727 . 13090) -(\TEDIT.FINDAGAIN 13092 . 13266) (\TEDIT.ITALIC.SEL.OFF 13268 . 13510) (\TEDIT.ITALIC.SEL.ON 13512 . -13695) (\TEDIT.LARGERSEL 13697 . 13992) (\TEDIT.LCASE.SEL 13994 . 14745) (\TEDIT.SHOWCARETLOOKS 14747 - . 16387) (\TEDIT.SMALLERSEL 16389 . 16687) (\TEDIT.SUBSCRIPTSEL 16689 . 16893) (\TEDIT.SUPERSCRIPTSEL - 16895 . 17100) (\TEDIT.UCASE.SEL 17102 . 17909) (\TEDIT.UNDERLINE.SEL.OFF 17911 . 18099) ( -\TEDIT.UNDERLINE.SEL.ON 18101 . 18287) (\TEDIT.STRIKEOUT.SEL.ON 18289 . 18475) ( -\TEDIT.STRIKEOUT.SEL.OFF 18477 . 18665) (\TEDIT.SELECT.ALL 18667 . 18886)) (18960 24400 ( -\TEDIT.BOLD.CARET.OFF 18970 . 19418) (\TEDIT.BOLD.CARET.ON 19420 . 19865) (\TEDIT.ITALIC.CARET.OFF -19867 . 20317) (\TEDIT.ITALIC.CARET.ON 20319 . 20767) (\TEDIT.LARGER.CARET 20769 . 21217) ( -\TEDIT.SMALLER.CARET 21219 . 21669) (\TEDIT.SUBSCRIPT.CARET 21671 . 22125) (\TEDIT.SUPERSCRIPT.CARET -22127 . 22582) (\TEDIT.UNDERLINE.CARET.OFF 22584 . 23037) (\TEDIT.UNDERLINE.CARET.ON 23039 . 23490) ( -\TEDIT.STRIKEOUT.CARET.OFF 23492 . 23945) (\TEDIT.STRIKEOUT.CARET.ON 23947 . 24398)) (24469 28217 ( -\SEL.LIMIT 24479 . 24917) (\SEL.LINEDESC 24919 . 25515) (\TK.DESCRIBEFONT 25517 . 26232) ( -\PARAS.IN.SEL 26234 . 28215))))) + (FILEMAP (NIL (5737 18485 (\TEDIT.BOLD.SEL.OFF 5747 . 6085) (\TEDIT.BOLD.SEL.ON 6087 . 6415) ( +\TEDIT.CENTER.SEL 6417 . 7458) (\TEDIT.CENTER.SEL.REV 7460 . 8526) (\TEDIT.DEFAULTS.CARET 8528 . 8806) + (\TEDIT.DEFAULTSSEL 8808 . 9131) (\TEDIT.SETDEFAULT.FROM.SEL 9133 . 9565) (\TEDIT.FIND 9567 . 12789) +(\TEDIT.FINDAGAIN 12791 . 12969) (\TEDIT.ITALIC.SEL.OFF 12971 . 13223) (\TEDIT.ITALIC.SEL.ON 13225 . +13418) (\TEDIT.LARGERSEL 13420 . 13708) (\TEDIT.LCASE.SEL 13710 . 14416) (\TEDIT.SHOWCARETLOOKS 14418 + . 15994) (\TEDIT.SMALLERSEL 15996 . 16287) (\TEDIT.SUBSCRIPTSEL 16289 . 16492) (\TEDIT.SUPERSCRIPTSEL + 16494 . 16698) (\TEDIT.UCASE.SEL 16700 . 17462) (\TEDIT.UNDERLINE.SEL.OFF 17464 . 17662) ( +\TEDIT.UNDERLINE.SEL.ON 17664 . 17860) (\TEDIT.STRIKEOUT.SEL.ON 17862 . 18058) ( +\TEDIT.STRIKEOUT.SEL.OFF 18060 . 18258) (\TEDIT.SELECT.ALL 18260 . 18483)) (18557 24045 ( +\TEDIT.BOLD.CARET.OFF 18567 . 19019) (\TEDIT.BOLD.CARET.ON 19021 . 19470) (\TEDIT.ITALIC.CARET.OFF +19472 . 19926) (\TEDIT.ITALIC.CARET.ON 19928 . 20380) (\TEDIT.LARGER.CARET 20382 . 20834) ( +\TEDIT.SMALLER.CARET 20836 . 21290) (\TEDIT.SUBSCRIPT.CARET 21292 . 21750) (\TEDIT.SUPERSCRIPT.CARET +21752 . 22211) (\TEDIT.UNDERLINE.CARET.OFF 22213 . 22670) (\TEDIT.UNDERLINE.CARET.ON 22672 . 23127) ( +\TEDIT.STRIKEOUT.CARET.OFF 23129 . 23586) (\TEDIT.STRIKEOUT.CARET.ON 23588 . 24043)) (24114 27576 ( +\SEL.LIMIT 24124 . 24568) (\SEL.LINEDESC 24570 . 25174) (\TK.DESCRIBEFONT 25176 . 25866) ( +\PARAS.IN.SEL 25868 . 27574))))) STOP diff --git a/library/TEDITFNKEYS.LCOM b/library/tedit/TEDIT-FNKEYS.LCOM similarity index 94% rename from library/TEDITFNKEYS.LCOM rename to library/tedit/TEDIT-FNKEYS.LCOM index 626820acb367c1553cac27051db882f464446c7f..8d4d2dbaaea6951a2c804e6d6fe547fa82e9967a 100644 GIT binary patch delta 570 zcmZ2px~*h_TfHV1mxi0CkE?T#t7C|(i-MA&iLO^^j;@h`k&%L-nU$%zm5HU2f`(FZ zer`c#PHKumex8Do0#~(5uy?IZX>n>%v0ZjzK~7?xT~2;-Vvb#IYD!LOrLmr=U3q>{ zc4l6>E=0sGCo`!iv8d9nBsC?o#13eeXNay_y`Q&hWU!vKp{4>Cs@29;hL%f@t;>}owdJtc*dM4&xb%``Mp(uDiD9=oSa ztxSM6Q_GVuKPnhmS{hm^SOo;RhI#sj2J5;w=7qSTJJQg~z{1MFkRt2zQp-_-8R`O~ z%??bQYErsxV7{}zZ!j<C#JrG^7Dm!{_AJs{rZD;gf$KuX3$ LfsMt_(}xQH{SB$B delta 679 zcmb7?QA@&56vv?;Xub7RFL4+ocMlHl)Tt{*W4e@Pu5C&^PQB=G?#i5zMEDhoK18p9 z(0Axtb>|8!3hd<%_j2z4{Ql>jxA=09ik2;#|0Jk;+z14IC zm_+2(r?cq_p4IUnXPe%fO&ga1my{$x{#P*R-!sQcytSLjrC+dW&mr5=uCCw*7NFGz zIO+ZK7@chk0{8ri4wmnzzPH>jz|II+ZP&6})@N1f3VO@Bu^Z=g7ZBee;fz2Au1Q4i mK&R1!MqcdGkOy2T7ZZ^aDKV+!62XZSU==>uH`evCVR9cO5W{i+ diff --git a/library/TEDITHCPY b/library/tedit/TEDIT-HCPY similarity index 58% rename from library/TEDITHCPY rename to library/tedit/TEDIT-HCPY index 89c32ff2..a963600e 100644 --- a/library/TEDITHCPY +++ b/library/tedit/TEDIT-HCPY @@ -1,24 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Jan-2022 23:03:27" {DSK}kaplan>Local>medley3.5>my-medley>library>TEDITHCPY.;15 106802 +(FILECREATED "14-Jul-2022 16:55:47"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-HCPY.;1 102257 - :CHANGES-TO (VARS TEDITHCPYCOMS) - - :PREVIOUS-DATE "27-Sep-2021 23:28:48" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITHCPY.;14) + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-HCPY.;2) -(* ; " -Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-HCPYCOMS) -(PRETTYCOMPRINT TEDITHCPYCOMS) - -(RPAQQ TEDITHCPYCOMS - ((FILES TEDITDCL) +(RPAQQ TEDIT-HCPYCOMS + ((FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (COMS (* ;; "Generic interface functions and common code") @@ -65,7 +60,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (FNS TEDIT-BOOK)))) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -77,7 +72,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) @@ -89,30 +84,28 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (TEDIT.HARDCOPY [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS) (* ; "Edited 5-Jan-88 16:09 by jds") - - (* ;; "Send the text to the printer.") + + (* ;; "Send the text to the printer.") (COND [(OR SERVER DEFAULTPRINTINGHOST) - - (* ;; "We can only hardcopy if there is a server specified, or the system will give us a reasonable default one.") + + (* ;; "We can only hardcopy if there is a server specified, or the system will give us a reasonable default one.") (for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER) - 'CANPRINT) - do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER - PRINTOPTIONS IMAGETYPE)) finally (ERROR (CONCAT - "Can't print TEDIT documents on a " - (PRINTERTYPE - SERVER) - " printer."] + 'CANPRINT) + do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS + IMAGETYPE)) finally (ERROR (CONCAT "Can't print TEDIT documents on a " + (PRINTERTYPE SERVER) + " printer."] (T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM) "Can't HARDCOPY: No print server specified." T]) (TEDIT.HCPYFILE - [LAMBDA (STREAM FILE BREAKPAGETITLE) (* ; "Edited 12-Jun-90 18:36 by mitani") + [LAMBDA (STREAM FILE BREAKPAGETITLE) (* ; "Edited 12-Jun-90 18:36 by mitani") - (* Create a hardcopy-format FILE from the text on STREAM, with the file type - depending on what the default printer is.) + (* Create a hardcopy-format FILE from the text on STREAM, with the file type + depending on what the default printer is.) (LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE) 'CANPRINT] @@ -123,11 +116,9 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (CONCAT IMAGETYPE " file name: ") (COND ((type? STREAM (SETQ TXTFILE - (fetch - (TEXTOBJ TXTFILE) - of TEXTOBJ))) - (* There was a file, so supply - default) + (fetch (TEXTOBJ TXTFILE) + of TEXTOBJ))) + (* There was a file, so supply default) (PACKFILENAME 'VERSION NIL 'EXTENSION (SELECTQ IMAGETYPE (PRESS 'PRESS) @@ -139,7 +130,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (TEDIT.FORMAT.HARDCOPY STREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE]) (\TEDIT.HARDCOPY.DISPLAYLINE - [LAMBDA (TEXTOBJ LINE THISLINE REGION PRSTREAM) (* ; "Edited 29-Mar-94 13:44 by jds") + [LAMBDA (TEXTOBJ LINE THISLINE REGION PRSTREAM) (* ; "Edited 29-Mar-94 13:44 by jds") (* ;; "Display LINE on the HARDCOPY file under way.") @@ -147,51 +138,46 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (PROG ((CH 0) (CHLIST (fetch CHARS of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) - (WLIST (fetch (THISLINE WIDTHS) of (OR (fetch (LINEDESCRIPTOR CACHE) - of LINE) - THISLINE))) + THISLINE))) + (WLIST (fetch (THISLINE WIDTHS) of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) + THISLINE))) (LOOKS (fetch LOOKS of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) + THISLINE))) (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (LEFTMARGIN (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) (STREAMSCALE (DSPSCALE NIL PRSTREAM)) (LINELEN (fetch LEN of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) + THISLINE))) OLOOKS LOOKSTARTX FONT OFONT CURRENTY FIRST-SCALED-CHAR KERN) (COND ((ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) TEXTLEN) (* ; - "Only display the line if it appears before the end of the text!") + "Only display the line if it appears before the end of the text!") (COND - ((fetch (LINEDESCRIPTOR CACHE) of LINE) - (* ; - "This line was cached. Don';t need to re-compute the breaks &c") + ((fetch (LINEDESCRIPTOR CACHE) of LINE) (* ; + "This line was cached. Don';t need to re-compute the breaks &c") ) ((NEQ (fetch DESC of THISLINE) LINE) (* ; "Format the line to our specs") (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) (fetch (LINEDESCRIPTOR CHAR1) of LINE) THISLINE LINE NIL PRSTREAM))) (* ; - "Use the characters cached in THISLINE.") + "Use the characters cached in THISLINE.") (SETQ OLOOKS (\EDITELT LOOKS 0)) (COND - ((ZEROP (SETQ FIRST-SCALED-CHAR (fetch (THISLINE TLFIRSTSPACE) of THISLINE)) - ) (* ; - "For expanding spaces to justify a line") + ((ZEROP (SETQ FIRST-SCALED-CHAR (fetch (THISLINE TLFIRSTSPACE) of THISLINE))) + (* ; + "For expanding spaces to justify a line") (DSPSPACEFACTOR (fetch (THISLINE TLSPACEFACTOR) of THISLINE) PRSTREAM) (SETQ FIRST-SCALED-CHAR -1))) (MOVETO LEFTMARGIN [SETQ CURRENTY (COND - [(AND (fetch (CHARLOOKS CLOFFSET) of - OLOOKS) + [(AND (fetch (CHARLOOKS CLOFFSET) of OLOOKS) (NEQ 0 (fetch (CHARLOOKS CLOFFSET) of OLOOKS))) - (IPLUS (fetch (LINEDESCRIPTOR YBASE) - of LINE) + (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) (FIXR (FTIMES STREAMSCALE - (fetch (CHARLOOKS - CLOFFSET) + (fetch (CHARLOOKS CLOFFSET) of OLOOKS] (T (fetch (LINEDESCRIPTOR YBASE) of LINE] PRSTREAM) @@ -204,158 +190,156 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (STREAMPROP PRSTREAM 'KERN KERN) (SETQ LOOKSTARTX LEFTMARGIN) (while (EQ (CHARCODE SPACE) - (\EDITELT CHLIST LINELEN)) do - (* ; - "Trim any trailing blanks off the line, to avoid the INTERPRESS CORRECT bug that they cause.") - (add LINELEN -1)) + (\EDITELT CHLIST LINELEN)) do (* ; + "Trim any trailing blanks off the line, to avoid the INTERPRESS CORRECT bug that they cause.") + (add LINELEN -1)) (bind (LOOKNO _ 1) - (TX _ LEFTMARGIN) - DX for I from 0 to LINELEN + (TX _ LEFTMARGIN) + DX for I from 0 to LINELEN do (SETQ CH (\EDITELT CHLIST I)) - (SETQ DX (\EDITELT WLIST I)) - [COND - ((EQ I FIRST-SCALED-CHAR) (* ; "Time to turn on space scaling.") - (DSPSPACEFACTOR (fetch (THISLINE TLSPACEFACTOR) of THISLINE) - PRSTREAM) - (LET ((X (DSPXPOSITION NIL PRSTREAM)) - (Y (DSPYPOSITION NIL PRSTREAM))) - (MOVETO 0 0 PRSTREAM) - (MOVETO X Y PRSTREAM] - [SELECTC CH - (LMInvisibleRun - (* ;; - "An INVISIBLE run -- skip it, and skip over the char count:") + (SETQ DX (\EDITELT WLIST I)) + [COND + ((EQ I FIRST-SCALED-CHAR) (* ; "Time to turn on space scaling.") + (DSPSPACEFACTOR (fetch (THISLINE TLSPACEFACTOR) of THISLINE) + PRSTREAM) + (LET ((X (DSPXPOSITION NIL PRSTREAM)) + (Y (DSPYPOSITION NIL PRSTREAM))) + (MOVETO 0 0 PRSTREAM) + (MOVETO X Y PRSTREAM] + [SELECTC CH + (LMInvisibleRun + (* ;; + "An INVISIBLE run -- skip it, and skip over the char count:") - (add LOOKNO 1)) - (LMLooksChange + (add LOOKNO 1)) + (LMLooksChange (* ;; "Change in character looks. Do any cleanup (like underlining) for the prior characters, and set up the new looks, like font:") - (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX - (fetch (LINEDESCRIPTOR YBASE) of LINE) - OLOOKS PRSTREAM) - (DSPFONT (fetch (CHARLOOKS CLFONT) - of (SETQ OLOOKS (\EDITELT LOOKS LOOKNO))) - PRSTREAM) - (add LOOKNO 1) - (DSPYPOSITION - [SETQ CURRENTY - (COND - [(AND (fetch (CHARLOOKS CLOFFSET) of OLOOKS) - (NEQ 0 (fetch (CHARLOOKS CLOFFSET) - of OLOOKS))) - (IPLUS (fetch (LINEDESCRIPTOR YBASE) of - LINE) - (FIXR (FTIMES STREAMSCALE (fetch - (CHARLOOKS CLOFFSET - ) - of OLOOKS] - (T (fetch (LINEDESCRIPTOR YBASE) of LINE] - PRSTREAM) - [COND - ((SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) - of OLOOKS) - 'KERN)) - (SETQ KERN (FIXR (FTIMES STREAMSCALE KERN] - (STREAMPROP PRSTREAM 'KERN KERN) - (SETQ LOOKSTARTX TX)) - ((CHARCODE SPACE) - (* ;; - "Space: Just print it, because we set up the space adjustment to do justification.") - - (* ; - "(DSPXPOSITION (IPLUS TX DX) PRSTREAM)") - (\OUTCHAR PRSTREAM CH)) - ((CHARCODE (TAB %#^I)) - (* ;; - "TAB: use the width from the cache to decide the right formatting:") - - [COND - ((OR (IEQP CH (CHARCODE %#^I)) - (fetch (CHARLOOKS CLLEADER) of OLOOKS) - (EQ (fetch (CHARLOOKS CLUSERINFO) of OLOOKS) - 'DOTTEDLEADER)) - - (* ;; - "Dotted leaders are meta-TAB, or have the DOTTEDLEADER looks.") - - (LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.) - (FONTCOPY (fetch (CHARLOOKS CLFONT) - of OLOOKS) - 'DEVICE PRSTREAM))) - (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH - (IREMAINDER TX DOTWIDTH] - (DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH) - PRSTREAM) (* ; - "Move over to the next even multiple of a dot's width.") - (while (ILEQ TTX (IPLUS TX DX)) - do (* ; - "Print enough dots to fill the TAB's gap.") - (\OUTCHAR PRSTREAM (CHARCODE %.)) - (add TTX DOTWIDTH] - (DSPXPOSITION (IPLUS TX DX) - PRSTREAM)) - ((CHARCODE CR) + (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX + (fetch (LINEDESCRIPTOR YBASE) of LINE) + OLOOKS PRSTREAM) + (DSPFONT (fetch (CHARLOOKS CLFONT) of (SETQ OLOOKS + (\EDITELT LOOKS LOOKNO) + )) + PRSTREAM) + (add LOOKNO 1) + (DSPYPOSITION [SETQ CURRENTY + (COND + [(AND (fetch (CHARLOOKS CLOFFSET) + of OLOOKS) + (NEQ 0 (fetch (CHARLOOKS CLOFFSET) + of OLOOKS))) + (IPLUS (fetch (LINEDESCRIPTOR YBASE) + of LINE) + (FIXR (FTIMES STREAMSCALE + (fetch (CHARLOOKS + CLOFFSET) + of OLOOKS] + (T (fetch (LINEDESCRIPTOR YBASE) + of LINE] + PRSTREAM) + [COND + ((SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) + of OLOOKS) + 'KERN)) + (SETQ KERN (FIXR (FTIMES STREAMSCALE KERN] + (STREAMPROP PRSTREAM 'KERN KERN) + (SETQ LOOKSTARTX TX)) + ((CHARCODE SPACE) (* ;; - "Do nothing for carriage return, since it ends the line.") + "Space: Just print it, because we set up the space adjustment to do justification.") - NIL) - (NIL - (* ;; "Do nothing if it's NIL, which signals a character we deleted during line formatting (e.g., an unused discretionary hyphen)") - - NIL) - (COND - [(SMALLP CH) (* ; - "CH is a char code, just print it") - (COND - ((AND (IGEQ CH 192) - (ILEQ CH 207)) (* ; "This is an NS accent character. Readjust our position with MOVETO, so that the accent overprints the next character.") - (MOVETO (+ TX (RSH (- (\EDITELT WLIST (ADD1 I)) - DX) - 1)) - CURRENTY PRSTREAM) - (\OUTCHAR PRSTREAM CH) - (MOVETO TX CURRENTY PRSTREAM) - (SETQ DX 0)) - (T (\OUTCHAR PRSTREAM CH] - (T (* ; "CH is an object.") - - (* ;; "Add SETXY command to PRSTREAM,to avoid the XP-9's BUG") - - (DSPXPOSITION (IPLUS TX 1) - PRSTREAM) - (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN) - CH PRSTREAM (IMAGESTREAMTYPE PRSTREAM) - TEXTOBJ) - (MOVETO (IPLUS TX DX) - CURRENTY PRSTREAM] - (add TX DX) finally - - (* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:") - - (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX - (fetch (LINEDESCRIPTOR YBASE) of LINE) - OLOOKS PRSTREAM) - (COND - ((fetch (FMTSPEC FMTREVISED) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) (* ; - "This paragraph has been revised, so mark it.") - (\TEDIT.MARK.REVISION TEXTOBJ (fetch - (LINEDESCRIPTOR + "(DSPXPOSITION (IPLUS TX DX) PRSTREAM)") + (\OUTCHAR PRSTREAM CH)) + ((CHARCODE (TAB %#^I)) + (* ;; + "TAB: use the width from the cache to decide the right formatting:") + + [COND + ((OR (IEQP CH (CHARCODE %#^I)) + (fetch (CHARLOOKS CLLEADER) of OLOOKS) + (EQ (fetch (CHARLOOKS CLUSERINFO) of OLOOKS) + 'DOTTEDLEADER)) + + (* ;; "Dotted leaders are meta-TAB, or have the DOTTEDLEADER looks.") + + (LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.) + (FONTCOPY (fetch (CHARLOOKS CLFONT) + of OLOOKS) + 'DEVICE PRSTREAM))) + (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH + (IREMAINDER TX DOTWIDTH] + (DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH) + PRSTREAM) (* ; + "Move over to the next even multiple of a dot's width.") + (while (ILEQ TTX (IPLUS TX DX)) + do (* ; + "Print enough dots to fill the TAB's gap.") + (\OUTCHAR PRSTREAM (CHARCODE %.)) + (add TTX DOTWIDTH] + (DSPXPOSITION (IPLUS TX DX) + PRSTREAM)) + ((CHARCODE CR) + (* ;; + "Do nothing for carriage return, since it ends the line.") + + NIL) + (NIL + (* ;; "Do nothing if it's NIL, which signals a character we deleted during line formatting (e.g., an unused discretionary hyphen)") + + NIL) + (COND + [(SMALLP CH) (* ; "CH is a char code, just print it") + (COND + ((AND (IGEQ CH 192) + (ILEQ CH 207)) (* ; "This is an NS accent character. Readjust our position with MOVETO, so that the accent overprints the next character.") + (MOVETO (+ TX (RSH (- (\EDITELT WLIST (ADD1 I)) + DX) + 1)) + CURRENTY PRSTREAM) + (\OUTCHAR PRSTREAM CH) + (MOVETO TX CURRENTY PRSTREAM) + (SETQ DX 0)) + (T (\OUTCHAR PRSTREAM CH] + (T (* ; "CH is an object.") + + (* ;; "Add SETXY command to PRSTREAM,to avoid the XP-9's BUG") + + (DSPXPOSITION (IPLUS TX 1) + PRSTREAM) + (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN) + CH PRSTREAM (IMAGESTREAMTYPE PRSTREAM) + TEXTOBJ) + (MOVETO (IPLUS TX DX) + CURRENTY PRSTREAM] + (add TX DX) finally + + (* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:") + + (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX + (fetch (LINEDESCRIPTOR YBASE) of LINE) + OLOOKS PRSTREAM) + (COND + ((fetch (FMTSPEC FMTREVISED) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE) - PRSTREAM LINE]) + of LINE)) + (* ; + "This paragraph has been revised, so mark it.") + (\TEDIT.MARK.REVISION TEXTOBJ (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE) + PRSTREAM LINE]) (\TEDIT.HARDCOPY.FORMATLINE - [LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING? PAGEINFO) - (* ; "Edited 28-Jun-2021 12:34 by rmk:") + [LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING? PAGEINFO) + (* ; "Edited 28-Jun-2021 12:34 by rmk:") -(* ;;; "Given a starting place, format the next line of text. Return T if a control-L was seen on the line.") +(* ;;; "Given a starting place, format the next line of text. Return T if a control-L was seen on the line.") - (DECLARE (SPECVARS LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST - WLIST DEVICE NEWASCENT NEWDESCENT IMAGESTREAM)) + (DECLARE (SPECVARS LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST + WLIST DEVICE NEWASCENT NEWDESCENT IMAGESTREAM)) (PROG ((TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (CH#B CH#1) (CHNO CH#1) @@ -373,171 +357,162 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO CTRL\L\SEEN 1STLN FMTSPEC NEWASCENT NEWDESCENT PREVHYPH PREVDHYPH ORIGCHLIST ORIGWLIST) - (* ;; "Variables:") + (* ;; "Variables:") - (* ;; "(TLEN = Current character count on the line)") + (* ;; "(TLEN = Current character count on the line)") - (* ;; "(CHNO = Current character # in the Text)") + (* ;; "(CHNO = Current character # in the Text)") - (* ;; "(DX = width of current char/object)") + (* ;; "(DX = width of current char/object)") - (* ;; "(TX = current right margin) ") + (* ;; "(TX = current right margin) ") - (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ") + (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ") - (* ;; "(CH#B = The CHNO of most recent space/tab)") + (* ;; "(CH#B = The CHNO of most recent space/tab)") - (* ;; "(TXB = right margin of most recent space/tab)") + (* ;; "(TXB = right margin of most recent space/tab)") - (* ;; "(DXB = width of most recent space/tab)") + (* ;; "(DXB = width of most recent space/tab)") - (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)") + (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)") - (* ;; "(T1SPACE = a space/CR/TAB has been seen)") + (* ;; "(T1SPACE = a space/CR/TAB has been seen)") - (* ;; "(#BLANKS = # of spaces/tabs seen) ") + (* ;; "(#BLANKS = # of spaces/tabs seen) ") - (* ;; "(LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)") + (* ;; "(LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)") - (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)") + (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)") - (* ;; "(ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential line break point)") + (* ;; "(ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential line break point)") - [SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch CHARS of - THISLINE] - (* ; - "Place to put character codes/objects") - [SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS) - of THISLINE] - (* ; "Place to put width of each item") + [SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch CHARS of THISLINE] + (* ; + "Place to put character codes/objects") + [SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS) of THISLINE] + (* ; "Place to put width of each item") (SETQ LOOKS (fetch LOOKS of THISLINE)) (SETQ TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) (SETQ TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) (replace LOOKSUPDATEFN of TEXTSTREAM with (FUNCTION \TEDIT.HCPYLOOKS.UPDATE)) - (* ; - "This gets called every time we cross a piece boundary, to check for changes in looks.") + (* ; + "This gets called every time we cross a piece boundary, to check for changes in looks.") (freplace (LINEDESCRIPTOR CHARLIM) of LINE with TEXTLEN) - (* ; - "Force each new line to find its true CHARLIM.") + (* ; + "Force each new line to find its true CHARLIM.") (freplace (LINEDESCRIPTOR CHAR1) of LINE with CH#1) - (freplace (LINEDESCRIPTOR CR\END) of LINE with NIL) - (* ; "Assume we won't see a CR.") + (freplace (LINEDESCRIPTOR CR\END) of LINE with NIL)(* ; "Assume we won't see a CR.") (replace (LINEDESCRIPTOR LHASTABS) of LINE with NIL) - (* ; "And has no TABs.") - (replace (LINEDESCRIPTOR LSTLN) of LINE with NIL) - (* ; - "And assume it isn't the last line in a paragraph until we find otherwise.") + (* ; "And has no TABs.") + (replace (LINEDESCRIPTOR LSTLN) of LINE with NIL) (* ; + "And assume it isn't the last line in a paragraph until we find otherwise.") (replace (THISLINE TLFIRSTSPACE) of THISLINE with 0) - (* ; - "Start out assuming that all spaces on the line will be scaled.") + (* ; + "Start out assuming that all spaces on the line will be scaled.") (COND [(COND ((AND (ILEQ CH#1 TEXTLEN) - (NOT (ZEROP TEXTLEN))) (* ; - "Only continue if there's really text we can format.") - (\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place") - (* ; "And starting character looks") + (NOT (ZEROP TEXTLEN))) (* ; + "Only continue if there's really text we can format.") + (\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place") + (* ; "And starting character looks") (SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM)) [COND ((fetch (CHARLOOKS CLINVISIBLE) of CLOOKS) - (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") + (* ; + "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") (SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) - (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN) - of PC))) + (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN) of PC))) (\RPLPTR CHLIST 0 401) (\RPLPTR WLIST 0 0) (add TLEN 1) (SETQ CHLIST (\ADDBASE CHLIST 2)) (SETQ WLIST (\ADDBASE WLIST 2)) (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) + (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) PC TEXTOBJ))) [while (AND PC (fetch (CHARLOOKS CLINVISIBLE) of CLOOKS)) - do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch - (PIECE PLEN) - of PC))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ] + do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch (PIECE PLEN) + of PC))) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) + of PC) + PC TEXTOBJ] (add CHNO (\EDITELT LOOKS LOOKNO)) (COND - (PC (* ; - "Move us to the right place in the stream") + (PC (* ; + "Move us to the right place in the stream") (\SETUPGETCH (create EDITMARK PC _ PC PCOFF _ 0 PCNO _ NIL) TEXTOBJ)) - (T (* ; - "We've walked off the end of the document. Just note that we're not at any piece now.") + (T (* ; + "We've walked off the end of the document. Just note that we're not at any piece now.") (replace (TEXTSTREAM PIECE) of TEXTSTREAM with NIL] (ILEQ CHNO TEXTLEN))) - (\TEDIT.HCPYLOOKS.UPDATE TEXTSTREAM (fetch (TEXTSTREAM PIECE) of TEXTSTREAM - ) + (\TEDIT.HCPYLOOKS.UPDATE TEXTSTREAM (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) CLOOKS) (SETQ ASCENTB ASCENT) (SETQ DESCENTB DESCENT) - (\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache") + (\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache") (SETQ FONT (fetch (CHARLOOKS CLFONT) of CLOOKS)) [SETQ FONT (COND ((AND (type? FONTCLASS FONT) (FONTCLASSCOMPONENT FONT DEVICE))) - (T (FONTCOPY FONT 'DEVICE DEVICE](* ; - "Keep the font around for char widths.") - (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (\TEDIT.APPLY.PARASTYLES - (OR (fetch (TEXTSTREAM CURRENTPARALOOKS) - of TEXTSTREAM) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) - ) - PC TEXTOBJ) - IMAGESTREAM)) (* ; "Paragraph formatting info") + (T (FONTCOPY FONT 'DEVICE DEVICE](* ; + "Keep the font around for char widths.") + (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (\TEDIT.APPLY.PARASTYLES (OR (fetch (TEXTSTREAM + CURRENTPARALOOKS + ) of TEXTSTREAM) + (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + PC TEXTOBJ) + IMAGESTREAM)) (* ; "Paragraph formatting info") (COND ((AND (NEQ FMTSPEC *TEDIT-CACHED-FMTSPEC*) (fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC)) - (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.") + (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.") (SETQ *TEDIT-CURRENTPARA-CACHE* NIL) (SETQ *TEDIT-CACHED-FMTSPEC* FMTSPEC))) [SETQ 1STLN (OR (IEQP CH#1 1) (AND (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) - (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM)) + (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) of + TEXTSTREAM + )) (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) - of (fetch - (TEXTSTREAM PIECE) - of TEXTSTREAM - ))) + of (fetch (TEXTSTREAM PIECE) + of TEXTSTREAM))) (IEQP (fetch (TEXTSTREAM PCSTARTCH) of TEXTSTREAM) (fetch (STREAM COFFSET) of TEXTSTREAM)) (IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM) (fetch (STREAM CPAGE) of TEXTSTREAM] - (* ; - "Are we on the first line of a paragraph?") + (* ; + "Are we on the first line of a paragraph?") (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) (COND - ((AND 1STLN (NOT DOINGHEADING?)) (* ; - "This is a new paragraph. Check for special paragraph types, and handle them accordingly.") + ((AND 1STLN (NOT DOINGHEADING?)) (* ; + "This is a new paragraph. Check for special paragraph types, and handle them accordingly.") (SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) - (PAGEHEADING (* ; "This paragraph is the content for a page heading. Handle it, then don't bother formatting further.") + (PAGEHEADING (* ; "This paragraph is the content for a page heading. Handle it, then don't bother formatting further.") (TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO IMAGESTREAM) - (* ;; "This will capture the text, and set LINE:CHARLIM to the LAST char# in the page heading. That lets formatting continue apace.") + (* ;; "This will capture the text, and set LINE:CHARLIM to the LAST char# in the page heading. That lets formatting continue apace.") (RETURN NIL)) - (EVEN (* ; "This paragraph may or may not belong here. If this is an odd page, we don't want to format this paragraph.") + (EVEN (* ; "This paragraph may or may not belong here. If this is an odd page, we don't want to format this paragraph.") (COND ((ODDP (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) (TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO IMAGESTREAM) (RETURN NIL)))) - (ODD (* ; "This paragraph may or may not belong here. If this is an even page, we don't want to format this paragraph.") + (ODD (* ; "This paragraph may or may not belong here. If this is an even page, we don't want to format this paragraph.") (COND ((EVENP (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) (TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO @@ -546,52 +521,50 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. NIL))) [SETQ TX (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE with (COND - (1STLN (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC)) - (T (fetch (FMTSPEC LEFTMAR) of FMTSPEC] - (* ; "Set the left margin accordingly") + (1STLN (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC)) + (T (fetch (FMTSPEC LEFTMAR) of FMTSPEC] + (* ; "Set the left margin accordingly") [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))) - (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) - (T WIDTH] (* ; - "RIGHTMAR = 0 => follow the window's width.") + ((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))) + (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) + (T WIDTH] (* ; + "RIGHTMAR = 0 => follow the window's width.") (SETQ TXB1 WIDTH) - (for old TLEN from TLEN to 511 as old CHNO from CHNO - while (ILEQ CHNO TEXTLEN) when (SETQ CH (\BIN TEXTSTREAM)) - do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)") + (for old TLEN from TLEN to 511 as old CHNO from CHNO while (ILEQ CHNO TEXTLEN) + when (SETQ CH (\BIN TEXTSTREAM)) + do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)") - (* ;; "The character loop") + (* ;; "The character loop") - (* ;; "Get the next character for the line.") + (* ;; "Get the next character for the line.") [SETQ DX (COND - ((SMALLP CH) (* ; "CH is really a character") + ((SMALLP CH) (* ; "CH is really a character") (\FGETCHARWIDTH FONT CH)) - (T (* ; "CH is an object") - (SETQ BOX (\TEDIT.INTEGER.IMAGEBOX (APPLY* (IMAGEOBJPROP - CH - 'IMAGEBOXFN) - CH IMAGESTREAM TX WIDTH - ))) - (* ; "Get its size") + (T (* ; "CH is an object") + (SETQ BOX (\TEDIT.INTEGER.IMAGEBOX (APPLY* (IMAGEOBJPROP CH + 'IMAGEBOXFN) + CH IMAGESTREAM TX WIDTH))) + (* ; "Get its size") [SETQ ASCENT (IMAX ASCENT (IDIFFERENCE (fetch YSIZE of BOX) (fetch YDESC of BOX] (SETQ DESCENT (IMAX DESCENT (fetch YDESC of BOX))) (IMAGEOBJPROP CH 'BOUNDBOX BOX) (fetch XSIZE of BOX] - (AND KERN (SETQ DX (IPLUS DX KERN))) (* ; "Get CH's X width.") + (AND KERN (SETQ DX (IPLUS DX KERN))) (* ; "Get CH's X width.") [SELCHARQ CH - (SPACE (* ; - "CH is a . Remember it, in case we need to break the line.") + (SPACE (* ; + "CH is a . Remember it, in case we need to break the line.") (COND (GATHERBLANK (SETQ TXB1 TX) (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) (* ; - "put the location # of the previous space/tab in the character array instead of the space itself") + (SETQ CH#B CHNO) (* ; + "put the location # of the previous space/tab in the character array instead of the space itself") (COND (NEWASCENT - (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") + (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") (SETQ ASCENT (IMAX ASCENT NEWASCENT)) (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) @@ -600,8 +573,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (\RPLPTR WLIST 0 DX) (SETQ PREVSP (ADD1 TLEN)) (SETQ PREVHYPH NIL) - (SETQ PREVDHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (SETQ PREVDHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") (SETQ T1SPACE T) (add TX DX) (SETQ TXB TX) @@ -611,13 +584,12 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ DESCENTB DESCENT) (SETQ INVISIBLERUNSB INVISIBLERUNS) (add %#BLANKS 1)) - ((CR LF) (* ; - "Ch is a . Force an end to the line.") + ((CR LF) (* ; + "Ch is a . Force an end to the line.") (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) (COND ((AND NEWASCENT (ZEROP ASCENT) - (ZEROP DESCENT)) (* ; - "The ascent has changed; catch it") + (ZEROP DESCENT)) (* ; "The ascent has changed; catch it") (SETQ ASCENT NEWASCENT) (SETQ DESCENT NEWDESCENT))) (SETQ FORCEEND T) @@ -630,14 +602,13 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (freplace (LINEDESCRIPTOR CR\END) of LINE with T) (SETQ TX (IPLUS TX DX)) (replace (LINEDESCRIPTOR LSTLN) of LINE - with (fetch (PIECE PPARALAST) of (fetch PIECE - of TEXTSTREAM))) + with (fetch (PIECE PPARALAST) of (fetch PIECE of TEXTSTREAM))) (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (SETQ PREVHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") (RETURN)) - (^L (* ; - "Ch is a
Force an end to the line. Immediately--just like a CR.") + (^L (* ; + "Ch is a Force an end to the line. Immediately--just like a CR.") (SETQ CTRL\L\SEEN T) (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) (SETQ FORCEEND T) @@ -651,18 +622,18 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ TX (IPLUS TX DX)) (replace (LINEDESCRIPTOR LSTLN) of LINE with T) (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (SETQ PREVHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") (RETURN)) (TAB - (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") + (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") - (\RPLPTR CHLIST 0 CH) (* ; "TABs are 0 wide to start with.") + (\RPLPTR CHLIST 0 CH) (* ; "TABs are 0 wide to start with.") (replace (THISLINE TLFIRSTSPACE) of THISLINE with TLEN) (COND (NEWASCENT - (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") + (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") (SETQ ASCENT (IMAX ASCENT NEWASCENT)) (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) @@ -674,15 +645,15 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. 0 TABPENDING (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM )) 1) - NIL)) (* ; - "Figure out which tab stop to use, and what we need to do to get there.") + NIL)) (* ; + "Figure out which tab stop to use, and what we need to do to get there.") [COND - ((FIXP TABPENDING) (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") + ((FIXP TABPENDING) (* ; + "If it returns a number, that is the new TX, adjusted for any prior tabs") (SETQ TX TABPENDING) (SETQ TABPENDING NIL)) - (TABPENDING (* ; - "Otherwise, look in the PENDINGTAB for the new TX") + (TABPENDING (* ; + "Otherwise, look in the PENDINGTAB for the new TX") (SETQ TX (fetch PTNEWTX of TABPENDING] (COND (GATHERBLANK (SETQ TXB1 TX) @@ -690,18 +661,18 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ CH#B CHNO) (SETQ DX (\GETBASEPTR WLIST 0)) (\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE) - PREVSP) (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) (* ; - "So we can allocate extra space among the right number of blanks to justify things after the tab.") + PREVSP) (* ; + "All the spaces before a tab don't take part in justification from here on.") + (SETQ %#BLANKS 0) (* ; + "So we can allocate extra space among the right number of blanks to justify things after the tab.") (SETQ PREVSP 0) (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (SETQ PREVHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") (SETQ T1SPACE T) (SETQ TX (IPLUS TX DX)) - (SETQ TXB TX) (* ; - "Remember the world in case this is the 'space' before the line breaks") + (SETQ TXB TX) (* ; + "Remember the world in case this is the 'space' before the line breaks") (SETQ DXB DX) (SETQ LOOK#B LOOKNO) (SETQ ASCENTB ASCENT) @@ -711,35 +682,35 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. ((AND (EQ CH (CHARCODE "0,377")) (NOT (ffetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ))) - (* ;; - "Character-set change character. This suggests undetected NS characters.") + (* ;; + "Character-set change character. This suggests undetected NS characters.") (\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM) - (* ; - "Leaves us ready to BIN again at the same place.") + (* ; + "Leaves us ready to BIN again at the same place.") - (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.") + (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.") (SETQ CHLIST (\ADDBASE CHLIST -2)) (SETQ WLIST (\ADDBASE WLIST -2)) (add CHNO -1) (add TLEN -1) (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "Because moving to NS characters changes the TEXTLEN for the shorter.") + (* ; + "Because moving to NS characters changes the TEXTLEN for the shorter.") ) (T - (* ;; "This character isn't special. Just space over for it.") + (* ;; "This character isn't special. Just space over for it.") (SETQ GATHERBLANK T) (COND ((IGREATERP (SETQ TX (IPLUS TX DX)) - WIDTH) (* ; - "We're past the right margin; stop formatting at the last blank.") + WIDTH) (* ; + "We're past the right margin; stop formatting at the last blank.") (SETQ FORCEEND T) (COND - (PREVDHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") + (PREVDHYPH (* ; + "There's a hyphen we can break at. Go back there and break the line.") (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CH#B) (\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH) @@ -754,8 +725,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ DESCENT DESCENTB) (SETQ LOOKNO LOOK#B) (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (PREVHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") + (PREVHYPH (* ; + "There's a hyphen we can break at. Go back there and break the line.") (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CH#B) (SETQ TX TXB) @@ -764,8 +735,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ DESCENT DESCENTB) (SETQ LOOKNO LOOK#B) (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (T1SPACE (* ; - "There's a breaking point on this line. Go back there and break the line.") + (T1SPACE (* ; + "There's a breaking point on this line. Go back there and break the line.") (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CH#B) (SETQ TX TXB) @@ -778,64 +749,60 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (freplace (LINEDESCRIPTOR CHARLIM) of LINE with (IMAX CH#1 (SUB1 CHNO))) (SETQ TX (IDIFFERENCE TX DX)) - (* ; - "No spaces on this line; break it before this character.") + (* ; + "No spaces on this line; break it before this character.") - (* ;; "Check line break character.") + (* ;; "Check line break character.") (while (OR (MEMBER (\GETBASEPTR CHLIST -2) - TEDIT.DONT.LAST.CHARS) - (MEMBER CH TEDIT.DONT.BREAK.CHARS)) + TEDIT.DONT.LAST.CHARS) + (MEMBER CH TEDIT.DONT.BREAK.CHARS)) do + (* ;; + "This character ch doesn't appear at first of lines. or") - (* ;; - "This character ch doesn't appear at first of lines. or") + (* ;; + "Previous character doesn't appear at the end of lines.") - (* ;; - "Previous character doesn't appear at the end of lines.") + (* ;; "So,move previous character to next line.") - (* ;; - "So,move previous character to next line.") - - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add TLEN -1) - (add CHNO -1) - (SETQ CH (\GETBASEPTR CHLIST 0))) + (SETQ CHLIST (\ADDBASE CHLIST -2)) + (SETQ WLIST (\ADDBASE WLIST -2)) + (add TLEN -1) + (add CHNO -1) + (SETQ CH (\GETBASEPTR CHLIST 0))) (freplace (LINEDESCRIPTOR CHARLIM) of LINE with (IMAX (SUB1 CHNO) - CH#1))) - (T (* ; - "Can't split BEFORE the first thing on the line!") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CHNO) + CH#1))) + (T (* ; + "Can't split BEFORE the first thing on the line!") + (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) (\RPLPTR CHLIST 0 CH) (\RPLPTR WLIST 0 DX))) (RETURN)) - (T (* ; "Not past the rightmargin yet...") + (T (* ; "Not past the rightmargin yet...") (COND ((AND NEWASCENT (SMALLP CH)) - (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") + (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") (SETQ ASCENT (IMAX ASCENT NEWASCENT)) (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) (SETQ NEWASCENT NIL))) (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX)(* ; "Check for decimal tabs") + (\RPLPTR WLIST 0 DX)(* ; "Check for decimal tabs") (SELCHARQ CH (%. (COND ((AND TABPENDING (NOT (FIXP TABPENDING)) (EQ (fetch PTTYPE of TABPENDING) 'DECIMAL)) - (add (fetch (PENDINGTAB PTTABX) - of TABPENDING) - DX) - (* ; - "Adjust the pending tab so that the LEFT side of the decimal point goes at the tab stop.") + (add (fetch (PENDINGTAB PTTABX) of TABPENDING) + DX) + (* ; + "Adjust the pending tab so that the LEFT side of the decimal point goes at the tab stop.") (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ (fetch - (FMTSPEC TABSPEC) + (\TEDIT.FORMATTABS TEXTOBJ (fetch (FMTSPEC + TABSPEC) of FMTSPEC) THISLINE CHLIST WLIST TX (FIXR (FTIMES 36.0 (DSPSCALE NIL @@ -845,43 +812,42 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM)) 1) T)) - (* ; - "Figure out which tab stop to use, and what we need to do to get there.") + (* ; + "Figure out which tab stop to use, and what we need to do to get there.") [COND ((FIXP TABPENDING) - (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") + (* ; + "If it returns a number, that is the new TX, adjusted for any prior tabs") (SETQ TX TABPENDING) (SETQ TABPENDING NIL)) (TABPENDING - (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX - of TABPENDING] + (* ; + "Otherwise, look in the PENDINGTAB for the new TX") + (SETQ TX (fetch PTNEWTX of TABPENDING + ] (COND (GATHERBLANK (SETQ TXB1 TX) (SETQ GATHERBLANK NIL))) (SETQ CH#B CHNO) - (* ; "SETQ DX (\GETBASE WLIST 0)") - (\TEDIT.PURGE.SPACES (fetch CHARS - of THISLINE) + (* ; "SETQ DX (\GETBASE WLIST 0)") + (\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE) PREVSP) - (* ; - "All the spaces before a tab don't take part in justification from here on.") + (* ; + "All the spaces before a tab don't take part in justification from here on.") (SETQ %#BLANKS 0) - (* ; - "So we can allocate extra space among the right number of blanks to justify things after the tab.") + (* ; + "So we can allocate extra space among the right number of blanks to justify things after the tab.") (SETQ PREVSP 0) (SETQ T1SPACE T) (SETQ TXB TX) - (* ; - "Remember the world in case this is the 'space' before the line breaks") + (* ; + "Remember the world in case this is the 'space' before the line breaks") (SETQ DXB DX) (SETQ LOOK#B LOOKNO) (SETQ ASCENTB ASCENT) (SETQ DESCENTB DESCENT) (SETQ INVISIBLERUNSB INVISIBLERUNS)))) - ((- "357,045") (* ; "Hyphen, M-dash") + ((- "357,045") (* ; "Hyphen, M-dash") (SETQ PREVHYPH (ADD1 TLEN)) (SETQ PREVDHYPH NIL) (SETQ TXB1 (SETQ TXB TX)) @@ -891,10 +857,10 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ ASCENTB ASCENT) (SETQ DESCENTB DESCENT) (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,042" (* ; "non-breaking hyphen") + ("357,042" (* ; "non-breaking hyphen") (\RPLPTR CHLIST 0 (CHARCODE "-"))) - ("357,043" (* ; "Discretionary hyphen") - (* ; "And isn't actually displayed.") + ("357,043" (* ; "Discretionary hyphen") + (* ; "And isn't actually displayed.") (SETQ PREVDHYPH (ADD1 TLEN)) (SETQ PREVHYPH NIL) (SETQ LOOK#B LOOKNO) @@ -902,8 +868,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ ASCENTB ASCENT) (SETQ DESCENTB DESCENT) (\RPLPTR WLIST 0 0) - (* ; - "Unless we use it, the prevhyph is 0 wide.") + (* ; + "Unless we use it, the prevhyph is 0 wide.") (\RPLPTR CHLIST 0 NIL) (SETQ TX (IDIFFERENCE TX DX)) (SETQ DX (\FGETCHARWIDTH FONT (CHARCODE @@ -911,31 +877,31 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ TXB1 (SETQ TXB (IPLUS TX DX))) (SETQ DXB DX) (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,041" (* ; "non-breaking space.") + ("357,041" (* ; "non-breaking space.") (\RPLPTR CHLIST 0 (CHARCODE SPACE))) (COND ((AND (SMALLP CH) (IGEQ CH 192) (ILEQ CH 207)) - (* ; "This is an NS accent character. Space it 0.0 -- SO back TX down by the width of the accent, so it doesn't add to the line width.") + (* ; "This is an NS accent character. Space it 0.0 -- SO back TX down by the width of the accent, so it doesn't add to the line width.") (SETQ TX (- TX DX] - (SETQ CHLIST (\ADDBASE CHLIST 2)) (* ; - "Move the pointers forward for the next character.") + (SETQ CHLIST (\ADDBASE CHLIST 2)) (* ; + "Move the pointers forward for the next character.") (SETQ WLIST (\ADDBASE WLIST 2))) -(* ;;; "Done processing characters; the line is now filled.") +(* ;;; "Done processing characters; the line is now filled.") (COND ((AND (IEQP TLEN 255) - (ILESSP CHNO TEXTLEN)) (* ; - "This line is too long for us to format??") + (ILESSP CHNO TEXTLEN)) (* ; + "This line is too long for us to format??") (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T))) (COND - (TABPENDING (* ; - "There is a TAB outstanding. Go handle it.") + (TABPENDING (* ; + "There is a TAB outstanding. Go handle it.") (add (fetch (PENDINGTAB PTTABX) of TABPENDING) - DX) (* ; - "Modify the pending tab so that the LEFT side of the CR is at the tab stop.") + DX) (* ; + "Modify the pending tab so that the LEFT side of the CR is at the tab stop.") (SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch (FMTSPEC TABSPEC) of FMTSPEC) THISLINE CHLIST WLIST TX @@ -948,17 +914,14 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE) PREVSP) (SETQ PREVSP 0] - (T (* ; - "No text to go in this line; set Ascent/Descent to the default font from the window.") + (T (* ; + "No text to go in this line; set Ascent/Descent to the default font from the window.") (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) (\EDITSETA LOOKS 0 CLOOKS) [SETQ 1STLN (AND (fetch (STREAM F5) of TEXTSTREAM) - (fetch (PIECE PREVPIECE) of (fetch (STREAM F5) - of TEXTSTREAM)) + (fetch (PIECE PREVPIECE) of (fetch (STREAM F5) of TEXTSTREAM)) (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) - of (fetch - (STREAM F5) - of TEXTSTREAM)) + of (fetch (STREAM F5) of TEXTSTREAM)) ) (IEQP (fetch (STREAM FW6) of TEXTSTREAM) (fetch (STREAM CPAGE) of TEXTSTREAM)) @@ -967,30 +930,24 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) [SETQ TX (SETQ TXB (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE with (COND - (1STLN (fetch (FMTSPEC 1STLEFTMAR) of - FMTSPEC)) - (T (fetch (FMTSPEC LEFTMAR) of FMTSPEC] + (1STLN (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC)) + (T (fetch (FMTSPEC LEFTMAR) of FMTSPEC] [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) - )) - (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) - (T WIDTH] + ((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))) + (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) + (T WIDTH] (SETQ TXB1 WIDTH))) [COND - ((ZEROP (freplace (LINEDESCRIPTOR LHEIGHT) of LINE with (IPLUS ASCENT - DESCENT))) + ((ZEROP (freplace (LINEDESCRIPTOR LHEIGHT) of LINE with (IPLUS ASCENT DESCENT))) (replace (LINEDESCRIPTOR LHEIGHT) of LINE with (FONTPROP (OR (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch (CHARLOOKS CLFONT) of (fetch - (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ)) - ) - DEFAULTFONT) - 'HEIGHT] (* ; - "Line's height (or 12 for an empty line)") + (fetch (CHARLOOKS CLFONT) of (fetch (TEXTOBJ + DEFAULTCHARLOOKS) + of TEXTOBJ))) + DEFAULTFONT) + 'HEIGHT] (* ; + "Line's height (or 12 for an empty line)") (replace (LINEDESCRIPTOR ASCENT) of LINE with ASCENT) (replace (LINEDESCRIPTOR DESCENT) of LINE with DESCENT) (freplace (LINEDESCRIPTOR CHARTOP) of LINE with CHNO) @@ -998,22 +955,20 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (FORCEEND NIL) (T (SETQ CHNO (SUB1 CHNO)) (SETQ TLEN (SUB1 TLEN)) - (SETQ TXB1 TX))) (* ; - "If we ran off the end of the text, then keep true space left on the line.") + (SETQ TXB1 TX))) (* ; + "If we ran off the end of the text, then keep true space left on the line.") (freplace (LINEDESCRIPTOR LXLIM) of LINE with TX) (freplace DESC of THISLINE with LINE) [freplace (THISLINE LEN) of THISLINE with (IMIN 254 (COND - ((ILESSP TEXTLEN CH#1) - -1) - (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE) - TEXTLEN) - (IPLUS INVISIBLERUNS (fetch - (LINEDESCRIPTOR - CHAR1) of - LINE] + ((ILESSP TEXTLEN CH#1) + -1) + (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR CHARLIM) + of LINE) + TEXTLEN) + (IPLUS INVISIBLERUNS (fetch (LINEDESCRIPTOR + CHAR1) + of LINE] (freplace (LINEDESCRIPTOR SPACELEFT) of LINE with (IDIFFERENCE WIDTH TXB1)) (\DOFORMATTING.HARDCOPY TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) (replace (LINEDESCRIPTOR LFMTSPEC) of LINE with FMTSPEC) @@ -1024,7 +979,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. [LAMBDA (TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) (* ; "Edited 29-Mar-94 16:30 by jds") (* ; - "Do the formatting work for justified, centered, etc. lines") + "Do the formatting work for justified, centered, etc. lines") (PROG ((QUAD (fetch QUAD of FMTSPEC)) (SPACELEFT (fetch (LINEDESCRIPTOR SPACELEFT) of LINE)) (EXISTINGSPACE 0) @@ -1032,177 +987,171 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) (SPACEOFLOW 0) EXTRASP OPREVSP LINELEAD) (* ; - "NB that SPACELEFT, OFLOW, etc. are kept in 32 x value form, for rounding ease.") - (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with (fetch (LINEDESCRIPTOR - DESCENT) - of LINE)) - (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with (fetch (LINEDESCRIPTOR - ASCENT) - of LINE)) + "NB that SPACELEFT, OFLOW, etc. are kept in 32 x value form, for rounding ease.") + (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with (fetch (LINEDESCRIPTOR DESCENT) + of LINE)) + (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with (fetch (LINEDESCRIPTOR ASCENT) + of LINE)) (* ; - "Save the true ascent value for display purposes") + "Save the true ascent value for display purposes") (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1) (* ; - "Start by assuming that we want a space factor of 1.0") + "Start by assuming that we want a space factor of 1.0") [COND - ((SETQ LINELEAD (fetch LINELEAD of FMTSPEC)) - (* ; - "If line leading was specified, set it") + ((SETQ LINELEAD (fetch LINELEAD of FMTSPEC)) (* ; + "If line leading was specified, set it") (COND (T (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LINELEAD of FMTSPEC)) - (* ; - "And adjust the line's descent accordingly") + (fetch LINELEAD of FMTSPEC)) (* ; + "And adjust the line's descent accordingly") (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LINELEAD of FMTSPEC] + (fetch LINELEAD of FMTSPEC] [COND - ((AND 1STLN (fetch LEADBEFORE of FMTSPEC)) - (* ; - "If paragraph pre-leading was specified, set it") + ((AND 1STLN (fetch LEADBEFORE of FMTSPEC)) (* ; + "If paragraph pre-leading was specified, set it") (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADBEFORE of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") + (fetch LEADBEFORE of FMTSPEC)) (* ; + "And adjust the line's ascent accordingly.") (add (fetch (LINEDESCRIPTOR ASCENT) of LINE) - (fetch LEADBEFORE of FMTSPEC] + (fetch LEADBEFORE of FMTSPEC] [COND ((AND (fetch (LINEDESCRIPTOR LSTLN) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "If paragraph pre-leading was specified, set it") + (fetch LEADAFTER of FMTSPEC)) (* ; + "If paragraph pre-leading was specified, set it") (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") + (fetch LEADAFTER of FMTSPEC)) (* ; + "And adjust the line's ascent accordingly.") (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LEADAFTER of FMTSPEC] + (fetch LEADAFTER of FMTSPEC] (SELECTQ QUAD (LEFT (* ; - "Do nothing for left-justified lines except replace the character codes")) + "Do nothing for left-justified lines except replace the character codes")) (RIGHT (* ; "Just move the right margin over") - (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (fetch (LINEDESCRIPTOR SPACELEFT) of LINE))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch ( - LINEDESCRIPTOR - RIGHTMARGIN - ) - of LINE)) + (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE with (IPLUS (fetch (LINEDESCRIPTOR + LEFTMARGIN) + of LINE) + (fetch (LINEDESCRIPTOR + SPACELEFT) + of LINE))) + (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR RIGHTMARGIN) + of LINE)) (COND ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) 0) (ZEROP %#BLANKS) (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") + "For empty lines, and lines with no spaces, don't bother fixing blank widths.") (RETURN)))) (CENTERED (* ; - "Split the difference for centering") + "Split the difference for centering") (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (LRSH SPACELEFT 1)) + (LRSH SPACELEFT 1)) (add (fetch (LINEDESCRIPTOR LXLIM) of LINE) - (LRSH SPACELEFT 1)) + (LRSH SPACELEFT 1)) (COND ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) 0) (ZEROP %#BLANKS) (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") + "For empty lines, and lines with no spaces, don't bother fixing blank widths.") (RETURN)))) (JUSTIFIED (* ; - "For justified lines, stretch each space so line reaches the right margin") + "For justified lines, stretch each space so line reaches the right margin") (COND ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) 0) (ZEROP %#BLANKS) (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") + "For empty lines, and lines with no spaces, don't bother fixing blank widths.") (RETURN))) (COND ((OR (fetch (LINEDESCRIPTOR CR\END) of LINE) (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) (* ; - "This is the last line in the paragraph; don't stretch it out.") + "This is the last line in the paragraph; don't stretch it out.") (SETQ EXTRASP 0)) ((IEQP PREVSP (ADD1 (fetch (THISLINE LEN) of THISLINE))) (* ; - "Only if the last character on the line is a space should we remove trailing spaces from the list") + "Only if the last character on the line is a space should we remove trailing spaces from the list") (bind (OPREVSP _ (SUB1 PREVSP)) while (AND (IGREATERP PREVSP 0) - (ILEQ OPREVSP PREVSP) - ) + (ILEQ OPREVSP PREVSP)) do (* ;; "Back up over all trailing white space on the line. So that those blanks don't get counted when computing the space to be added to each REAL space on the line, when it is justified.") - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - (add %#BLANKS -1)) + (SETQ OPREVSP (SUB1 PREVSP)) + (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) + (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) + (add %#BLANKS -1)) (COND ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks except at end-of-line, don't bother going further.") + "If there aren't any blanks except at end-of-line, don't bother going further.") (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE - with (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)) + (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR + RIGHTMARGIN) + of LINE)) (* ; - "Fix the right margin for showing selections &c") + "Fix the right margin for showing selections &c") (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) (* ; - "Now apportion the extra space evenly among blanks.") + "Now apportion the extra space evenly among blanks.") ) (T (* ;; - "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.") + "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.") (COND ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks except at end-of-line, don't bother going further.") + "If there aren't any blanks except at end-of-line, don't bother going further.") (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE - with (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)) + (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR + RIGHTMARGIN) + of LINE)) (* ; - "Fix the right margin for showing selections &c") + "Fix the right margin for showing selections &c") (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) (* ; - "Now apportion the extra space evenly among blanks.") + "Now apportion the extra space evenly among blanks.") )) (bind (SP _ PREVSP) while (IGREATERP SP 0) - do (* ; - "Fix up the widths of spaces in the line") - (SETQ OPREVSP (SUB1 SP)) - (SETQ SP (\EDITELT CHLIST OPREVSP)) - (add EXISTINGSPACE (\EDITELT WLIST OPREVSP))) + do (* ; + "Fix up the widths of spaces in the line") + (SETQ OPREVSP (SUB1 SP)) + (SETQ SP (\EDITELT CHLIST OPREVSP)) + (add EXISTINGSPACE (\EDITELT WLIST OPREVSP))) [while (IGREATERP PREVSP 0) - do (* ; - "Fix up the widths of spaces in the line") - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - (OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (\EDITSETA WLIST OPREVSP (FIXR (FTIMES (\EDITELT WLIST OPREVSP) - (FPLUS 1.0 - (FQUOTIENT - SPACELEFT + do (* ; + "Fix up the widths of spaces in the line") + (SETQ OPREVSP (SUB1 PREVSP)) + (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) + (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) + (OR (fetch (LINEDESCRIPTOR CR\END) of LINE) + (\EDITSETA WLIST OPREVSP (FIXR (FTIMES (\EDITELT WLIST OPREVSP) + (FPLUS 1.0 (FQUOTIENT + SPACELEFT + EXISTINGSPACE - ] + ] (COND ((AND (NOT (ZEROP EXISTINGSPACE)) (NOT (ZEROP EXTRASP))) (* ; "Only if we really expanded the line -- and there are spaces to expand (or else EXISTINGSPACE is 0).") (replace (THISLINE TLSPACEFACTOR) of THISLINE - with (FQUOTIENT (IPLUS EXISTINGSPACE (fetch (LINEDESCRIPTOR - SPACELEFT) - of LINE)) - EXISTINGSPACE)) - (* ; - "And set the space factor for display") + with (FQUOTIENT (IPLUS EXISTINGSPACE (fetch (LINEDESCRIPTOR SPACELEFT + ) of LINE)) + EXISTINGSPACE)) (* ; + "And set the space factor for display") ) (T (* ; "Pathological cases ") (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1))) (RETURN)) NIL) (\TEDIT.PURGE.SPACES CHLIST PREVSP) (* ; -"Change all the spaces--chained for justification--back into regular spaces, for the display code.") + "Change all the spaces--chained for justification--back into regular spaces, for the display code.") ]) (\TEDIT.HARDCOPY.MODIFYLOOKS - [LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* ; "Edited 30-May-91 21:17 by jds") + [LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* ; "Edited 30-May-91 21:17 by jds") (* ;; "Do underlining, overlining, etc. for hardcopy files") @@ -1211,7 +1160,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM))) YOFFSET) (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.") + ((fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.") (DRAWLINE STARTX (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LINE) (fetch (LINEDESCRIPTOR LTRUEDESCENT) of LINE)) CURX @@ -1221,7 +1170,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. 'PAINT PRSTREAM) (* ; "A 1/2-pt underline") )) (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line") + ((fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line") (DRAWLINE STARTX (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) (fetch (LINEDESCRIPTOR LTRUEASCENT) of LINE)) CURX @@ -1230,12 +1179,11 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. RULEWIDTH 'PAINT PRSTREAM))) (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struch-thru") + ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struch-thru") (DRAWLINE STARTX (SETQ YOFFSET (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) (IQUOTIENT [FIXR (FTIMES STREAMSCALE - (FONTPROP (fetch (CHARLOOKS - CLFONT) + (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) 'ASCENT] 3))) @@ -1243,39 +1191,36 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (MOVETO CURX CURY PRSTREAM]) (\TEDIT.HCPYLOOKS.UPDATE - [LAMBDA (STREAM PC NLOOKS) (* ; - "Edited 3-Jul-93 20:12 by sybalskY:MV:ENVOS") + [LAMBDA (STREAM PC NLOOKS) (* ; + "Edited 3-Jul-93 20:12 by sybalskY:MV:ENVOS") (* ;; "At a piece boundary, update the line formatting fields ASCENT, DESCENT, and FONTWIDTHS") (* ;; "Also, KERN, if USERPROPS has a KERN entry.") - (DECLARE (USEDFREE LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST - WLIST DEVICE NEWASCENT NEWDESCENT KERN IMAGESTREAM)) + (DECLARE (USEDFREE LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST + WLIST DEVICE NEWASCENT NEWDESCENT KERN IMAGESTREAM)) (COND (PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) TLOOKS TEMP NEWPC OFFSET PARALOOKS PREVPC NEWKERN) [COND ([OR (NOT (fetch (PIECE PREVPIECE) of PC)) (NEQ (fetch (PIECE PPARALOOKS) of PC) - (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) - of PC] + (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) of PC] (* ; -"The paragraph looks have changed between the last piece and this one. Take account of the change") - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of PC) + "The paragraph looks have changed between the last piece and this one. Take account of the change") + (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) of PC) PC TEXTOBJ)) (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)) (T (SETQ PARALOOKS (fetch (TEXTSTREAM CURRENTPARALOOKS) of STREAM] - (SETQ TLOOKS (OR NLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of - PC) + (SETQ TLOOKS (OR NLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) PC TEXTOBJ))) (COND ((fetch (CHARLOOKS CLINVISIBLE) of TLOOKS) (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") + "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") (\EDITSETA LOOKS LOOKNO (fetch (PIECE PLEN) of PC)) (\RPLPTR CHLIST 0 LMInvisibleRun) (\RPLPTR WLIST 0 0) @@ -1290,34 +1235,29 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) of PC) PC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS) - )) - (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) + (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) + (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) PC TEXTOBJ))) [while (AND PC (OR (ZEROP (fetch (PIECE PLEN) of PC)) - (fetch (CHARLOOKS CLINVISIBLE) of TLOOKS))) + (fetch (CHARLOOKS CLINVISIBLE) of TLOOKS))) do (\EDITSETA LOOKS LOOKNO (IPLUS (fetch (PIECE PLEN) of PC) - (\EDITELT LOOKS LOOKNO))) - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (COND - ((AND PC (NEQ (fetch (PIECE PPARALOOKS) of PC) - (fetch (PIECE PPARALOOKS) of PREVPC))) + (\EDITELT LOOKS LOOKNO))) + (SETQ PREVPC PC) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + (COND + ((AND PC (NEQ (fetch (PIECE PPARALOOKS) of PC) + (fetch (PIECE PPARALOOKS) of PREVPC))) (* ; - "If there IS new text, and the paragraph looks have changed, update the streams notion of them.") - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE - PPARALOOKS - ) - of PC) - PC TEXTOBJ)) - (* ; - "And take care of style sheets on the way.") - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM - with PARALOOKS))) - (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) + "If there IS new text, and the paragraph looks have changed, update the streams notion of them.") + (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) of PC) - PC TEXTOBJ] + PC TEXTOBJ)) + (* ; + "And take care of style sheets on the way.") + (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) + (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) + of PC) + PC TEXTOBJ] (add CHNO (\EDITELT LOOKS LOOKNO)) (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) (SETQ NEWPC PC))) @@ -1333,8 +1273,7 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (T (FONTCOPY FONT 'DEVICE DEVICE] (SETQ OFFSET (OR [AND (fetch (CHARLOOKS CLOFFSET) of TLOOKS) (FIXR (FTIMES (DSPSCALE NIL DEVICE) - (fetch (CHARLOOKS CLOFFSET) of TLOOKS - ] + (fetch (CHARLOOKS CLOFFSET) of TLOOKS] 0)) (SETQ NEWASCENT (IMAX ASCENT (IPLUS (fetch \SFAscent of FONT) OFFSET))) @@ -1351,39 +1290,39 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (* ;; "If we're calling this to initialize values, don't go and update the running cache. However, since NLOOKS is NIL, we're not initializing, so go to it!") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") (\EDITSETA LOOKS LOOKNO TLOOKS) (* ; - "Save the new looks for selection/display") + "Save the new looks for selection/display") (\RPLPTR CHLIST 0 LMLooksChange) (* ; - "Put a marker in the character list to denote a looks change") + "Put a marker in the character list to denote a looks change") (\RPLPTR WLIST 0 0) (* ; "Font changes have no width") (add TLEN 1) (SETQ CHLIST (\ADDBASE CHLIST 2)) (SETQ WLIST (\ADDBASE WLIST 2)) (* ; - "Account for the dummy marker/looks in TLEN") + "Account for the dummy marker/looks in TLEN") )) (SETQ NEWPC PC)) ((NOT (OR PC NLOOKS)) (* ; -"We have run off the end of the document. Bail out so that \TEDIT.HARDCOPY.FORMATLINE doesn't die") + "We have run off the end of the document. Bail out so that \TEDIT.HARDCOPY.FORMATLINE doesn't die") (RETFROM '\BIN NIL))) (OR NEWPC (SETQ NEWPC PC)) [COND ((AND (fetch (PIECE POBJ) of NEWPC) (NEQ (fetch (PIECE PLEN) of NEWPC) 1)) (* ; - "If this piece is for an object, check for a length mismatch") + "If this piece is for an object, check for a length mismatch") (COND ((IMAGEOBJPROP (fetch (PIECE POBJ) of NEWPC) 'SUBSTREAM)) (T (* ;; "The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from. Build an invisible run to fill the space.") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") (\EDITSETA LOOKS LOOKNO (SUB1 (fetch (PIECE PLEN) of PC))) (\RPLPTR CHLIST 0 LMInvisibleRun) (* ; - "Note the existence of an invisible run of characters here.") + "Note the existence of an invisible run of characters here.") (\RPLPTR WLIST 0 0) (add TLEN 1) (SETQ CHLIST (\ADDBASE CHLIST 2)) @@ -1391,82 +1330,73 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (add CHNO (\EDITELT LOOKS LOOKNO)) (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) (* ; - "Keep track of how much invisible text we cross over") + "Keep track of how much invisible text we cross over") ] (RETURN NEWPC]) (\TEDIT.HCPYFMTSPEC - [LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 30-May-91 21:18 by jds") + [LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 30-May-91 21:18 by jds") (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.)") (PROG ((SCALEFACTOR (DSPSCALE NIL IMAGESTREAM))) - (RETURN (create FMTSPEC using - SPEC 1STLEFTMAR _ (FIXR (FTIMES (fetch (FMTSPEC 1STLEFTMAR) - of SPEC) - SCALEFACTOR)) - LEFTMAR _ (FIXR (FTIMES (fetch (FMTSPEC LEFTMAR) - of SPEC) - SCALEFACTOR)) - RIGHTMAR _ (FIXR (FTIMES (fetch (FMTSPEC RIGHTMAR) - of SPEC) - SCALEFACTOR)) - LEADBEFORE _ (FIXR (FTIMES (fetch (FMTSPEC LEADBEFORE) + (RETURN (create FMTSPEC using SPEC 1STLEFTMAR _ (FIXR (FTIMES (fetch (FMTSPEC 1STLEFTMAR) + of SPEC) + SCALEFACTOR)) + LEFTMAR _ (FIXR (FTIMES (fetch (FMTSPEC LEFTMAR) of SPEC) + SCALEFACTOR)) + RIGHTMAR _ (FIXR (FTIMES (fetch (FMTSPEC RIGHTMAR) of SPEC) SCALEFACTOR)) - LEADAFTER _ (FIXR (FTIMES (fetch (FMTSPEC LEADAFTER) - of SPEC) - SCALEFACTOR)) - LINELEAD _ (FIXR (FTIMES (fetch (FMTSPEC LINELEAD) - of SPEC) - SCALEFACTOR)) - FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE) - of SPEC) - (FIXR (FTIMES (fetch (FMTSPEC + LEADBEFORE _ (FIXR (FTIMES (fetch (FMTSPEC LEADBEFORE) + of SPEC) + SCALEFACTOR)) + LEADAFTER _ (FIXR (FTIMES (fetch (FMTSPEC LEADAFTER) + of SPEC) + SCALEFACTOR)) + LINELEAD _ (FIXR (FTIMES (fetch (FMTSPEC LINELEAD) + of SPEC) + SCALEFACTOR)) + FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE) + of SPEC) + (FIXR (FTIMES (fetch (FMTSPEC FMTBASETOBASE - ) - of SPEC) + ) + of SPEC) + SCALEFACTOR))) + QUAD _ (fetch (FMTSPEC QUAD) of SPEC) + TABSPEC _ + [CONS (AND (CAR (fetch (FMTSPEC TABSPEC) of SPEC)) + (FIXR (FTIMES (CAR (fetch (FMTSPEC TABSPEC) + of SPEC)) + SCALEFACTOR))) + (for TAB in (CDR (fetch (FMTSPEC TABSPEC) of SPEC)) + collect (CONS (FIXR (FTIMES SCALEFACTOR (CAR TAB))) + (CDR TAB] + FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX) of SPEC) + (FIXR (FTIMES (SCALEPAGEUNITS + (fetch (FMTSPEC FMTSPECIALX + ) + of SPEC) + 1.0 NIL) SCALEFACTOR))) - QUAD _ (fetch (FMTSPEC QUAD) of SPEC) - TABSPEC _ - [CONS (AND (CAR (fetch (FMTSPEC TABSPEC) of SPEC)) - (FIXR (FTIMES (CAR (fetch (FMTSPEC TABSPEC) - of SPEC)) - SCALEFACTOR))) - (for TAB in (CDR (fetch (FMTSPEC TABSPEC) - of SPEC)) - collect (CONS (FIXR (FTIMES SCALEFACTOR - (CAR TAB))) - (CDR TAB] - FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX) - of SPEC) - (FIXR (FTIMES (SCALEPAGEUNITS - (fetch (FMTSPEC - FMTSPECIALX - ) - of SPEC) - 1.0 NIL) - SCALEFACTOR))) - FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY) - of SPEC) - (FIXR (FTIMES (SCALEPAGEUNITS - (fetch (FMTSPEC - FMTSPECIALY - ) - of SPEC) - 1.0 NIL) - SCALEFACTOR]) + FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY) of SPEC) + (FIXR (FTIMES (SCALEPAGEUNITS + (fetch (FMTSPEC FMTSPECIALY + ) + of SPEC) + 1.0 NIL) + SCALEFACTOR]) (\TEDIT.INTEGER.IMAGEBOX - (LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52") - - (* Take an IMAGEBOX, and assure that its contents are integers) - + [LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52") + (* Take an IMAGEBOX, and assure that + its contents are integers) (replace XKERN of OLDBOX with (FIXR (fetch XKERN of OLDBOX))) (replace YDESC of OLDBOX with (FIXR (fetch YDESC of OLDBOX))) (replace YSIZE of OLDBOX with (FIXR (fetch YSIZE of OLDBOX))) (replace XSIZE of OLDBOX with (FIXR (fetch XSIZE of OLDBOX))) - OLDBOX)) + OLDBOX]) ) @@ -1517,10 +1447,10 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (DEFINEQ (TEDIT.HARDCOPYFN - [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 21-Sep-2021 15:33 by rmk:") + [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 21-Sep-2021 15:33 by rmk:") (* ;; - "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.") + "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.") (PROG ((TEXTOBJ (TEXTOBJ WINDOW)) (TEXTSTREAM (TEXTSTREAM WINDOW))) @@ -1535,9 +1465,9 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))]) (\TEDIT.HARDCOPY - [LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:35 by mitani") + [LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:35 by mitani") - (* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).") + (* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).") (CL:WITH-OPEN-STREAM [TEXT-STREAM (OPENTEXTSTREAM (COND ((STRINGP FILE) @@ -1552,8 +1482,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. PFILE)]) (\TEDIT.PRESS.HARDCOPY - [LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:36 by mitani") - (* Send the text to the printer.) + [LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:36 by mitani") + (* Send the text to the printer.) [SETQ FILE (OPENTEXTSTREAM (COND ((STRINGP FILE) (MKATOM FILE)) @@ -1599,29 +1529,26 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation. (DEFINEQ (TEDIT-BOOK - [LAMBDA (FILES DIRECTORY PRINT-FILE DONT-SEND) (* ; "Edited 22-Mar-93 23:55 by jds") + [LAMBDA (FILES DIRECTORY PRINT-FILE DONT-SEND) (* ; "Edited 22-Mar-93 23:55 by jds") (LET ((DOC (OPENTEXTSTREAM (MKATOM (CAR FILES)) NIL))) (* ;; "Gather all the files into one document:") - (for FILE in (CDR FILES) do (TEDIT.SETSEL DOC 1 (fetch (TEXTOBJ TEXTLEN) - of (TEXTOBJ DOC)) - 'RIGHT NIL NIL) - (TEDIT.INCLUDE DOC (PACK* (OR DIRECTORY "") - FILE))) + (for FILE in (CDR FILES) do (TEDIT.SETSEL DOC 1 (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ DOC)) + 'RIGHT NIL NIL) + (TEDIT.INCLUDE DOC (PACK* (OR DIRECTORY "") + FILE))) (* ; "Set page layout") (TEDIT.FORMAT.HARDCOPY DOC PRINT-FILE DONT-SEND NIL NIL NIL NIL NIL) (CLOSEF DOC]) ) -(PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1992 1993 1994 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3784 100502 (TEDIT.HARDCOPY 3794 . 5045) (TEDIT.HCPYFILE 5047 . 7121) ( -\TEDIT.HARDCOPY.DISPLAYLINE 7123 . 21268) (\TEDIT.HARDCOPY.FORMATLINE 21270 . 68592) ( -\DOFORMATTING.HARDCOPY 68594 . 81887) (\TEDIT.HARDCOPY.MODIFYLOOKS 81889 . 84296) ( -\TEDIT.HCPYLOOKS.UPDATE 84298 . 94906) (\TEDIT.HCPYFMTSPEC 94908 . 99928) (\TEDIT.INTEGER.IMAGEBOX -99930 . 100500)) (100591 101675 (\TEDIT.SCALE 100601 . 100895) (\TEDIT.SCALEREGION 100897 . 101673)) ( -101918 104469 (TEDIT.HARDCOPYFN 101928 . 102833) (\TEDIT.HARDCOPY 102835 . 103744) ( -\TEDIT.PRESS.HARDCOPY 103746 . 104467)) (105749 106652 (TEDIT-BOOK 105759 . 106650))))) + (FILEMAP (NIL (3705 96172 (TEDIT.HARDCOPY 3715 . 4731) (TEDIT.HCPYFILE 4733 . 6660) ( +\TEDIT.HARDCOPY.DISPLAYLINE 6662 . 20176) (\TEDIT.HARDCOPY.FORMATLINE 20178 . 65510) ( +\DOFORMATTING.HARDCOPY 65512 . 78584) (\TEDIT.HARDCOPY.MODIFYLOOKS 78586 . 80933) ( +\TEDIT.HCPYLOOKS.UPDATE 80935 . 90952) (\TEDIT.HCPYFMTSPEC 90954 . 95497) (\TEDIT.INTEGER.IMAGEBOX +95499 . 96170)) (96261 97345 (\TEDIT.SCALE 96271 . 96565) (\TEDIT.SCALEREGION 96567 . 97343)) (97588 +100153 (TEDIT.HARDCOPYFN 97598 . 98509) (\TEDIT.HARDCOPY 98511 . 99424) (\TEDIT.PRESS.HARDCOPY 99426 + . 100151)) (101433 102234 (TEDIT-BOOK 101443 . 102232))))) STOP diff --git a/library/TEDITHCPY.LCOM b/library/tedit/TEDIT-HCPY.LCOM similarity index 96% rename from library/TEDITHCPY.LCOM rename to library/tedit/TEDIT-HCPY.LCOM index 1e4f0f9383b8dd012b001f80375fdd2612b7114c..913f3b2ef389e75c0a76ba3629db890ba15a914c 100644 GIT binary patch delta 560 zcmeycneo>q#tGpfh9~ivx z6LaixQ&VzMD~n|~(EPw^+g>Z=8--J$RO3T3q-9F9Osr^S zg#q-J)8@Y`El;-=>&_Z2`15DP2EK80H1oN?ao6r2+?^7zh&B`g>v%?^2>RSCF@1Ai zR;JIbr=sybalsky>lispcore3.0>library>TEDITHISTORY.;2 38471 - changes to%: (FNS TEDIT.UNDO.INSERTION TEDIT.REDO.INSERTION TEDIT.UNDO.DELETION) +(FILECREATED "14-Jul-2022 16:55:48"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;1 36011 - previous date%: "25-Aug-94 10:54:22" {DSK}sybalsky>lispcore3.0>library>TEDITHISTORY.;1 -) + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-HISTORY.;2) -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venue & Xerox Corporation. All rights reserved. -") +(PRETTYCOMPRINT TEDIT-HISTORYCOMS) -(PRETTYCOMPRINT TEDITHISTORYCOMS) - -(RPAQQ TEDITHISTORYCOMS - ((FILES TEDITDCL) +(RPAQQ TEDIT-HISTORYCOMS + ((FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST) (INITVARS (TEDIT.HISTORY.TYPELST NIL) (TEDIT.HISTORYLST NIL)) @@ -32,7 +28,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu TEDIT.REDO.INSERTION TEDIT.UNDO.MOVE TEDIT.UNDO.REPLACE TEDIT.REDO.REPLACE TEDIT.REDO.MOVE)))) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -44,7 +40,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -63,11 +59,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (\TEDIT.HISTORYADD [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Sep-87 10:36 by jds") - - (* ;; "Add a new event to the history list. For now, this just re-sets the whole list to be the one event...") - - (* ;; - "This function also takes care of cumulating cumulative events, like successive deletions.") + + (* ;; "Add a new event to the history list. For now, this just re-sets the whole list to be the one event...") + + (* ;; "This function also takes care of cumulating cumulative events, like successive deletions.") (LET* ((OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) (ETYPE (fetch (TEDITHISTORYEVENT THACTION) of EVENT)) @@ -77,7 +72,6 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu ((AND OLDEVENT (EQ OETYPE ETYPE) (EQ ETYPE 'Delete)) (* ;  "Repeated successive deletions. See if we can combine them.") - (LET* [(OSTART (fetch (TEDITHISTORYEVENT THCH#) of OLDEVENT)) (NSTART (fetch (TEDITHISTORYEVENT THCH#) of EVENT)) (OLDEND (+ OSTART (fetch (TEDITHISTORYEVENT THLEN) of OLDEVENT))) @@ -85,20 +79,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (COND ((IEQP OLDEND NSTART) (* ;  "The old deletion was just in front of the current one; cumulate them.") - (SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT T))) ((IEQP NEWEND OSTART) (* ;  "The new deletion was just in front of the old one; cumulate them.") - (SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT T] (replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with REALEVENT]) (\TEDIT.CUMULATE.EVENTS [LAMBDA (EVENT1 EVENT2 PIECES-TO-SAVE?) (* ; "Edited 3-Sep-87 10:42 by jds") - - (* ;; "Accumulate history events that should really be combined into a single event.") - - (* ;; "For now, this assumes they're events of the same type. Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.") + + (* ;; "Accumulate history events that should really be combined into a single event.") + + (* ;; "For now, this assumes they're events of the same type. Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.") (LET* [(OLDLEN (fetch (TEDITHISTORYEVENT THLEN) of EVENT1)) (NEWPC1 (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT2)) @@ -108,7 +100,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu of EVENT2] (bind (PC _ (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT1)) (CHCOUNT _ 0) while (< (SETQ CHCOUNT (+ CHCOUNT (fetch (PIECE PLEN) of PC))) - OLDLEN) do (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + OLDLEN) do (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (replace (PIECE NEXTPIECE) of PC with NEWPC1) (replace (PIECE PREVPIECE) of NEWPC1 with PC) (RETURN)) @@ -122,57 +114,57 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (DEFINEQ (TEDIT.UNDO - [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:41 by mitani") + [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:41 by mitani") - (* ;; "Undo the last thing this guy did.") + (* ;; "Undo the last thing this guy did.") (COND ((NOT (FETCH (TEXTOBJ TXTREADONLY) OF TEXTOBJ)) - (* ;; "Only undo things if the document is allowed to change.") + (* ;; "Only undo things if the document is allowed to change.") (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) EVENT CH# LEN FIRSTPIECE) (COND ((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - (* ; - "There really is something to UNDO. Decide what, & fix it.") - (SETQ LEN (fetch THLEN of EVENT)) (* ; - "Length of the text that was inserted/deleted/changed") - (SETQ CH# (fetch THCH# of EVENT)) (* ; "Starting CH# of the change") + (* ; + "There really is something to UNDO. Decide what, & fix it.") + (SETQ LEN (fetch THLEN of EVENT)) (* ; + "Length of the text that was inserted/deleted/changed") + (SETQ CH# (fetch THCH# of EVENT)) (* ; "Starting CH# of the change") (SETQ FIRSTPIECE (fetch THFIRSTPIECE of EVENT)) - (* ; - "First piece affected by the change") + (* ; + "First piece affected by the change") (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (\SHOWSEL SEL NIL NIL) [SELECTQ (fetch THACTION of EVENT) - ((Insert Copy Include) (* ; "It was an insertion") + ((Insert Copy Include) (* ; "It was an insertion") (TEDIT.UNDO.INSERTION TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Delete (* ; "It was a deletion") + (Delete (* ; "It was a deletion") (TEDIT.UNDO.DELETION TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Looks (* ; "It was a character-looks change") + (Looks (* ; "It was a character-looks change") (TEDIT.UNDO.LOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (ParaLooks (* ; "It was a PARA looks change") + (ParaLooks (* ; "It was a PARA looks change") (TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE)) (Move (TEDIT.UNDO.MOVE TEXTOBJ EVENT LEN CH# FIRSTPIECE) - (* ; "He moved some text") + (* ; "He moved some text") ) ((Replace LowerCase UpperCase) - (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.") + (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.") (TEDIT.UNDO.REPLACE TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Get (* ; "He did a GET -- not undoable.") + (Get (* ; "He did a GET -- not undoable.") (TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a GET." T)) - (Put (* ; "He did a PUT -- not undoable.") + (Put (* ; "He did a PUT -- not undoable.") (TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a Put." T)) (COND ((AND (SETQ UNDOFN (ASSOC (fetch THACTION of EVENT) TEDIT.HISTORY.TYPELST)) (SETQ UNDOFN (CADDR UNDOFN))) - (* ; - "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") + (* ; + "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") (APPLY* UNDOFN TEXTOBJ EVENT LEN CH# FIRSTPIECE)) (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (fetch THACTION of EVENT)) @@ -181,14 +173,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to UNDO." T]) (TEDIT.UNDO.INSERTION - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 01:33 by jds") + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 01:33 by jds") (* ;; "UNDO a prior Insert, Copy, or Include.") (PROG (OBJ DELETEFN) (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Keep TEdit from reusing the current cache piece in the future -- it is probably invalid") + "Keep TEdit from reusing the current cache piece in the future -- it is probably invalid") (\DELETECH CH# (IPLUS CH# LEN) LEN TEXTOBJ) (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) @@ -196,20 +188,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu CH# (IPLUS CH# LEN) TEXTOBJ) (* ; - "Fix the line descriptors & selection") + "Fix the line descriptors & selection") (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; - "Fix up the display for all this foofaraw") - (replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of TEXTOBJ) - with 'LEFT) + "Fix up the display for all this foofaraw") + (replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of TEXTOBJ) with 'LEFT) (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) TEXTOBJ) (* ; "Really fix the selection") - (replace THACTION of EVENT with 'Delete) - (* ; - "Make the UNDO be UNDOable, by changing the event to a deletion.") + (replace THACTION of EVENT with 'Delete) (* ; + "Make the UNDO be UNDOable, by changing the event to a deletion.") ]) (TEDIT.UNDO.DELETION - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 12:01 by jds") + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 12:01 by jds") (* ;; "UNDO a prior Deletion of text.") @@ -221,11 +211,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (SETQ INSPC (\CHTOPC CH# PCTB T)) (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Keep future people from stepping on the current cache piece, which is probably no longer valid.") + "Keep future people from stepping on the current cache piece, which is probably no longer valid.") (COND - ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (* ; - "Don't change read-only documents.") + ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (* ; "Don't change read-only documents.") (RETURN))) [COND ((IGREATERP CH# START-OF-PIECE) @@ -235,60 +223,50 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (replace THFIRSTPIECE of EVENT with NEWPIECE) (bind (TL _ 0) while (ILESSP TL LEN) do (\INSERTPIECE NEWPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in") - [COND - ([AND (SETQ OBJECT - (fetch (PIECE POBJ) - of NEWPIECE)) - (SETQ INSERTFN - (IMAGEOBJPROP OBJECT - 'WHENINSERTEDFN] + [COND + ([AND (SETQ OBJECT (fetch (PIECE POBJ) + of NEWPIECE)) + (SETQ INSERTFN (IMAGEOBJPROP OBJECT + 'WHENINSERTEDFN] (* ; - "If this is an imageobject, and it has an insertfn, call it.") - (APPLY* INSERTFN OBJECT ( - \TEDIT.PRIMARYW - TEXTOBJ) - NIL - (TEXTSTREAM TEXTOBJ] - (SETQ TL (IPLUS TL (fetch - (PIECE PLEN) - of FIRSTPIECE) - )) + "If this is an imageobject, and it has an insertfn, call it.") + (APPLY* INSERTFN OBJECT (\TEDIT.PRIMARYW + TEXTOBJ) + NIL + (TEXTSTREAM TEXTOBJ] + (SETQ TL (IPLUS TL (fetch (PIECE PLEN) of + FIRSTPIECE + ))) (* ; - "Keep track of how much we've re-inserted") - (SETQ FIRSTPIECE NPC) + "Keep track of how much we've re-inserted") + (SETQ FIRSTPIECE NPC) + (* ; "Move to the next piece to insert") + (AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) + of NPC))) + (SETQ NEWPIECE (create PIECE using FIRSTPIECE))) (* ; - "Move to the next piece to insert") - (AND NPC (SETQ NPC (fetch - (PIECE NEXTPIECE) - of NPC))) - (SETQ NEWPIECE (create PIECE - using FIRSTPIECE)) - ) (* ; - "Done here because \INSERTPIECE creams the NEXTPIECE field.") - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) - LEN)) + "Done here because \INSERTPIECE creams the NEXTPIECE field.") + (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + LEN)) (* ; - "Reset the text length and EOF ptr of the text stream.") + "Reset the text length and EOF ptr of the text stream.") (\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ; - "Fix the line descriptors & selection") + "Fix the line descriptors & selection") (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; - "Fix up the display for all this foofaraw") - (replace (SELECTION CH#) of SEL with CH#) - (* ; - "Make the selection point at the re-inserted text") + "Fix up the display for all this foofaraw") + (replace (SELECTION CH#) of SEL with CH#) (* ; + "Make the selection point at the re-inserted text") (replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN)) (replace (SELECTION DCH) of SEL with LEN) (replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT)) (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) (\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection") - (replace THACTION of EVENT with 'Insert) - (* ; - "Make the UNDO be UNDOable, by changing the event to a insertion.") + (replace THACTION of EVENT with 'Insert) (* ; + "Make the UNDO be UNDOable, by changing the event to a insertion.") ]) (TEDIT.REDO - [LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:27 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:27 by jds") (* ;; "REDO the last thing this guy did.") @@ -302,7 +280,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu NIL) ((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) (* ; - "There really is something to REDO Decide what, & do it.") + "There really is something to REDO Decide what, & do it.") (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (\SHOWSEL SEL NIL NIL) @@ -316,7 +294,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (Delete (* ; "It was a deletion") (\TEDIT.DELETE SEL TEXTOBJ)) (Replace (* ; - "It was a replacement (a del/insert combo)") + "It was a replacement (a del/insert combo)") (TEDIT.REDO.REPLACE TEXTOBJ EVENT)) (LowerCase (* ; "He lower-cased something") (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) @@ -324,14 +302,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) (Looks (* ; "It was a looks change") (TEDIT.REDO.LOOKS TEXTOBJ EVENT (IMAX 1 - (SELECTQ (fetch (SELECTION - POINT) + (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION - CH#) + (LEFT (fetch (SELECTION CH#) of SEL)) (RIGHT (fetch (SELECTION - CHLIM) + CHLIM) of SEL)) NIL)))) (ParaLooks (* ; "It was a Paragraph looks change") @@ -351,12 +327,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (CH (TEDIT.PROMPTPRINT TEXTOBJ "done.") (replace (SELECTION CH#) of SEL with CH) [replace (SELECTION CHLIM) of SEL - with (IPLUS CH (NCHARS (fetch THAUXINFO - of EVENT] + with (IPLUS CH (NCHARS (fetch THAUXINFO of EVENT] (replace (SELECTION DCH) of SEL with (NCHARS (fetch THAUXINFO of EVENT))) - (replace (SELECTION POINT) of SEL with - 'RIGHT) + (replace (SELECTION POINT) of SEL with 'RIGHT) (\FIXSEL SEL TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ) (\SHOWSEL SEL NIL T)) @@ -383,99 +357,90 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to REDO." T]) (TEDIT.REDO.INSERTION - [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 21-Apr-93 01:06 by jds") + [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 21-Apr-93 01:06 by jds") (* ; - "REDO a prior Insert/Copy/Include of text.") + "REDO a prior Insert/Copy/Include of text.") (PROG (INSPC INSPC# NPC (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (LEN (fetch THLEN of EVENT)) (FIRSTPIECE (create PIECE using (fetch THFIRSTPIECE of EVENT) - PNEW _ T)) + PNEW _ T)) (OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) OBJ COPYFN ORIGFIRSTPC) (SETQ ORIGFIRSTPC FIRSTPIECE) - (replace THFIRSTPIECE of EVENT with FIRSTPIECE) - (* ; - "So we can UNDO this, and remove the right set of pieces.") + (replace THFIRSTPIECE of EVENT with FIRSTPIECE) (* ; + "So we can UNDO this, and remove the right set of pieces.") (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Force any further insertions to make new pieces.") + "Force any further insertions to make new pieces.") (SETQ NPC (fetch (PIECE NEXTPIECE) of FIRSTPIECE)) (SETQ INSPC (\CHTOPC CH# PCTB T)) [SETQ INSPC (COND ((IEQP CH# START-OF-PIECE) (* ; - "We're inserting just before an existing piece") + "We're inserting just before an existing piece") INSPC) (T (* ; - "We must split this piece, and insert before the second part.") + "We must split this piece, and insert before the second part.") (\SPLITPIECE INSPC (- CH# START-OF-PIECE) TEXTOBJ] (bind (TL _ 0) while (ILESSP TL LEN) do + (* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.") - (* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.") - - [COND - ((SETQ OBJ (fetch (PIECE POBJ) of FIRSTPIECE)) + [COND + ((SETQ OBJ (fetch (PIECE POBJ) of FIRSTPIECE)) (* ; "This piece describes an object") - [COND - [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN)) - (SETQ OBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of - TEXTOBJ - ) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) - (COND - ((EQ OBJ 'DON'T) - (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T) - (RETFROM 'TEDIT.COPY)) - (T (replace (PIECE POBJ) of FIRSTPIECE with OBJ] - (OBJ (replace (PIECE POBJ) of FIRSTPIECE with (COPY OBJ] - (COND - ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) + [COND + [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN)) + (SETQ OBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) + (COND + ((EQ OBJ 'DON'T) + (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T) + (RETFROM 'TEDIT.COPY)) + (T (replace (PIECE POBJ) of FIRSTPIECE with OBJ] + (OBJ (replace (PIECE POBJ) of FIRSTPIECE with (COPY OBJ] + (COND + ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) (* ; - "If there's an eventfn for copying, use it.") - (APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ)) - 'DSP) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] - (\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in") - (SETQ TL (IPLUS TL (fetch (PIECE PLEN) of FIRSTPIECE))) + "If there's an eventfn for copying, use it.") + (APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) + 'DSP) + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] + (\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in") + (SETQ TL (IPLUS TL (fetch (PIECE PLEN) of FIRSTPIECE))) (* ; - "Keep track of how much we've re-inserted") - (SETQ FIRSTPIECE (create PIECE using NPC PNEW _ T)) + "Keep track of how much we've re-inserted") + (SETQ FIRSTPIECE (create PIECE using NPC PNEW _ T)) + (* ; "Move to the next piece to insert") + (AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC))) (* ; - "Move to the next piece to insert") - (AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC))) - (* ; - "Done here because \INSERTPIECE creams the NEXTPIECE field.") - ) + "Done here because \INSERTPIECE creams the NEXTPIECE field.") + ) (\TEDIT.DIFFUSE.PARALOOKS (fetch (PIECE PREVPIECE) of ORIGFIRSTPC) INSPC) (* ; - "propagate paragraph formatting into the new insertion") - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) - LEN)) + "propagate paragraph formatting into the new insertion") + (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + LEN)) (* ; - "Reset the text length and EOF ptr of the text stream.") + "Reset the text length and EOF ptr of the text stream.") (\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ; - "Fix the line descriptors & selection") + "Fix the line descriptors & selection") (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; - "Fix up the display for all this foofaraw") - (replace (SELECTION CH#) of SEL with CH#) - (* ; - "Make the selection point at the re-inserted text") + "Fix up the display for all this foofaraw") + (replace (SELECTION CH#) of SEL with CH#) (* ; + "Make the selection point at the re-inserted text") (replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN)) (replace (SELECTION DCH) of SEL with LEN) (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) (\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection") - (replace THACTION of EVENT with 'Insert) - (* ; - "Make the UNDO be UNDOable, by changing the event to a insertion.") + (replace THACTION of EVENT with 'Insert) (* ; + "Make the UNDO be UNDOable, by changing the event to a insertion.") ]) (TEDIT.UNDO.MOVE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds") + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds") (* ; "UNDO a MOVE command") (PROG ((TOOBJ (fetch THAUXINFO of EVENT)) (FROMOBJ (fetch THTEXTOBJ of EVENT)) @@ -484,29 +449,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu TOSEL TOTEXTLEN) (\SHOWSEL (fetch (TEXTOBJ SEL) of TOOBJ) NIL NIL) (* ; - "Turn off the selections in the old source and target documents") + "Turn off the selections in the old source and target documents") (\SHOWSEL (fetch (TEXTOBJ SEL) of FROMOBJ) NIL NIL) (\DELETECH CH# (IPLUS CH# LEN) LEN FROMOBJ) (* ; - "Delete the characters we moved, from the place we moved them to") + "Delete the characters we moved, from the place we moved them to") (\FIXDLINES (fetch (TEXTOBJ LINES) of FROMOBJ) (fetch (TEXTOBJ SEL) of FROMOBJ) CH# (IPLUS CH# LEN) FROMOBJ) (replace (SELECTION CH#) of (fetch (TEXTOBJ SEL) of FROMOBJ) - with (replace (SELECTION CHLIM) of (fetch (TEXTOBJ SEL) of FROMOBJ) - with CH#)) (* ; - "Make this document's selection be a point sel at the place the text used to be.") - (replace (SELECTION DCH) of (fetch (TEXTOBJ SEL) of FROMOBJ) with - 0) - (replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of FROMOBJ) - with 'LEFT) (* ; - "Mark lines for update, and fix the selection") - (SETQ TOTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ)) + with (replace (SELECTION CHLIM) of (fetch (TEXTOBJ SEL) of FROMOBJ) with CH#)) (* ; - "The pre-insertion len of the place the text is returning to, for the line udpater below") + "Make this document's selection be a point sel at the place the text used to be.") + (replace (SELECTION DCH) of (fetch (TEXTOBJ SEL) of FROMOBJ) with 0) + (replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of FROMOBJ) with 'LEFT) + (* ; + "Mark lines for update, and fix the selection") + (SETQ TOTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ))(* ; + "The pre-insertion len of the place the text is returning to, for the line udpater below") (\TEDIT.INSERT.PIECES TOOBJ SOURCECH# (fetch THFIRSTPIECE of EVENT) LEN) @@ -514,24 +477,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (\FIXILINES TOOBJ (fetch (TEXTOBJ SEL) of TOOBJ) SOURCECH# LEN TOTEXTLEN) (* ; - "Mark lines that need updating, and fix up the selection") + "Mark lines that need updating, and fix up the selection") (add (fetch (TEXTOBJ TEXTLEN) of TOOBJ) - LEN) (* ; - "Update the text length of the erstwhile move source") + LEN) (* ; + "Update the text length of the erstwhile move source") (TEDIT.UPDATE.SCREEN FROMOBJ) (* ; - "Update the erstwhile text location's image.") + "Update the erstwhile text location's image.") (COND ((NEQ FROMOBJ TOOBJ) (* ; - "If they aren't the same document, we need to update the other document image as well.") + "If they aren't the same document, we need to update the other document image as well.") (TEDIT.UPDATE.SCREEN TOOBJ))) (\FIXSEL (fetch (TEXTOBJ SEL) of TOOBJ) TOOBJ) (* ; - "Fix up the selections so their images will be OK") + "Fix up the selections so their images will be OK") (\FIXSEL (fetch (TEXTOBJ SEL) of FROMOBJ) FROMOBJ) (\COPYSEL (fetch (TEXTOBJ SEL) of FROMOBJ) TEDIT.SELECTION) (* ; - "It's handy to think of this as the last selection made, also.") + "It's handy to think of this as the last selection made, also.") (replace THACTION of EVENT with 'Move) (replace THTEXTOBJ of EVENT with TOOBJ) (replace THAUXINFO of EVENT with FROMOBJ) @@ -543,7 +506,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu NIL T]) (TEDIT.UNDO.REPLACE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds") + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds") (PROG ((OLDEVENT (fetch THOLDINFO of EVENT)) (CH# (fetch THCH# of EVENT)) (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) @@ -558,8 +521,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (replace THOLDINFO of EVENT with NIL) (\TEDIT.HISTORYADD TEXTOBJ OLDEVENT) (replace (SELECTION CH#) of SEL with CH#) - (replace (SELECTION CHLIM) of SEL with (IPLUS CH# (fetch THLEN of - OLDEVENT))) + (replace (SELECTION CHLIM) of SEL with (IPLUS CH# (fetch THLEN of OLDEVENT))) (replace (SELECTION DCH) of SEL with (fetch THLEN of OLDEVENT)) (replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT)) (replace THPOINT of OLDEVENT with (fetch THPOINT of EVENT)) @@ -567,7 +529,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (\SHOWSEL SEL NIL T]) (TEDIT.REDO.REPLACE - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-91 21:28 by jds") + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-91 21:28 by jds") (PROG ((OLDEVENT (fetch THOLDINFO of EVENT)) (CH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of TEXTOBJ))) (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) @@ -584,15 +546,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu TEXTOBJ) (replace (SELECTION POINT) of SEL with 'LEFT) (TEDIT.REDO.INSERTION TEXTOBJ EVENT CH#) - (replace THOLDINFO of EVENT with (SETQ OLDEVENT (fetch (TEXTOBJ TXTHISTORY) - of TEXTOBJ))) + (replace THOLDINFO of EVENT with (SETQ OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))) (replace THACTION of OLDEVENT with 'Replace) (replace THACTION of EVENT with 'Replace) (replace THCH# of EVENT with CH#) (\TEDIT.HISTORYADD TEXTOBJ EVENT]) (TEDIT.REDO.MOVE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:28 by jds") + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:28 by jds") (PROG ((FROMOBJ TEXTOBJ) (SOURCECH# (fetch THOLDINFO of EVENT)) (OLDCH# (fetch THCH# of EVENT)) @@ -607,12 +568,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1990, 1991, 1993, 1994, 1999 by Venu (\TEDIT.SET.SEL.LOOKS MOVESEL 'MOVE) (TEDIT.MOVE MOVESEL SEL]) ) -(PUTPROPS TEDITHISTORY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1990 1991 1993 -1994 1999)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1711 5083 (\TEDIT.HISTORYADD 1721 . 3606) (\TEDIT.CUMULATE.EVENTS 3608 . 5081)) (5136 -38333 (TEDIT.UNDO 5146 . 9098) (TEDIT.UNDO.INSERTION 9100 . 10686) (TEDIT.UNDO.DELETION 10688 . 16623) - (TEDIT.REDO 16625 . 23562) (TEDIT.REDO.INSERTION 23564 . 30211) (TEDIT.UNDO.MOVE 30213 . 34646) ( -TEDIT.UNDO.REPLACE 34648 . 36087) (TEDIT.REDO.REPLACE 36089 . 37514) (TEDIT.REDO.MOVE 37516 . 38331))) + (FILEMAP (NIL (1548 4840 (\TEDIT.HISTORYADD 1558 . 3393) (\TEDIT.CUMULATE.EVENTS 3395 . 4838)) (4893 +35988 (TEDIT.UNDO 4903 . 8883) (TEDIT.UNDO.INSERTION 8885 . 10419) (TEDIT.UNDO.DELETION 10421 . 15423) + (TEDIT.REDO 15425 . 22036) (TEDIT.REDO.INSERTION 22038 . 28108) (TEDIT.UNDO.MOVE 28110 . 32451) ( +TEDIT.UNDO.REPLACE 32453 . 33807) (TEDIT.REDO.REPLACE 33809 . 35165) (TEDIT.REDO.MOVE 35167 . 35986))) )) STOP diff --git a/library/TEDITHISTORY.LCOM b/library/tedit/TEDIT-HISTORY.LCOM similarity index 54% rename from library/TEDITHISTORY.LCOM rename to library/tedit/TEDIT-HISTORY.LCOM index 2679df6b70b60d955d810d072a4260d0979ce87d..5bdc5152a27560c56a204230091a10c785a48fcd 100644 GIT binary patch delta 841 zcmaDA_9=9Ndp#GIhMT94t8FYKlUBo`RABSG7y9cdbonacWVqU3OwYPGX*2PJVJ?j$LkQN=|B}v7V`2d45rL zW?s53M8qy9GpQ)CsM4+^H6^pe4rrHWh^~iceQ=0>P^6xCs@=v`hL%f@t;>})+fJtc*dM4&}j%``Mp(u8}u9=oqi z!M>)NFJYckFg7zVG*qw(2yzYc^bZZzbphFr?n*-|0}CqyLyAHz&p9v^>U(kmQNa;vqgVfBBbY}%p59Gdql+|M3jlZM_N@Q_ delta 839 zcmbVK&ui3B5T?JY5=4+{Rb&XYZWa^rlHG1zlt@g{c5QZ(CfnkoP||L!OXFtA?n)Pt zp1c$hA>cpZsq8;c@FaNg;>EiMK@blfJUQ7dC_Q@lX6C(bX1_q zW;=#%YZc41t-34}HM{J)hT~c2-1Bs=u3`OhZME#z9Ir0iCLGqG{DIz1u$w3XQB;wr zvc$r6)-1Z&0H%q}Dq$lE`+y~3xfey?_d9W~3#9N@s2~U|G=eV5WB)yuWK|}rNLlXG zloI9d2Q8jbc!(3q1y!ajjArUKqeiH8`rAR&+3Rajv(w&*lTa2!^tY2B>7N=z0$C}P z2rxTOg4S->fo^<5h1_!0Phn;*t>&lGyZI|AvoL$WK|2YbHRE1qs1|7qD;0UYx69K4 z5K%1_R0$XGpGpYFJQ^-pIN7ppnxL8rlXIa2RcqjnFO7{cgTskpW{xM{O`wTp-)7Oo z*;Zzfb6@ZWxhwjzEj|*fPFWJj`8Rzx<$`qQ<*MDWyqXigzXWwTRM+=uQ zWAI_|)!6)r1jDKLxP8yn*VkbvE^X)L)5DxLxm4ho^dkmea~9UQ#XUw$hxnUopud%; zbEAjzZAUjp>84?0+Nb=*bZh3!RJA;cuI=NH8#UK+Tz|wn=?{kE*1ht|Y7IZ}X4vY5 zum}&rB;E%jPTFx2benOD1ws`$1AGRm6f;=LpoBp2Z&FG!kbyzWIFxc6gWZ`wyr}9V diff --git a/library/TEDITLOOKS b/library/tedit/TEDIT-LOOKS similarity index 58% rename from library/TEDITLOOKS rename to library/tedit/TEDIT-LOOKS index 8b121b10..85af13d9 100644 --- a/library/TEDITLOOKS +++ b/library/tedit/TEDIT-LOOKS @@ -1,32 +1,29 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Jan-99 17:33:35" {DSK}sybalsky>lispcore3.0>library>TEDITLOOKS.;2 173603 - changes to%: (FNS TEDIT.LOOKS \TEDIT.CHANGE.LOOKS) +(FILECREATED "14-Jul-2022 16:55:49"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-LOOKS.;1 161854 - previous date%: "25-Aug-94 10:54:30" {DSK}sybalsky>lispcore3.0>library>TEDITLOOKS.;1) + :PREVIOUS-DATE "14-Jul-2022 11:12:19" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-LOOKS.;3) -(* ; " -Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1999 by John Sybalsky & Xerox Corporation. All rights reserved. -") +(PRETTYCOMPRINT TEDIT-LOOKSCOMS) -(PRETTYCOMPRINT TEDITLOOKSCOMS) - -(RPAQQ TEDITLOOKSCOMS +(RPAQQ TEDIT-LOOKSCOMS [ (* ;; "Support for Character looks (font, italic/bold, sub/superscripting, etc) and paragraph looks (margins, centered/justified, tabs, etc.)") - (FILES TEDITDCL) + (FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.TERMSA.FONTS NIL) (TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)) (TEDIT.DEFAULT.FMTSPEC (\CREATE.TEDIT.DEFAULT.FMTSPEC)) (* ; "Original was (create FMTSPEC QUAD _ 'LEFT 1STLEFTMAR _ 0 LEFTMAR _ 0 RIGHTMAR _ 0 LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0 TABSPEC _ (CONS NIL NIL)).") (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + "Changed by yabu.fx, for SUNLOADUP without DWIM.") (TEDIT.TERMSA.FONTS NIL) (TEDIT.KNOWN.FONTS '((Classic 'CLASSIC) (Modern 'MODERN) @@ -40,11 +37,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (TEDIT.FACE.MENU (\CREATE.TEDIT.FACE.MENU)) (* ; "Original was (create MENU ITEMS _ '(Bold Italic Bold%% Italic Regular) CENTERFLG _ T TITLE _ %"Face:%").") (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + "Changed by yabu.fx, for SUNLOADUP without DWIM.") (TEDIT.SIZE.MENU (\CREATE.TEDIT.SIZE.MENU)) (* ; "Original was (create MENU ITEMS _ '(6 7 8 9 10 11 12 14 18 24 30 36) CENTERFLG _ T MENUROWS _ 4 TITLE _ %"Type Size:%").") (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + "Changed by yabu.fx, for SUNLOADUP without DWIM.") ) (GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT @@ -76,7 +73,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (COMS (* ; "Revision-mark support") (FNS \TEDIT.MARK.REVISION)) (COMS (* ; - "Added by yabu.fx, for SUNLOADUP without DWIM") + "Added by yabu.fx, for SUNLOADUP without DWIM") (FNS \CREATE.TEDIT.DEFAULT.FMTSPEC \CREATE.TEDIT.FACE.MENU \CREATE.TEDIT.SIZE.MENU)) (COMS (* ; "Style-sheet support") (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET @@ -101,7 +98,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, ) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -113,7 +110,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -135,8 +132,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (Times% Roman 'TIMESROMAN))) ) -(RPAQQ TEDIT.CHARLOOKS.FEATURES (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY OVERLINE - STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT)) +(RPAQQ TEDIT.CHARLOOKS.FEATURES (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY OVERLINE + STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT)) (RPAQ TEDIT.FACE.MENU (\CREATE.TEDIT.FACE.MENU)) @@ -149,7 +146,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, ) (ADDTOVAR FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT) - (TEDIT.ICON.FONT MENUFONT)) + (TEDIT.ICON.FONT MENUFONT)) @@ -158,10 +155,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (DEFINEQ (CHARLOOKS.FROM.FONT - [LAMBDA (FONT) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (FONT) (* ; "Edited 30-May-91 21:45 by jds") - (* Create a CHARLOOKS from a font, filling in such fields as can be inferred - from the font descriptor.) + (* Create a CHARLOOKS from a font, filling in such fields as can be inferred from + the font descriptor.) (PROG ((LOOKS (create CHARLOOKS CLFONT _ FONT))) @@ -170,24 +167,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SELECTQ (CAR (FONTPROP FONT 'FACE)) (BOLD (replace (CHARLOOKS CLBOLD) of LOOKS with T) (replace (CHARLOOKS CLITAL) of LOOKS with NIL)) - (replace (CHARLOOKS CLBOLD) of LOOKS with NIL)) - (* Set the boldness bit, if it's a - bold font.) + (replace (CHARLOOKS CLBOLD) of LOOKS with NIL))(* Set the boldness bit, if it's a + bold font.) (SELECTQ (CADR (FONTPROP FONT 'FACE)) (ITALIC (replace (CHARLOOKS CLITAL) of LOOKS with T)) - (replace (CHARLOOKS CLITAL) of LOOKS with NIL)) - (* Set the italic bit, if it's - italic) + (replace (CHARLOOKS CLITAL) of LOOKS with NIL))(* Set the italic bit, if it's italic) (with CHARLOOKS LOOKS (SETQ CLSIZE (FONTPROP FONT 'SIZE)) (* Grab the size from the font) - (SETQ CLOFFSET 0) (* And let it be neither super- - nor subscripted.) - ) + (SETQ CLOFFSET 0) (* And let it be neither super- + nor subscripted.) + ) (RETURN LOOKS]) (EQCLOOKS - [LAMBDA (CLOOK1 CLOOK2) (* ; - "Edited 1-Jun-93 11:49 by sybalsky:mv:envos") + [LAMBDA (CLOOK1 CLOOK2) (* ; + "Edited 1-Jun-93 11:49 by sybalsky:mv:envos") (* ;; "Given two sets of CHARLOOKS, are they effectively the same?") @@ -196,10 +190,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (fetch (CHARLOOKS CLFONT) of CLOOK2)) (AND (type? FONTCLASS (ffetch (CHARLOOKS CLFONT) of CLOOK1)) (type? FONTCLASS (ffetch (CHARLOOKS CLFONT) of CLOOK2)) - (EQ (ffetch FONTCLASSNAME of (ffetch (CHARLOOKS CLFONT) - of CLOOK1)) - (ffetch FONTCLASSNAME of (ffetch (CHARLOOKS CLFONT) - of CLOOK2] + (EQ (ffetch FONTCLASSNAME of (ffetch (CHARLOOKS CLFONT) of CLOOK1)) + (ffetch FONTCLASSNAME of (ffetch (CHARLOOKS CLFONT) of CLOOK2] (EQ (ffetch (CHARLOOKS CLPROTECTED) of CLOOK1) (ffetch (CHARLOOKS CLPROTECTED) of CLOOK2)) (EQ (ffetch (CHARLOOKS CLINVISIBLE) of CLOOK1) @@ -226,150 +218,122 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (ffetch (CHARLOOKS CLUSERINFO) of CLOOK2]) (SAMECLOOKS - [LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 30-May-91 21:45 by jds") (* ;; "Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES") (for F in FEATURES always (SELECTQ F - (FAMILY (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK1) - 'FAMILY) - (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK2) - 'FAMILY))) - (SIZE (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK1) - 'SIZE) - (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK2) - 'SIZE))) - (EXPANSION (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK1) - 'EXPANSION) - (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK2) - 'EXPANSION))) - (SLOPE (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK1) - 'SLOPE) - (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK2) - 'SLOPE))) - (WEIGHT (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK1) - 'WEIGHT) - (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK2) - 'WEIGHT))) - (SUPERSCRIPT (EQ (fetch (CHARLOOKS CLOFFSET) - of CLOOK1) - (fetch (CHARLOOKS CLOFFSET) - of CLOOK2))) - (INVISIBLE (EQ (fetch (CHARLOOKS CLINVISIBLE) - of CLOOK1) - (fetch (CHARLOOKS CLINVISIBLE) - of CLOOK2))) - (SELECTPOINT (EQ (fetch (CHARLOOKS CLSELHERE) - of CLOOK1) - (fetch (CHARLOOKS CLSELHERE) - of CLOOK2))) - (PROTECTED (EQ (fetch (CHARLOOKS CLPROTECTED) - of CLOOK1) - (fetch (CHARLOOKS CLPROTECTED) - of CLOOK2))) - (OVERLINE (EQ (fetch (CHARLOOKS CLOLINE) - of CLOOK1) - (fetch (CHARLOOKS CLOLINE) - of CLOOK2))) - (STRIKEOUT (EQ (fetch (CHARLOOKS CLSTRIKE) - of CLOOK1) - (fetch (CHARLOOKS CLSTRIKE) - of CLOOK2))) - (UNDERLINE (EQ (fetch (CHARLOOKS CLULINE) - of CLOOK1) - (fetch (CHARLOOKS CLULINE) - of CLOOK2))) - (FACE (EQUAL (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK1) - 'FACE) - (FONTPROP (fetch (CHARLOOKS CLFONT) - of CLOOK2) - 'FACE))) - (ERROR (CONCAT F + (FAMILY (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) + 'FAMILY) + (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) + 'FAMILY))) + (SIZE (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) + 'SIZE) + (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) + 'SIZE))) + (EXPANSION (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) + 'EXPANSION) + (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) + 'EXPANSION))) + (SLOPE (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) + 'SLOPE) + (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) + 'SLOPE))) + (WEIGHT (EQ (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) + 'WEIGHT) + (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) + 'WEIGHT))) + (SUPERSCRIPT (EQ (fetch (CHARLOOKS CLOFFSET) of CLOOK1) + (fetch (CHARLOOKS CLOFFSET) of CLOOK2))) + (INVISIBLE (EQ (fetch (CHARLOOKS CLINVISIBLE) of CLOOK1) + (fetch (CHARLOOKS CLINVISIBLE) of CLOOK2))) + (SELECTPOINT (EQ (fetch (CHARLOOKS CLSELHERE) of CLOOK1) + (fetch (CHARLOOKS CLSELHERE) of CLOOK2))) + (PROTECTED (EQ (fetch (CHARLOOKS CLPROTECTED) of CLOOK1) + (fetch (CHARLOOKS CLPROTECTED) of CLOOK2))) + (OVERLINE (EQ (fetch (CHARLOOKS CLOLINE) of CLOOK1) + (fetch (CHARLOOKS CLOLINE) of CLOOK2))) + (STRIKEOUT (EQ (fetch (CHARLOOKS CLSTRIKE) of CLOOK1) + (fetch (CHARLOOKS CLSTRIKE) of CLOOK2))) + (UNDERLINE (EQ (fetch (CHARLOOKS CLULINE) of CLOOK1) + (fetch (CHARLOOKS CLULINE) of CLOOK2))) + (FACE (EQUAL (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) + 'FACE) + (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) + 'FACE))) + (ERROR (CONCAT F " is an unknown feature of character looks. Detected in SAMECLOOKS" - ]) + ]) (\TEDIT.UNIQUIFY.CHARLOOKS - [LAMBDA (NEWLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:40 by jds") + [LAMBDA (NEWLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:40 by jds") (* Assure that there is only ONE of a given CHARLOOKS in the document--so that - all instances of that set of looks share structure.) + all instances of that set of looks share structure.) (COND - ((for LOOK in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) - thereis (EQCLOOKS NEWLOOKS LOOK))) + ((for LOOK in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) thereis (EQCLOOKS NEWLOOKS LOOK))) (T (push (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) - NEWLOOKS) + NEWLOOKS) NEWLOOKS]) (TEDIT.CARETLOOKS - [LAMBDA (STREAM LOOKS) (* ; "Edited 30-May-91 21:40 by jds") + [LAMBDA (STREAM LOOKS) (* ; "Edited 30-May-91 21:40 by jds") (* ;; "Set the 'Caret looks' for a TEdit document, i.e., the looks that will be applied to newly-typed characters from here on.") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) CHARLOOKS) (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY - TEXTOBJ - (\TEDIT.PARSE.CHARLOOKS.LIST - LOOKS - (fetch (TEXTOBJ CARETLOOKS) - of TEXTOBJ) - TEXTOBJ)) + TEXTOBJ + (\TEDIT.PARSE.CHARLOOKS.LIST + LOOKS + (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + TEXTOBJ)) TEXTOBJ)) (* ; - "Parse up the looks he gave us, to make sure they're a valid CHARLOOKS") + "Parse up the looks he gave us, to make sure they're a valid CHARLOOKS") (COND ((NEQ CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) (* ; - "Only change the caret looks if they really changed") + "Only change the caret looks if they really changed") (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; "Changing the caret's looks means we can't type into the same piece any more. Force the next insert to create a new one.") (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with CHARLOOKS]) (TEDIT.COPY.LOOKS - [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 30-May-91 21:43 by jds") + [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 30-May-91 21:43 by jds") (* ;; "Copy the CHARACTER LOOKS of one piece of text (actually, the first selected character) to another piece of text") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) LOOKS LEN) (* ; - "get the character looks of the first character of SOURCE") - [SETQ LOOKS (fetch (PIECE PLOOKS) - of (CL:TYPECASE SOURCE - ((SMALLP FIXP) (\CHTOPC SOURCE (fetch (TEXTOBJ PCTB) - of TEXTOBJ))) - (SELECTION - (\SHOWSEL SOURCE NIL NIL) + "get the character looks of the first character of SOURCE") + [SETQ LOOKS (fetch (PIECE PLOOKS) of (CL:TYPECASE SOURCE + ((SMALLP FIXP) (\CHTOPC SOURCE (fetch (TEXTOBJ + PCTB) + of TEXTOBJ))) + (SELECTION + (\SHOWSEL SOURCE NIL NIL) (* ; - "Turn off the source selection, so it doesn't hang around after the copy.") - (\CHTOPC (fetch (SELECTION CH#) of SOURCE) - (fetch (TEXTOBJ PCTB) of (fetch - (SELECTION \TEXTOBJ) - of SOURCE)))) - (T (\ILLEGAL.ARG SOURCE)))] + "Turn off the source selection, so it doesn't hang around after the copy.") + (\CHTOPC (fetch (SELECTION CH#) of SOURCE) + (fetch (TEXTOBJ PCTB) + of (fetch (SELECTION \TEXTOBJ) + of SOURCE)))) + (T (\ILLEGAL.ARG SOURCE)))] (COND - [(type? SELECTION DEST) (* ; - "make sure that the destination selection is in this document") + [(type? SELECTION DEST) (* ; + "make sure that the destination selection is in this document") (COND ((NEQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of DEST)) (\LISPERROR "Destination selection is not in stream " STREAM] (T (* ; - "set the LEN arg for TEDIT.LOOKS to be 1 since we just have a char pos.") + "set the LEN arg for TEDIT.LOOKS to be 1 since we just have a char pos.") (SETQ LEN 1))) (TEDIT.LOOKS TEXTOBJ LOOKS DEST LEN]) (\TEDIT.GET.CHARLOOKS - [LAMBDA (PC FILE LOOKSARRAY PREVPC) (* ; "Edited 30-May-91 21:43 by jds") + [LAMBDA (PC FILE LOOKSARRAY PREVPC) (* ; "Edited 30-May-91 21:43 by jds") (* ;;; "Set the PLOOKS for the current piece, PC, according to what the file says") @@ -381,112 +345,107 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (replace (PIECE PNEW) of PC with T))) (COND ((NOT (ZEROP (LOGAND FLAGS 2))) (* ; - "This text is FAT--16 bit characters.") + "This text is FAT--16 bit characters.") (replace (PIECE PFATP) of PC with T))) (replace (PIECE PLOOKS) of PC with (ELT LOOKSARRAY (\SMALLPIN FILE))) (* ; - "Look the looks up in the array we built according to specs earlier") + "Look the looks up in the array we built according to specs earlier") (COND - [(fetch (PIECE PFATP) of PC) (* ; - "For a fat piece, convert bytes to characters") + [(fetch (PIECE PFATP) of PC) (* ; + "For a fat piece, convert bytes to characters") (COND ((AND PREVPC (fetch (PIECE PFATP) of PREVPC)) - (replace (PIECE PLEN) of PC with (FOLDHI (FETCH (PIECE PLEN) - OF PC) - 2))) + (replace (PIECE PLEN) of PC with (FOLDHI (FETCH (PIECE PLEN) OF PC) + 2))) (T (* ; - "The prior piece wasn't fat and this one is. Take account of the 255-255-0 in the length") - (replace (PIECE PLEN) of PC with (FOLDHI (IDIFFERENCE - (fetch (PIECE PLEN) + "The prior piece wasn't fat and this one is. Take account of the 255-255-0 in the length") + (replace (PIECE PLEN) of PC with (FOLDHI (IDIFFERENCE (fetch (PIECE PLEN) of PC) - 3) - 2)) + 3) + 2)) (add (fetch (PIECE PFPOS) of PC) - 3] + 3] ((AND PREVPC (fetch (PIECE PFATP) of PREVPC)) (* ;; "The prior piece was fat and this one isn't. Take account of the 255-0 on the front of this piece's chars.") - (replace (PIECE PLEN) of PC with (IDIFFERENCE (fetch (PIECE PLEN) - of PC) - 2)) + (replace (PIECE PLEN) of PC with (IDIFFERENCE (fetch (PIECE PLEN) of PC) + 2)) (add (fetch (PIECE PFPOS) of PC) - 2]) + 2]) (\TEDIT.UNPARSE.CHARLOOKS.LIST - [LAMBDA (LOOKS) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (LOOKS) (* ; "Edited 30-May-91 21:45 by jds") (* Convert a CHARLOOKS into an - equivalent PList-form for external - consumption) + equivalent PList-form for external + consumption) (PROG ((NEWLOOKS NIL) OFFSET) (for PROP in (LIST (fetch (CHARLOOKS CLSTYLE) of LOOKS) - (fetch (CHARLOOKS CLUSERINFO) of LOOKS) - (ONOFF (fetch (CHARLOOKS CLINVERTED) of LOOKS)) - (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) - 'WEIGHT) - (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) - 'SLOPE) - (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) - 'EXPANSION) - (ONOFF (fetch (CHARLOOKS CLULINE) of LOOKS)) - (ONOFF (fetch (CHARLOOKS CLSTRIKE) of LOOKS)) - (ONOFF (fetch (CHARLOOKS CLOLINE) of LOOKS)) - (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) - 'FAMILY) - (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) - 'SIZE) - (ONOFF (fetch (CHARLOOKS CLPROTECTED) of LOOKS)) - (ONOFF (fetch (CHARLOOKS CLSELHERE) of LOOKS)) - (ONOFF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS))) - as PROPNAME - in '(STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE - FAMILY SIZE PROTECTED SELECTPOINT INVISIBLE) - do (push NEWLOOKS PROP) - (push NEWLOOKS PROPNAME)) + (fetch (CHARLOOKS CLUSERINFO) of LOOKS) + (ONOFF (fetch (CHARLOOKS CLINVERTED) of LOOKS)) + (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) + 'WEIGHT) + (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) + 'SLOPE) + (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) + 'EXPANSION) + (ONOFF (fetch (CHARLOOKS CLULINE) of LOOKS)) + (ONOFF (fetch (CHARLOOKS CLSTRIKE) of LOOKS)) + (ONOFF (fetch (CHARLOOKS CLOLINE) of LOOKS)) + (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) + 'FAMILY) + (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) + 'SIZE) + (ONOFF (fetch (CHARLOOKS CLPROTECTED) of LOOKS)) + (ONOFF (fetch (CHARLOOKS CLSELHERE) of LOOKS)) + (ONOFF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS))) as PROPNAME + in '(STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE FAMILY + SIZE PROTECTED SELECTPOINT INVISIBLE) do (push NEWLOOKS PROP) + (push NEWLOOKS PROPNAME)) (push NEWLOOKS (IABS (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0))) + 0))) [push NEWLOOKS (COND - ((IGREATERP (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0) - 'SUPERSCRIPT) - ((ILESSP (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0) - 'SUBSCRIPT) - (T 'SUPERSCRIPT] + ((IGREATERP (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0) + 'SUPERSCRIPT) + ((ILESSP (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0) + 'SUBSCRIPT) + (T 'SUPERSCRIPT] (RETURN NEWLOOKS]) (TEDIT.MODIFYLOOKS - [LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* ; "Edited 30-May-91 21:45 by jds") (* Modify the screen to allow for underlining, etc. - Also, restore the vertical offset to the baseline.) + Also, restore the vertical offset to the baseline.) (PROG ((CURX (DSPXPOSITION NIL DS)) (CURY (DSPYPOSITION NIL DS)) (FONT (fetch (CHARLOOKS CLFONT) of LOOKS))) (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) (* It's underlined.) + ((fetch (CHARLOOKS CLULINE) of LOOKS) (* It's underlined.) (MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY) (fetch (LINEDESCRIPTOR LTRUEDESCENT) of LINE))) DS) (RELDRAWTO (IDIFFERENCE CURX STARTX) 0 1 'PAINT DS))) (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) (* Over-line) + ((fetch (CHARLOOKS CLOLINE) of LOOKS) (* Over-line) (MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT 'ASCENT] DS) (RELDRAWTO (IDIFFERENCE CURX STARTX) 0 1 'PAINT DS))) (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* Struck-thru) + ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* Struck-thru) (MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT 'ASCENT) 3)) DS) (RELDRAWTO (IDIFFERENCE CURX STARTX) 0 1 'PAINT DS))) (COND - ((fetch (CHARLOOKS CLINVERTED) of LOOKS)(* Inverse video) + ((fetch (CHARLOOKS CLINVERTED) of LOOKS) (* Inverse video) (BITBLT NIL NIL NIL DS STARTX (IDIFFERENCE CURY (FONTPROP FONT 'DESCENT)) (IDIFFERENCE CURX STARTX) (FONTPROP FONT 'HEIGHT) @@ -495,11 +454,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (MOVETO CURX LINEBASEY DS]) (TEDIT.NEW.FONT - (LAMBDA (TEXTOBJ) (* jds " 8-Feb-85 11:27") - (PROG ((NAME (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Name of font: ")))) - (AND NAME (SETQ TEDIT.KNOWN.FONTS (NCONC1 TEDIT.KNOWN.FONTS (LIST NAME (KWOTE (U-CASE - NAME))))) - (RETURN (U-CASE NAME)))))) + [LAMBDA (TEXTOBJ) (* jds " 8-Feb-85 11:27") + (PROG [(NAME (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Name of font: "] + (AND NAME [SETQ TEDIT.KNOWN.FONTS (NCONC1 TEDIT.KNOWN.FONTS (LIST NAME (KWOTE (U-CASE + NAME] + (RETURN (U-CASE NAME]) (\TEDIT.PUT.CHARLOOKS [LAMBDA (FILE CH1 CHLIM LOOKS OLDPC EDITSTENTATIVE LOOKSHARRAY PREVFATP) @@ -511,30 +470,28 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, STR) (\DWOUT FILE (IDIFFERENCE CHLIM CH1)) (* ; "The length of this run of looks") (\SMALLPOUT FILE \PieceDescriptorLOOKS) (* ; - "Mark this as setting the piece's looks") + "Mark this as setting the piece's looks") [\BOUT FILE (LOGOR (COND ((AND EDITSTENTATIVE OLDPC (fetch (PIECE PNEW) of OLDPC)) (* ; - "If this is a tentative edit, save the newness flag") + "If this is a tentative edit, save the newness flag") 1) (T (* ; "Otherwise, don't bother") 0)) (COND ((AND OLDPC (fetch (PIECE PFATP) of OLDPC)) (* ; - "If this piece contains fat characters, remember that fact.") + "If this piece contains fat characters, remember that fact.") 2) (T (* ; "Otherwise, don't bother") 0] - (\SMALLPOUT FILE (GETHASH LOOKS LOOKSHARRAY)) (* ; - "The index into the list of fonts") + (\SMALLPOUT FILE (GETHASH LOOKS LOOKSHARRAY)) (* ; "The index into the list of fonts") ]) (\TEDIT.CARETLOOKS.VERIFY - [LAMBDA (TEXTOBJ NEWLOOKS) (* ; "Edited 30-May-91 21:41 by jds") - (* Check with the user's - CARETLOOKSFN to see if he wants to - make changes) + [LAMBDA (TEXTOBJ NEWLOOKS) (* ; "Edited 30-May-91 21:41 by jds") + (* Check with the user's CARETLOOKSFN + to see if he wants to make changes) (PROG ((CARETFN (TEXTPROP TEXTOBJ 'CARETLOOKSFN)) LOOKS) (SETQ LOOKS (AND CARETFN (APPLY* CARETFN NEWLOOKS TEXTOBJ))) @@ -543,15 +500,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (OR (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ))) (LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS LOOKS TEXTOBJ)) - (T (* He didn't give us any guidance, - so return the looks unmodified.) + (T (* He didn't give us any guidance, so + return the looks unmodified.) NEWLOOKS]) (\TEDIT.GET.INSERT.CHARLOOKS - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (TEXTOBJ SEL) (* ; "Edited 30-May-91 21:45 by jds") (* Given a default source of charlooks, set us up some good ones. - IN particular, reset CLPROTECTED if need be.) + IN particular, reset CLPROTECTED if need be.) (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) [CH# (IMAX 1 (IMIN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) @@ -563,61 +520,57 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SETQ PIECE (\CHTOPC CH# PCTB)) [COND [(NULL PIECE) (* No piece to take looks from; - use the default) + use the default) (SETQ LOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) TEXTOBJ] ((ATOM PIECE) (* Trying to take from the - pseudo-piece at the end.) + pseudo-piece at the end.) (COND [(ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* No characters to steal from. - Use the defaults) + Use the defaults) (SETQ LOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT - ) + (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) TEXTOBJ] (T (* Otherwise, steal the looks of the - last character) - (SETQ PIECE (fetch (PCTNODE PCE) - of (FINDNODE-INDEX PCTB (SUB1 (INDEX (fetch (PCTNODE - CHNUM) - of (\LASTNODE - PCTB)) - PCTB] + last character) + (SETQ PIECE (fetch (PCTNODE PCE) of (FINDNODE-INDEX + PCTB + (SUB1 (INDEX (fetch (PCTNODE CHNUM) + of (\LASTNODE PCTB)) + PCTB] [COND (LOOKS) ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PIECE)) (* His looks are protected; - we have to copy to a new CHARLOOKS.) + we have to copy to a new CHARLOOKS.) (SETQ LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS - using (fetch (PIECE PLOOKS) - of PIECE) - CLPROTECTED _ NIL CLSELHERE _ NIL) + using (fetch (PIECE PLOOKS) of PIECE) + CLPROTECTED _ NIL CLSELHERE _ NIL) TEXTOBJ))) - (T (* No protection, just reuse his - looks) + (T (* No protection, just reuse his looks) (SETQ LOOKS (fetch (PIECE PLOOKS) of PIECE] (RETURN (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS) TEXTOBJ]) (\TEDIT.GET.TERMSA.WIDTHS - (LAMBDA (TERMSA FONT) (* jds "22-OCT-83 21:36") - - (* If the guy is using a terminal table, get an updated set of widths to - reflect that.) + [LAMBDA (TERMSA FONT) (* jds "22-OCT-83 21:36") + + (* If the guy is using a terminal table, get an updated set of widths to reflect + that.) (PROG ((NWIDTHS (ARRAY 256 'SMALLP 0 0))) (for I from 0 to 255 do (\WORDSETA NWIDTHS I (TEDIT.CHARWIDTH I FONT TERMSA))) - (RETURN NWIDTHS)))) + (RETURN NWIDTHS]) (\TEDIT.LOOKS.UPDATE - [LAMBDA (STREAM PC) (* ; "Edited 30-May-91 21:47 by jds") + [LAMBDA (STREAM PC) (* ; "Edited 30-May-91 21:47 by jds") (* ;;; "Called under \FORMATLINE, on which it depends. At a piece boundary, update the line formatting fields such as ASCENT, DESCENT, etc. Also, skip over invisible characters") (DECLARE (USEDFREE LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT - INVISIBLERUNS NEWASCENT NEWDESCENT)) + INVISIBLERUNS NEWASCENT NEWDESCENT)) (COND (PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) (ORIGPC PC) @@ -625,10 +578,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, [COND ([OR (NOT (fetch (PIECE PREVPIECE) of ORIGPC)) (NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) - (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) - of ORIGPC] - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of ORIGPC) + (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) of ORIGPC] + (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) of ORIGPC) ORIGPC TEXTOBJ)) (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)) (T (SETQ PARALOOKS (fetch (TEXTSTREAM CURRENTPARALOOKS) of STREAM] @@ -637,12 +588,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (COND ((fetch (CHARLOOKS CLINVISIBLE) of TLOOKS) (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") + "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") (\EDITSETA LOOKS LOOKNO (fetch (PIECE PLEN) of ORIGPC)) (\RPLPTR CHLIST 0 LMInvisibleRun) (* ; - "Note the existence of an invisible run of characters here.") + "Note the existence of an invisible run of characters here.") (\RPLPTR WLIST 0 0) (add TLEN 1) (SETQ CHLIST (\ADDBASE CHLIST 2)) @@ -653,54 +604,49 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, ((AND ORIGPC (NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) (fetch (PIECE PPARALOOKS) of PREVPC))) (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of ORIGPC) + of ORIGPC) ORIGPC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS) - )) + (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of ORIGPC) + of ORIGPC) ORIGPC TEXTOBJ))) [while (AND ORIGPC (OR (ZEROP (fetch (PIECE PLEN) of ORIGPC)) - (fetch (CHARLOOKS CLINVISIBLE) of TLOOKS))) - do (* ; - "Skip over this run of invisible characters --and any trailing run of empty pieces") - (\EDITSETA LOOKS LOOKNO (IPLUS (fetch (PIECE PLEN) of ORIGPC) - (\EDITELT LOOKS LOOKNO))) + (fetch (CHARLOOKS CLINVISIBLE) of TLOOKS))) + do (* ; + "Skip over this run of invisible characters --and any trailing run of empty pieces") + (\EDITSETA LOOKS LOOKNO (IPLUS (fetch (PIECE PLEN) of ORIGPC) + (\EDITELT LOOKS LOOKNO))) (* ; - "Note the invisible run length for the line displayer") - (SETQ PREVPC ORIGPC) - (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC)) - (COND - ((NOT ORIGPC) (* ; - "We ran off the end of the document. Don't try to update paragraph looks.") - ) - ((NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) - (fetch (PIECE PPARALOOKS) of PREVPC)) + "Note the invisible run length for the line displayer") + (SETQ PREVPC ORIGPC) + (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC)) + (COND + ((NOT ORIGPC) (* ; + "We ran off the end of the document. Don't try to update paragraph looks.") + ) + ((NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) + (fetch (PIECE PPARALOOKS) of PREVPC)) (* ; - "Paragraph looks changed in the course of the invisible section.") - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch - (PIECE PPARALOOKS) - of ORIGPC) - ORIGPC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM - with PARALOOKS))) - (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch - (PIECE PLOOKS) - of ORIGPC) - ORIGPC TEXTOBJ] + "Paragraph looks changed in the course of the invisible section.") + (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) + of ORIGPC) + ORIGPC TEXTOBJ)) + (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) + (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) + of ORIGPC) + ORIGPC TEXTOBJ] (while (AND ORIGPC (ZEROP (fetch (PIECE PLEN) of ORIGPC))) - do (* ; - "Skip over any trailing pieces that are zero long") - (SETQ PREVPC ORIGPC) - (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC))) + do (* ; + "Skip over any trailing pieces that are zero long") + (SETQ PREVPC ORIGPC) + (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC))) (add CHNO (\EDITELT LOOKS LOOKNO)) (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) (* ; - "Keep track of how much invisible text we cross over") + "Keep track of how much invisible text we cross over") (SETQ NEWPC ORIGPC))) (COND - ([AND ORIGPC (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) - of STREAM] + ([AND ORIGPC (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of STREAM] (* ;; "Only update looks if there's really a new piece to update them from, and the looks have really changed") @@ -709,12 +655,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, [COND [(type? FONTCLASS (fetch (CHARLOOKS CLFONT) of TLOOKS)) (* ; - "For FONTCLASSes, we have to get the real font") + "For FONTCLASSes, we have to get the real font") (SETQ FONT (FONTCOPY (fetch (CHARLOOKS CLFONT) of TLOOKS) 'DEVICE 'DISPLAY] (T (* ; - "It's a font already, so no work is needed") + "It's a font already, so no work is needed") (SETQ FONT (fetch (CHARLOOKS CLFONT) of TLOOKS] [SETQ NEWASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT 'ASCENT) (OR (ffetch (CHARLOOKS CLOFFSET) @@ -727,29 +673,28 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, [COND ((fetch (FMTSPEC FMTHARDCOPY) of PARALOOKS) (* ; - "If it's a hardcopy-format line, grab the hardcopy widths.") + "If it's a hardcopy-format line, grab the hardcopy widths.") (SETQ FONT (FONTCOPY (fetch (CHARLOOKS CLFONT) of TLOOKS) 'DEVICE DEVICE] - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") (\EDITSETA LOOKS LOOKNO TLOOKS) (* ; - "Save the new looks for selection/display") + "Save the new looks for selection/display") (\RPLPTR CHLIST 0 LMLooksChange) (* ; - "Put a marker in the character list to denote a looks change") + "Put a marker in the character list to denote a looks change") (\RPLPTR WLIST 0 0) (* ; "Font changes have no width") (add TLEN 1) (SETQ CHLIST (\ADDBASE CHLIST 2)) (SETQ WLIST (\ADDBASE WLIST 2)) (* ; - "Account for the dummy marker/looks in TLEN") + "Account for the dummy marker/looks in TLEN") (COND ((ffetch (CHARLOOKS CLPROTECTED) of TLOOKS) (* ; - "If this line contains protected text, mark the linedescriptor accordingly") + "If this line contains protected text, mark the linedescriptor accordingly") (freplace (LINEDESCRIPTOR LHASPROT) of LINE with T))) (SETQ NEWPC ORIGPC)) [(AND ORIGPC (fetch (PIECE PREVPIECE) of ORIGPC) - (fetch (PIECE POBJ) of (fetch (PIECE PREVPIECE) of ORIGPC)) - ) + (fetch (PIECE POBJ) of (fetch (PIECE PREVPIECE) of ORIGPC))) (* ;; "After passing over an image object, always update the ascent and descent. This avoids losing that info if an image object is first on the line; we used to forget the starting font's data, which left following characters at the mercy of the imageobj.") @@ -769,7 +714,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (RETURN NEWPC]) (\TEDIT.PARSE.CHARLOOKS.LIST - [LAMBDA (NLOOKS OLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:46 by jds") + [LAMBDA (NLOOKS OLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:46 by jds") (* ;; "Takes a CHARLOOKS, a FONTDESCRIPTOR, or an ALST-format looks spec and parses it into a new CHARLOOKS. If OLOOKS is given, it will be used as the base for modifications; otherwise, TEDIT.DEFAULT.CHARLOOKS will be.") @@ -792,16 +737,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (INVISIBLE NIL) STYLE STYLESET UISET USERINFO NEWLOOKS NEWFONT NEWPCLOOKS INVERSEVIDEO) (* ; - "Construct the set of new looks to apply:") + "Construct the set of new looks to apply:") (COND - ((type? CHARLOOKS NLOOKS) (* ; - "We've already got a made-up set of looks; we'll just use it.") + ((type? CHARLOOKS NLOOKS) (* ; + "We've already got a made-up set of looks; we'll just use it.") (RETURN NLOOKS)) ((FONTP NLOOKS) (* ; - "It was a font spec. Make the looks be that font, otherwise unmodified.") + "It was a font spec. Make the looks be that font, otherwise unmodified.") (RETURN (CHARLOOKS.FROM.FONT NLOOKS))) (T (* ; - "We got an AList -- prepare looks changes in that form") + "We got an AList -- prepare looks changes in that form") (SETQ FONT (LISTGET NLOOKS 'FONT)) (SETQ FAMILY (LISTGET NLOOKS 'FAMILY)) (SETQ FACE (LISTGET NLOOKS 'FACE)) @@ -824,8 +769,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SETQ STYLESET (FMEMB 'STYLE NLOOKS)) (SETQ USERINFO (LISTGET NLOOKS 'USERINFO)) (SETQ UISET (FMEMB 'USERINFO NLOOKS)) - (SETQ NLOOKS NIL) (* ; - "Tell later code to use NEWLOOKS.") + (SETQ NLOOKS NIL) (* ; "Tell later code to use NEWLOOKS.") (SETQ NEWLOOKS NIL) [COND (FAMILY (SETQ NEWLOOKS (CONS 'FAMILY (CONS FAMILY NEWLOOKS] @@ -833,7 +777,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (FONT (SETQ FONT (CAR (NLSETQ (\DTEST FONT 'FONTDESCRIPTOR] [COND [(OR WEIGHT SLOPE EXPANSION) (* ; - "Setting one of these inhibits the FACE parameter") + "Setting one of these inhibits the FACE parameter") [AND WEIGHT (SETQ NEWLOOKS (CONS 'WEIGHT (CONS WEIGHT NEWLOOKS] [AND SLOPE (SETQ NEWLOOKS (CONS 'SLOPE (CONS SLOPE NEWLOOKS] (AND EXPANSION (SETQ NEWLOOKS (CONS 'EXPANSION (CONS EXPANSION NEWLOOKS] @@ -843,24 +787,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, [SETQ NEWPCLOOKS (COND [OLOOKS (create CHARLOOKS using OLOOKS CLFONT _ - (SETQ NEWFONT - (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) - of OLOOKS) - NEWLOOKS TEXTOBJ] + (SETQ NEWFONT (OR FONT (\TEDIT.FONTCOPY + (fetch (CHARLOOKS CLFONT) + of OLOOKS) + NEWLOOKS TEXTOBJ] (T (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS CLFONT _ (SETQ NEWFONT (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of - TEDIT.DEFAULT.CHARLOOKS - ) + (fetch (CHARLOOKS CLFONT) of TEDIT.DEFAULT.CHARLOOKS) (COND (SIZEINC (* ; - "There's a size change requested. Fix up the size of the font.") + "There's a size change requested. Fix up the size of the font.") (LISTPUT NEWLOOKS 'SIZE - (IPLUS (FONTPROP (fetch (CHARLOOKS - CLFONT) + (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT + ) of TEDIT.DEFAULT.CHARLOOKS ) @@ -869,22 +810,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, NEWLOOKS) (T NEWLOOKS)) TEXTOBJ] (* ; "Give this piece its new looks") - [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS with (EQ 'BOLD - (FONTPROP NEWFONT - 'WEIGHT] - [replace (CHARLOOKS CLITAL) of NEWPCLOOKS with (EQ 'ITALIC - (FONTPROP NEWFONT - 'SLOPE] - [AND PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS - with (EQ PROT 'ON] - [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS - with (EQ SELHERE 'ON] - [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS - with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS - with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS - with (EQ STRIKE 'ON] + [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS with (EQ 'BOLD (FONTPROP NEWFONT + 'WEIGHT] + [replace (CHARLOOKS CLITAL) of NEWPCLOOKS with (EQ 'ITALIC (FONTPROP NEWFONT + 'SLOPE] + [AND PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS with (EQ PROT 'ON] + [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS with (EQ SELHERE + 'ON] + [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS with (EQ ULINE 'ON] + [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS with (EQ OLINE 'ON] + [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS with (EQ STRIKE 'ON] [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS with (EQ INVISIBLE 'ON] [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS @@ -894,50 +829,42 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) (AND OFFSETINC (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) of - NEWPCLOOKS - ) - 0) - OFFSETINC))) - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT - 'SIZE)) + with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) of NEWPCLOOKS) + 0) + OFFSETINC))) + (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) (RETURN NEWPCLOOKS]) (\TEDIT.FLUSH.UNUSED.LOOKS - [LAMBDA (TEXTOBJ FIRSTPC) (* ; "Edited 30-May-91 21:47 by jds") + [LAMBDA (TEXTOBJ FIRSTPC) (* ; "Edited 30-May-91 21:47 by jds") (* ;; "Run thru the CHARLOOKS and PARALOOKS lists for this document, and flush any looks that aren't being used in the document itself.") (PROG ((CHARLOOKS (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) (PARALOOKS (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ))) - (for LOOKS in CHARLOOKS do (* ; - "Reset the in-use mark in all CHARLOOKSs") - (replace (CHARLOOKS CLMARK) of LOOKS - with NIL)) - (for LOOKS in PARALOOKS do (* ; - "Reset the in-use mark in all FMTSPECs") - (replace (FMTSPEC FMTMARK) of LOOKS - with NIL)) - (while FIRSTPC do (* ; - "Now run thru the pieces in the document, marking the looks that are really in use.") - (replace (CHARLOOKS CLMARK) of (fetch (PIECE PLOOKS) - of FIRSTPC) - with T) - (replace (FMTSPEC FMTMARK) of (fetch (PIECE PPARALOOKS - ) - of FIRSTPC) - with T) - (SETQ FIRSTPC (fetch (PIECE NEXTPIECE) of FIRSTPC))) - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ - with (for LOOKS in CHARLOOKS when (fetch (CHARLOOKS CLMARK) - of LOOKS) collect LOOKS)) + (for LOOKS in CHARLOOKS do (* ; + "Reset the in-use mark in all CHARLOOKSs") + (replace (CHARLOOKS CLMARK) of LOOKS with NIL)) + (for LOOKS in PARALOOKS do (* ; + "Reset the in-use mark in all FMTSPECs") + (replace (FMTSPEC FMTMARK) of LOOKS with NIL)) + (while FIRSTPC do (* ; + "Now run thru the pieces in the document, marking the looks that are really in use.") + (replace (CHARLOOKS CLMARK) of (fetch (PIECE PLOOKS) of FIRSTPC) + with T) + (replace (FMTSPEC FMTMARK) of (fetch (PIECE PPARALOOKS) of FIRSTPC) + with T) + (SETQ FIRSTPC (fetch (PIECE NEXTPIECE) of FIRSTPC))) + (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with (for LOOKS in CHARLOOKS + when (fetch (CHARLOOKS CLMARK) + of LOOKS) collect LOOKS)) (* ; - "Keep only those CHARLOOKSs that ARE being used.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ - with (for LOOKS in PARALOOKS when (fetch (FMTSPEC FMTMARK) - of LOOKS) collect LOOKS)) + "Keep only those CHARLOOKSs that ARE being used.") + (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with (for LOOKS in PARALOOKS + when (fetch (FMTSPEC FMTMARK) + of LOOKS) collect LOOKS)) (* ; - "And only those PARALOOKSs that ARE being used.") + "And only those PARALOOKSs that ARE being used.") ]) ) @@ -948,7 +875,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (DEFINEQ (TEDIT.SUBLOOKS - [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 26-Apr-93 14:53 by jds") + [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 26-Apr-93 14:53 by jds") (* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.") @@ -962,22 +889,19 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, CHANGEMADE) (\SHOWSEL SEL NIL NIL) (* ; "Turn off the selection, first.") [OR (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (bind (CH# _ 1) for (PC _ FIRSTPC) while PC - by (fetch (PIECE NEXTPIECE) of PC) + (bind (CH# _ 1) for (PC _ FIRSTPC) while PC by (fetch (PIECE NEXTPIECE) of PC) do (COND - ((SAMECLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC) - FEATURELIST) - (replace (TEXTOBJ \DIRTY) of (TEXTOBJ TEXTSTREAM) with T) - (freplace (PIECE PLOOKS) of PC - with (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST - NEWLOOKSLIST - (fetch (PIECE PLOOKS) - of PC)) - (TEXTOBJ TEXTSTREAM))) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch (PIECE PLEN) - of PC))) - (SETQ CHANGEMADE T))) - (add CH# (fetch (PIECE PLEN) of PC] + ((SAMECLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC) + FEATURELIST) + (replace (TEXTOBJ \DIRTY) of (TEXTOBJ TEXTSTREAM) with T) + (freplace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS + (\TEDIT.PARSE.CHARLOOKS.LIST + NEWLOOKSLIST + (fetch (PIECE PLOOKS) of PC)) + (TEXTOBJ TEXTSTREAM))) + (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch (PIECE PLEN) of PC))) + (SETQ CHANGEMADE T))) + (add CH# (fetch (PIECE PLEN) of PC] (COND ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") @@ -990,7 +914,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (DEFINEQ (\TEDIT.CHANGE.LOOKS - [LAMBDA (STREAM NEWLOOKS CH# LEN) (* ; "Edited 19-Apr-93 14:08 by jds") + [LAMBDA (STREAM NEWLOOKS CH# LEN) (* ; "Edited 19-Apr-93 14:08 by jds") (* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection.") @@ -1012,25 +936,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, FOOLOOKS NEWFONT DY CHLIM (OLDLOOKSLIST NIL) STYLE STYLESET UISET USERINFO START-OF-PIECE) (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ \INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) - (* ; - "Construct the set of new looks to apply:") + (SETQ \INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ))(* ; + "Construct the set of new looks to apply:") (COND ((OR (IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (ZEROP LEN)) (* ; - "There won't be any text changed by this. Just punt out.") - (TEDIT.CARETLOOKS STREAM NEWLOOKS) (* ; "After setting the caret looks.") + "There won't be any text changed by this. Just punt out.") + (TEDIT.CARETLOOKS STREAM NEWLOOKS) (* ; "After setting the caret looks.") (RETURN))) [COND - ((type? CHARLOOKS NEWLOOKS) (* ; - "We've already got a made-up set of looks; we'll just use it.") + ((type? CHARLOOKS NEWLOOKS) (* ; + "We've already got a made-up set of looks; we'll just use it.") ) ((FONTP NEWLOOKS) (* ; - "If it's a font descriptor, extract what we need from that.") + "If it's a font descriptor, extract what we need from that.") (SETQ FONT NEWLOOKS) (SETQ NEWLOOKS NIL)) (T (* ; - "We got an AList -- prepare looks changes in that form") + "We got an AList -- prepare looks changes in that form") (SETQ FONT (LISTGET NEWLOOKS 'FONT)) (SETQ FAMILY (LISTGET NEWLOOKS 'FAMILY)) (SETQ FACE (LISTGET NEWLOOKS 'FACE)) @@ -1059,21 +982,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (FAMILY (SETQ FOOLOOKS (CONS 'FAMILY (CONS FAMILY FOOLOOKS] [COND (FONT (COND - ((type? FONTCLASS FONT) (* ; - "Needn't do anything. It's a font class.") + ((type? FONTCLASS FONT) (* ; + "Needn't do anything. It's a font class.") ) ([SETQ FONT (CAR (NLSETQ (\DTEST FONT 'FONTDESCRIPTOR] (* ; - "Try converting it to a font--it might be a list or some such.") + "Try converting it to a font--it might be a list or some such.") ) (T (* ; - "Nothing doing--it isn't any of the reasonable forms, so punt.") + "Nothing doing--it isn't any of the reasonable forms, so punt.") (TEDIT.PROMPTPRINT (CONCAT FONT " isn't a valid font descriptor.") T) (RETURN] [COND [(OR WEIGHT SLOPE EXPANSION) (* ; - "Setting one of these inhibits the FACE parameter") + "Setting one of these inhibits the FACE parameter") [AND WEIGHT (SETQ FOOLOOKS (CONS 'WEIGHT (CONS WEIGHT FOOLOOKS] [AND SLOPE (SETQ FOOLOOKS (CONS 'SLOPE (CONS SLOPE FOOLOOKS] (AND EXPANSION (SETQ FOOLOOKS (CONS 'EXPANSION (CONS EXPANSION FOOLOOKS] @@ -1081,29 +1004,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (COND [SIZE (SETQ FOOLOOKS (CONS 'SIZE (CONS SIZE FOOLOOKS] (SIZEINC (SETQ FOOLOOKS (CONS 'SIZE (CONS 'BOGUSSIZE FOOLOOKS] - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) - (* ; "Mark the document changed.") + (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "Mark the document changed.") (SETQ CHLIM (IMIN (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (IPLUS CH# LEN))) (* ; "last ch to change") (SETQ PC1 (\CHTOPC CH# PCTB T)) (* ; "Piece the first ch is in") (COND ((IGREATERP CH# START-OF-PIECE) (* ; - "If CH# is not first ch in piece, split it.") + "If CH# is not first ch in piece, split it.") (SETQ PC1 (\SPLITPIECE PC1 (- CH# START-OF-PIECE) TEXTOBJ PCNO1)) (* ; - "Take 2nd half of the split, which starts with CH#.") - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (* ; - "NB: \SplitPiece may make a new PCTB, so copy it here.") + "Take 2nd half of the split, which starts with CH#.") + (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (* ; + "NB: \SplitPiece may make a new PCTB, so copy it here.") )) (SETQ PCN (\CHTOPC CHLIM PCTB T)) (COND ((IEQP CHLIM START-OF-PIECE) (* ; - "CHLIM+1 is the start of a new piece. just use prevpiece as pcn") + "CHLIM+1 is the start of a new piece. just use prevpiece as pcn") (SETQ PCN (\CHTOPC (SUB1 CHLIM) PCTB T))) (T (* ; - "If the last char isn't the last char in the piece, then split it and take the first half.") + "If the last char isn't the last char in the piece, then split it and take the first half.") (\SPLITPIECE PCN (- CHLIM START-OF-PIECE) TEXTOBJ PCNON))) [COND @@ -1113,100 +1034,84 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWLOOKS TEXTOBJ] [bind (PC _ PC1) - NEWPCLOOKS while (AND PC (NEQ PC PCN)) + NEWPCLOOKS while (AND PC (NEQ PC PCN)) do (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE PLOOKS) of PC))) (* ; "Save old looks for the Undo.") (COND (NEWLOOKS (* ; - "We got a CHARLOOKS in. Just use it") + "We got a CHARLOOKS in. Just use it") (replace (PIECE PLOOKS) of PC with NEWLOOKS)) (T (* ; - "Otherwise, we have to override selectively") - [replace (PIECE PLOOKS) of PC with (SETQ NEWPCLOOKS - (create CHARLOOKS - using (fetch - (PIECE PLOOKS) + "Otherwise, we have to override selectively") + [replace (PIECE PLOOKS) of PC with (SETQ NEWPCLOOKS (create CHARLOOKS + using (fetch (PIECE PLOOKS) of PC] (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font.") [replace (CHARLOOKS CLFONT) of NEWPCLOOKS - with - (SETQ NEWFONT - (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of (fetch (PIECE PLOOKS) - of PC)) - (COND - (SIZEINC (* ; - "There's a size change requested. Fix up the size of the font.") - (LISTPUT FOOLOOKS 'SIZE - (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT) - of (fetch (PIECE PLOOKS - ) - of PC)) - 'SIZE) - SIZEINC)) - FOOLOOKS) - (T FOOLOOKS)) - TEXTOBJ] (* ; "Give this piece its new looks") - [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS - with (EQ 'BOLD (FONTPROP NEWFONT 'WEIGHT] - [replace (CHARLOOKS CLITAL) of NEWPCLOOKS - with (EQ 'ITALIC (FONTPROP NEWFONT 'SLOPE] + with (SETQ NEWFONT + (OR FONT (\TEDIT.FONTCOPY + (fetch (CHARLOOKS CLFONT) of (fetch (PIECE PLOOKS) of PC)) + (COND + (SIZEINC (* ; + "There's a size change requested. Fix up the size of the font.") + (LISTPUT FOOLOOKS 'SIZE + (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT) + of (fetch (PIECE PLOOKS) + of PC)) + 'SIZE) + SIZEINC)) + FOOLOOKS) + (T FOOLOOKS)) + TEXTOBJ] (* ; "Give this piece its new looks") + [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS with (EQ 'BOLD (FONTPROP NEWFONT + 'WEIGHT] + [replace (CHARLOOKS CLITAL) of NEWPCLOOKS with (EQ 'ITALIC (FONTPROP NEWFONT + 'SLOPE] [AND PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS with (EQ PROT 'ON] [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS with (EQ SELHERE 'ON] - [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS - with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS - with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS - with (EQ STRIKE 'ON] + [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS with (EQ ULINE 'ON] + [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS with (EQ OLINE 'ON] + [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS with (EQ STRIKE + 'ON] [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS with (EQ INVISIBLE 'ON] (AND SUPER (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with SUPER)) - (AND SUB (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS - SUB))) + (AND SUB (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS SUB))) (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) - (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO - )) + (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) (AND OFFSETINC (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) of - NEWPCLOOKS) - 0) - OFFSETINC))) + with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) of NEWPCLOOKS) + 0) + OFFSETINC))) [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS with (EQ INVERSEVIDEO 'ON] - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT - 'SIZE)) - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - NEWPCLOOKS TEXTOBJ)) + (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS TEXTOBJ)) (* ; - "Assure that each set of looks appears only once in the world.") + "Assure that each set of looks appears only once in the world.") )) [COND ((EQ PC \INPC) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with ( - \TEDIT.CARETLOOKS.VERIFY - TEXTOBJ - (fetch (PIECE PLOOKS) - of PC] + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY + TEXTOBJ + (fetch (PIECE PLOOKS) of PC] (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (OR PC (RETURN)) (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE PLOOKS) of PC))) (COND (NEWLOOKS (* ; - "We got a CHARLOOKS in. Just use it") + "We got a CHARLOOKS in. Just use it") (replace (PIECE PLOOKS) of PC with NEWLOOKS)) (T (* ; - "Otherwise, we have to override selectively") - [replace (PIECE PLOOKS) of PC with (SETQ NEWPCLOOKS - (create CHARLOOKS - using (fetch (PIECE - PLOOKS) + "Otherwise, we have to override selectively") + [replace (PIECE PLOOKS) of PC with (SETQ NEWPCLOOKS (create CHARLOOKS + using (fetch (PIECE PLOOKS) of PC] (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font.") @@ -1215,37 +1120,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, with (SETQ NEWFONT (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of (fetch (PIECE PLOOKS) - of PC)) + (fetch (CHARLOOKS CLFONT) of (fetch (PIECE PLOOKS) of PC)) (COND (SIZEINC (PROGN (LISTPUT FOOLOOKS 'SIZE - (IPLUS (FONTPROP (fetch (CHARLOOKS - CLFONT) - of - (fetch (PIECE PLOOKS - ) - of PC)) + (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT) + of (fetch (PIECE PLOOKS) + of PC)) 'SIZE) SIZEINC)) FOOLOOKS)) (T FOOLOOKS)) TEXTOBJ] (* ; "Give this piece its new looks") - [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS with - (EQ 'BOLD (FONTPROP NEWFONT - 'WEIGHT] - [replace (CHARLOOKS CLITAL) of NEWPCLOOKS with - (EQ 'ITALIC (FONTPROP NEWFONT - 'SLOPE] - [AND PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS - with (EQ PROT 'ON] - [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS - with (EQ SELHERE 'ON] - [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS - with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS - with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS - with (EQ STRIKE 'ON] + [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS with (EQ 'BOLD (FONTPROP NEWFONT + 'WEIGHT] + [replace (CHARLOOKS CLITAL) of NEWPCLOOKS with (EQ 'ITALIC (FONTPROP NEWFONT + 'SLOPE] + [AND PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS with (EQ PROT 'ON] + [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS with (EQ SELHERE + 'ON] + [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS with (EQ ULINE 'ON] + [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS with (EQ OLINE 'ON] + [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS with (EQ STRIKE 'ON] (AND SUPER (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with SUPER)) (AND SUB (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS SUB))) [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS @@ -1253,15 +1148,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS with (EQ INVERSEVIDEO 'ON] [AND OFFSETINC (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS OFFSETINC (OR (fetch (CHARLOOKS CLOFFSET) - of NEWPCLOOKS) - 0] + with (IPLUS OFFSETINC (OR (fetch (CHARLOOKS CLOFFSET) of + NEWPCLOOKS + ) + 0] (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT - 'SIZE)) - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - NEWPCLOOKS TEXTOBJ] + (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS TEXTOBJ] (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CHLIM) (COND ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) @@ -1277,7 +1171,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (RETURN (LIST OLDLOOKSLIST NLOOKSAVE PC1]) (TEDIT.LOOKS - [LAMBDA (STREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 30-May-91 21:41 by jds") + [LAMBDA (STREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 30-May-91 21:41 by jds") (* ;; "Programmatic interface for character looks in TEdit") @@ -1289,13 +1183,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SELORCH# (TEDIT.SETSEL TEXTOBJ SELORCH# LEN 'LEFT)) (T (fetch (TEXTOBJ SEL) of TEXTOBJ] (COND - ((NOT (fetch (SELECTION SET) of TSEL)) (* ; - "No selection to change the looks of. Can't do anything!") + ((NOT (fetch (SELECTION SET) of TSEL)) (* ; + "No selection to change the looks of. Can't do anything!") (RETURN))) (COND - ((SETQ CHANGERESULT (\TEDIT.CHANGE.LOOKS STREAM NEWLOOKS (fetch (SELECTION - CH#) - of TSEL) + ((SETQ CHANGERESULT (\TEDIT.CHANGE.LOOKS STREAM NEWLOOKS (fetch (SELECTION CH#) + of TSEL) (fetch (SELECTION DCH) of TSEL))) (* ; "Go actually change the looks") (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT @@ -1309,7 +1202,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, ]) (\TEDIT.LOOKS - [LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:41 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:41 by jds") (* ;; "Handler for the middle-button menu's LOOKS button. Brings up 3 menus, for font, face, and size. Then calls TEDIT.LOOKS to make the requested changes.") @@ -1325,10 +1218,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, YCOORD _ (fetch TOP of REGION] (COND ((IGREATERP (fetch (SELECTION CH#) of SEL) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; "Nothing to change, really") + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; "Nothing to change, really") ) - [(fetch (SELECTION SET) of SEL) (* ; "He's got something selected.") + [(fetch (SELECTION SET) of SEL) (* ; "He's got something selected.") (CURSORPOSITION (CREATEPOSITION 0 (fetch HEIGHT of REGION)) (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) (SETQ FONT (MENU (create MENU @@ -1346,7 +1238,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, NIL)) (* ; "Set the face (bold, etc.)") (SETQ SIZE (MENU TEDIT.SIZE.MENU POS)) (* ; "Set the type size") (* ; - "Construct the set of new looks to apply:") + "Construct the set of new looks to apply:") (COND (FONT (SETQ NEWLOOKS (LIST 'FAMILY FONT))) (T (SETQ NEWLOOKS NIL))) (* ; "The font") @@ -1358,23 +1250,22 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (* ; "The size") (COND (NEWLOOKS (* ; - "If there's something to do, do it.") + "If there's something to do, do it.") (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL] (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T]) (\TEDIT.FONTCOPY - (LAMBDA (FONT NEWSPECS TEXTOBJ) (* jds "26-Dec-84 16:06") - - (* Cloak FONTCOPY in protection for the user from an unavailable font.) - + [LAMBDA (FONT NEWSPECS TEXTOBJ) (* jds "26-Dec-84 16:06") + (* Cloak FONTCOPY in protection for + the user from an unavailable font.) (COND ((NULL NEWSPECS) (* No changes specified.  Punt it.) FONT) - ((CAR (NLSETQ (FONTCOPY FONT NEWSPECS)))) - (T (PROG ((OLDFAMILY (FONTPROP FONT 'FAMILY)) - (OLDSIZE (FONTPROP FONT 'SIZE))) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Can't find font " (OR (LISTGET NEWSPECS + [(CAR (NLSETQ (FONTCOPY FONT NEWSPECS] + (T (PROG [(OLDFAMILY (FONTPROP FONT 'FAMILY)) + (OLDSIZE (FONTPROP FONT 'SIZE] + (TEDIT.PROMPTPRINT TEXTOBJ [CONCAT "Can't find font " (OR (LISTGET NEWSPECS 'FAMILY) OLDFAMILY) " " @@ -1382,54 +1273,42 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, OLDSIZE) " " (OR (LISTGET NEWSPECS 'FACE) - (FONTPROP FONT 'FACE))) + (FONTPROP FONT 'FACE] T)) - FONT)))) + FONT]) (TEDIT.GET.LOOKS - [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 30-May-91 21:44 by jds") + [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 30-May-91 21:44 by jds") (* Return a PLIST of character looks) (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) LOOKS FONT NLOOKS) [COND - ((type? CHARLOOKS CH#ORCHARLOOKS) (* He handed us a CHARLOOKS. - Unparse it for him.) + ((type? CHARLOOKS CH#ORCHARLOOKS) (* He handed us a CHARLOOKS. + Unparse it for him.) (SETQ LOOKS CH#ORCHARLOOKS)) - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* There's no text in the document. - Use the extant caret looks.) + ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* There's no text in the document. + Use the extant caret looks.) (SETQ LOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ))) - [(FIXP CH#ORCHARLOOKS) (* He gave us a CH# to geth the - looks of. Grab it.) - (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN - ) - of TEXTOBJ) - CH#ORCHARLOOKS) - (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - [(type? SELECTION CH#ORCHARLOOKS) (* Get the looks of the selected - text) - (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN - ) - of TEXTOBJ) - (fetch (SELECTION - CH#) - of CH#ORCHARLOOKS)) - (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - ((NULL CH#ORCHARLOOKS) (* Get the looks of the selected - text) - (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN - ) - of TEXTOBJ) - (fetch (SELECTION - CH#) - of - (fetch (TEXTOBJ - SEL) - of TEXTOBJ))) - (fetch (TEXTOBJ PCTB) - of TEXTOBJ] + [(FIXP CH#ORCHARLOOKS) (* He gave us a CH# to geth the looks + of. Grab it.) + (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN) + of TEXTOBJ) + CH#ORCHARLOOKS) + (fetch (TEXTOBJ PCTB) of TEXTOBJ] + [(type? SELECTION CH#ORCHARLOOKS) (* Get the looks of the selected text) + (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN) + of TEXTOBJ) + (fetch (SELECTION CH#) of + CH#ORCHARLOOKS + )) + (fetch (TEXTOBJ PCTB) of TEXTOBJ] + ((NULL CH#ORCHARLOOKS) (* Get the looks of the selected text) + (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN) + of TEXTOBJ) + (fetch (SELECTION CH#) + of (fetch (TEXTOBJ SEL) + of TEXTOBJ))) + (fetch (TEXTOBJ PCTB) of TEXTOBJ] (* * Now break the looks apart into a PROPLIST) @@ -1444,7 +1323,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (DEFINEQ (\TEDIT.GET.PARALOOKS - [LAMBDA (FILE PARAHASH) (* ; "Edited 18-Dec-88 17:47 by jds") + [LAMBDA (FILE PARAHASH) (* ; "Edited 18-Dec-88 17:47 by jds") (* ;; "Read a paragraph format spec from the FILE, and return it for later use.") @@ -1457,8 +1336,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (T (ELT PARAHASH LOOKS#]) (EQFMTSPEC - [LAMBDA (PARALOOK1 PARALOOK2) (* ; - "Edited 2-Jul-93 21:32 by sybalskY:MV:ENVOS") + [LAMBDA (PARALOOK1 PARALOOK2) (* ; + "Edited 2-Jul-93 21:32 by sybalskY:MV:ENVOS") (* ;; "Given two sets of FMTSPECS, are they effectively the same?") @@ -1511,97 +1390,94 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (ffetch (FMTSPEC TABSPEC) of PARALOOK2]) (\TEDIT.UNIQUIFY.PARALOOKS - [LAMBDA (NEWLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:41 by jds") + [LAMBDA (NEWLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:41 by jds") (* Assure that there is only ONE of a given PARALOOKS in the document--so that - all instances of that set of looks share structure.) + all instances of that set of looks share structure.) (COND - ((for LOOK in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - thereis (EQFMTSPEC NEWLOOKS LOOK))) + ((for LOOK in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) thereis (EQFMTSPEC NEWLOOKS LOOK)) + ) (T (push (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - NEWLOOKS) + NEWLOOKS) NEWLOOKS]) (TEDIT.GET.PARALOOKS - [LAMBDA (TEXTSTREAM SELORCH#) (* ; "Edited 30-May-91 21:44 by jds") + [LAMBDA (TEXTSTREAM SELORCH#) (* ; "Edited 30-May-91 21:44 by jds") (* ; - "Return a proplist of paragraph formatting information about the characters specified.") + "Return a proplist of paragraph formatting information about the characters specified.") (LET* [(TEXTOBJ (TEXTOBJ TEXTSTREAM)) (SEL (OR SELORCH# (fetch (TEXTOBJ SEL) of TEXTOBJ] (\TEDIT.UNPARSE.PARALOOKS.LIST (fetch (PIECE PPARALOOKS) - of - (\CHTOPC (CL:TYPECASE SEL - (SELECTION (fetch (SELECTION CH#) - of SEL)) - ((OR FIXP SMALLP) - (IMAX 1 (IMIN SEL (fetch - (TEXTOBJ TEXTLEN) - of TEXTOBJ)) - )) - (T (\ILLEGAL.ARG SEL))) - (fetch (TEXTOBJ PCTB) of TEXTOBJ]) + of (\CHTOPC (CL:TYPECASE SEL + (SELECTION (fetch (SELECTION CH#) + of SEL)) + ((OR FIXP SMALLP) + (IMAX 1 (IMIN SEL (fetch (TEXTOBJ + TEXTLEN) + of TEXTOBJ)))) + (T (\ILLEGAL.ARG SEL))) + (fetch (TEXTOBJ PCTB) of TEXTOBJ]) (\TEDIT.UNPARSE.PARALOOKS.LIST - [LAMBDA (FMTSPEC) (* ; "Edited 30-May-91 21:48 by jds") + [LAMBDA (FMTSPEC) (* ; "Edited 30-May-91 21:48 by jds") (* ; - "Convert a FMTSPEC into an equivalent PList-form for external consumption") + "Convert a FMTSPEC into an equivalent PList-form for external consumption") (PROG ((NEWLOOKS NIL)) (for PROP in (LIST (fetch (FMTSPEC QUAD) of FMTSPEC) - (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC) - (fetch (FMTSPEC LEFTMAR) of FMTSPEC) - (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) - (fetch (FMTSPEC LEADBEFORE) of FMTSPEC) - (fetch (FMTSPEC LEADAFTER) of FMTSPEC) - (fetch (FMTSPEC LINELEAD) of FMTSPEC) - (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) - (fetch (FMTSPEC TABSPEC) of FMTSPEC) - (fetch (FMTSPEC FMTSTYLE) of FMTSPEC) - (fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC) - (fetch (FMTSPEC FMTUSERINFO) of FMTSPEC) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) - (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) - (fetch (FMTSPEC FMTPARASUBTYPE) of FMTSPEC) - (fetch (FMTSPEC FMTNEWPAGEBEFORE) of FMTSPEC) - (fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC) - (fetch (FMTSPEC FMTHEADINGKEEP) of FMTSPEC) - (fetch (FMTSPEC FMTKEEP) of FMTSPEC) - (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) - (fetch (FMTSPEC FMTREVISED) of FMTSPEC) - (fetch (FMTSPEC FMTCOLUMN) of FMTSPEC)) as PROPNAME - in '(QUAD 1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING - LINELEADING BASETOBASE TABS STYLE CHARSTYLES USERINFO SPECIALX SPECIALY - TYPE SUBTYPE NEWPAGEBEFORE NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY REVISED - COLUMN) as METHOD - in '(VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE - VALUE VALUE VALUE VALUE VALUE ONOFF VALUE VALUE VALUE VALUE) + (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC) + (fetch (FMTSPEC LEFTMAR) of FMTSPEC) + (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) + (fetch (FMTSPEC LEADBEFORE) of FMTSPEC) + (fetch (FMTSPEC LEADAFTER) of FMTSPEC) + (fetch (FMTSPEC LINELEAD) of FMTSPEC) + (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) + (fetch (FMTSPEC TABSPEC) of FMTSPEC) + (fetch (FMTSPEC FMTSTYLE) of FMTSPEC) + (fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC) + (fetch (FMTSPEC FMTUSERINFO) of FMTSPEC) + (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) + (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) + (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) + (fetch (FMTSPEC FMTPARASUBTYPE) of FMTSPEC) + (fetch (FMTSPEC FMTNEWPAGEBEFORE) of FMTSPEC) + (fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC) + (fetch (FMTSPEC FMTHEADINGKEEP) of FMTSPEC) + (fetch (FMTSPEC FMTKEEP) of FMTSPEC) + (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) + (fetch (FMTSPEC FMTREVISED) of FMTSPEC) + (fetch (FMTSPEC FMTCOLUMN) of FMTSPEC)) as PROPNAME + in '(QUAD 1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING LINELEADING + BASETOBASE TABS STYLE CHARSTYLES USERINFO SPECIALX SPECIALY TYPE SUBTYPE + NEWPAGEBEFORE NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY REVISED COLUMN) + as METHOD + in '(VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE + VALUE VALUE VALUE VALUE ONOFF VALUE VALUE VALUE VALUE) do (SELECTQ METHOD - (VALUE (* ; - "Give him the value straight from the looks") - (push NEWLOOKS PROP)) - (ONOFF (* ; "Translate T/NIL into ON/OFF") - (push NEWLOOKS (ONOFF PROP))) - (SHOULDNT)) - (push NEWLOOKS PROPNAME)) + (VALUE (* ; + "Give him the value straight from the looks") + (push NEWLOOKS PROP)) + (ONOFF (* ; "Translate T/NIL into ON/OFF") + (push NEWLOOKS (ONOFF PROP))) + (SHOULDNT)) + (push NEWLOOKS PROPNAME)) (RETURN NEWLOOKS]) (\TEDIT.PARSE.PARALOOKS.LIST - [LAMBDA (NEWLOOKS OLDLOOKS) (* ; - "Edited 3-Jul-93 21:49 by sybalskY:MV:ENVOS") + [LAMBDA (NEWLOOKS OLDLOOKS) (* ; + "Edited 3-Jul-93 21:49 by sybalskY:MV:ENVOS") (* ; - "Apply a given format spec to the paragraphs which are included in this guy.") + "Apply a given format spec to the paragraphs which are included in this guy.") (PROG (D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC QUADD NLOOKSAVE PC1 TYPE SUBTYPE TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET HEADINGKEEP BASETOBASE BASESET REVISED REVISEDSET COLUMN COLUMNSET USERINFO USERINFOSET SPECIALX SPECXSET SPECIALY SPECYSET STYLE STYLESET CHARSTYLES CHARSTYLESSET) (COND - ((type? FMTSPEC NEWLOOKS) (* ; - "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") + ((type? FMTSPEC NEWLOOKS) (* ; + "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") (RETURN NEWLOOKS)) - (T (* ; - "create an FMTSPEC from the Alist") + (T (* ; "create an FMTSPEC from the Alist") (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN)) (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN)) (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN)) @@ -1619,7 +1495,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP)) (* ; "Keep for headings") (SETQ KEEP (LISTGET NEWLOOKS 'KEEP)) (* ; - "More general `Keep-together' spec -- undefined as of 5/22/85") + "More general `Keep-together' spec -- undefined as of 5/22/85") (SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS)) (SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE)) (SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS)) @@ -1640,7 +1516,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, (SETQ CHARSTYLESSET (FMEMB 'CHARSTYLES NEWLOOKS)) [SELECTQ QUADD ((LEFT RIGHT CENTERED JUSTIFIED NIL) (* ; - "Do nothing -- we got a valid justification spec") + "Do nothing -- we got a valid justification spec") ) ((JUST J) (SETQ QUADD 'JUSTIFIED)) @@ -1650,7 +1526,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, ((C CENTER) (SETQQ QUADD CENTERED)) (PROGN (* ; - "We got an illegal QUAD value. Use LEFT.") + "We got an illegal QUAD value. Use LEFT.") (TEDIT.PROMPTPRINT (AND (BOUNDP 'TEXTOBJ) TEXTOBJ) (CONCAT "Illegal paragraph quad " QUADD ", replaced with LEFT.") @@ -1668,8 +1544,8 @@ CONS pair of default width and LIST of TAB record instances") of OLDLOOKS] (for SPEC in (CDR TABSPECC) collect (create TAB - TABKIND _ (CDR SPEC) - TABX _ (CAR SPEC] + TABKIND _ (CDR SPEC) + TABX _ (CAR SPEC] (SETQ NEWLOOKS (create FMTSPEC using (OR OLDLOOKS TEDIT.DEFAULT.FMTSPEC))) (AND 1STLEFT (replace (FMTSPEC 1STLEFTMAR) of NEWLOOKS with 1STLEFT)) (AND LEFT (replace (FMTSPEC LEFTMAR) of NEWLOOKS with LEFT)) @@ -1680,30 +1556,24 @@ CONS pair of default width and LIST of TAB record instances") (AND TABSPECC (replace (FMTSPEC TABSPEC) of NEWLOOKS with TABSPECC)) (AND QUADD (replace (FMTSPEC QUAD) of NEWLOOKS with QUADD)) (AND TYPESET (replace (FMTSPEC FMTPARATYPE) of NEWLOOKS with TYPE)) - (AND SUBTYPESET (replace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS with - SUBTYPE)) - (AND NEWBEFORESET (replace (FMTSPEC FMTNEWPAGEBEFORE) of NEWLOOKS - with NEWBEFORE)) - (AND NEWAFTERSET (replace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS with - NEWAFTER)) + (AND SUBTYPESET (replace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS with SUBTYPE)) + (AND NEWBEFORESET (replace (FMTSPEC FMTNEWPAGEBEFORE) of NEWLOOKS with NEWBEFORE)) + (AND NEWAFTERSET (replace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS with NEWAFTER)) [AND HEADINGKEEP (replace (FMTSPEC FMTHEADINGKEEP) of NEWLOOKS with (EQ HEADINGKEEP 'ON] (AND KEEPSET (replace (FMTSPEC FMTKEEP) of NEWLOOKS with KEEP)) - (AND BASESET (replace (FMTSPEC FMTBASETOBASE) of NEWLOOKS with BASETOBASE - )) + (AND BASESET (replace (FMTSPEC FMTBASETOBASE) of NEWLOOKS with BASETOBASE)) (AND REVISEDSET (replace (FMTSPEC FMTREVISED) of NEWLOOKS with REVISED)) (AND COLUMNSET (replace (FMTSPEC FMTCOLUMN) of NEWLOOKS with COLUMN)) (AND SPECXSET (replace (FMTSPEC FMTSPECIALX) of NEWLOOKS with SPECIALX)) (AND SPECYSET (replace (FMTSPEC FMTSPECIALY) of NEWLOOKS with SPECIALY)) (AND STYLESET (replace (FMTSPEC FMTSTYLE) of NEWLOOKS with STYLE)) - (AND CHARSTYLESSET (replace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS with - CHARSTYLES)) - (AND USERINFOSET (replace (FMTSPEC FMTUSERINFO) of NEWLOOKS with USERINFO - )) + (AND CHARSTYLESSET (replace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS with CHARSTYLES)) + (AND USERINFOSET (replace (FMTSPEC FMTUSERINFO) of NEWLOOKS with USERINFO)) (RETURN NEWLOOKS]) (TEDIT.PARALOOKS - [LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* ; "Edited 21-Apr-93 18:44 by jds") + [LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* ; "Edited 21-Apr-93 18:44 by jds") (* ;; "Apply a given format spec to the paragraphs which are included in this guy.") @@ -1719,39 +1589,36 @@ CONS pair of default width and LIST of TAB record instances") SUBTYPESET SPECIALX SPECIALY NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET HEADINGKEEP BASETOBASE BASESET HCPYMODE HCPYSET USERINFO USERSET REVISED REVISEDSET STYLE STYLESET CHARSTYLES CHARSTYLESSET COLUMN COLUMNSET STYLE STYLESET START-OF-PIECE OLDSTART) - (SETQ CH# (fetch (SELECTION CH#) of SEL)) (* ; "First affected character") + (SETQ CH# (fetch (SELECTION CH#) of SEL)) (* ; "First affected character") (SETQ CHLIM (IMIN (IMAX CH# (SUB1 (fetch (SELECTION CHLIM) of SEL))) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) (* ; "Last affected character.") (COND ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; - "Can't change the para looks of something beyond end of text.") + "Can't change the para looks of something beyond end of text.") (RETURN)) - ((NOT (fetch (SELECTION SET) of SEL)) (* ; - "Can't do anything if there is no selection set in the main document") + ((NOT (fetch (SELECTION SET) of SEL)) (* ; + "Can't do anything if there is no selection set in the main document") (RETURN))) (COND ((NOT (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ)) (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (* ; - "Because it may grow during the conversion to formatted.") + (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (* ; + "Because it may grow during the conversion to formatted.") (SETQ PC (\CHTOPC CH# PCTB T)) (SETQ OLDSTART START-OF-PIECE) (SETQ PC1 PC) (SETQ NLOOKSAVE NEWLOOKS) [COND - ((type? FMTSPEC NEWLOOKS) (* ; - "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") - (SETQ D (create FMTSPEC copying NEWLOOKS)) - (* ; - "Create the universal replacement looks") + ((type? FMTSPEC NEWLOOKS) (* ; + "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") + (SETQ D (create FMTSPEC copying NEWLOOKS)) (* ; + "Create the universal replacement looks") (SETQ REPLACEALLFIELDS T) (* ; - "And set the replace-everything flag.") + "And set the replace-everything flag.") ) - (T (* ; - "create an FMTSPEC from the Alist") + (T (* ; "create an FMTSPEC from the Alist") (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN)) (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN)) (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN)) @@ -1774,7 +1641,7 @@ CONS pair of default width and LIST of TAB record instances") (SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP)) (* ; "Keep for headings") (SETQ KEEP (LISTGET NEWLOOKS 'KEEP)) (* ; - "More general 'Keep-together' spec -- undefined as of 5/22/85") + "More general 'Keep-together' spec -- undefined as of 5/22/85") (SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS)) (SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE)) (SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS)) @@ -1804,186 +1671,177 @@ CONS pair of default width and LIST of TAB record instances") (T (CAR TABSPECC))) (CAR (fetch (FMTSPEC TABSPEC) of (fetch (PIECE PPARALOOKS) - of PC] + of PC] (for SPEC in (CDR TABSPECC) collect (create TAB - TABKIND _ (CDR SPEC) - TABX _ (CAR SPEC] + TABKIND _ (CDR SPEC) + TABX _ (CAR SPEC] [COND (REPLACEALLFIELDS (* ;; "Given that we're replacing the FMTSPEC wholesale, let's uniquify it within this document OUTSIDE the loop.") (SETQ D (\TEDIT.UNIQUIFY.PARALOOKS D TEXTOBJ] - (bind (NPC _ PC) while NPC - do (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE PPARALOOKS) - of NPC))) - [COND - (REPLACEALLFIELDS + (bind (NPC _ PC) while NPC do (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE + PPARALOOKS + ) + of NPC))) + [COND + (REPLACEALLFIELDS - (* ;; "We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified (and recorded in the master list) already.") + (* ;; "We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified (and recorded in the master list) already.") - (replace (PIECE PPARALOOKS) of NPC with D)) - (T (* ; - "Only replacing part of the looks; create a new one, and smash it.") - (COND - [(NEQ (fetch (PIECE PPARALOOKS) of NPC) - LASTLOOKS) (* ; - "only build a new FMTSPEC when they are different") - (SETQ LASTLOOKS (ffetch (PIECE PPARALOOKS) of NPC)) - (SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS)) - (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) of NEWLOOKS - with 1STLEFT)) - (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWLOOKS with - LEFT)) - (AND RIGHT (freplace (FMTSPEC RIGHTMAR) of NEWLOOKS with - RIGHT)) - (AND LEADB (freplace (FMTSPEC LEADBEFORE) of NEWLOOKS - with LEADB)) - (AND LEADA (freplace (FMTSPEC LEADAFTER) of NEWLOOKS - with LEADA)) - (AND BLEADSET (freplace (FMTSPEC FMTBASETOBASE) of NEWLOOKS - with BLEAD)) - (AND LLEAD (freplace (FMTSPEC LINELEAD) of NEWLOOKS with - LLEAD)) - (AND TABSPECC (freplace (FMTSPEC TABSPEC) of NEWLOOKS - with TABSPECC)) - (AND QUADD (freplace (FMTSPEC QUAD) of NEWLOOKS with QUADD)) - (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) of NEWLOOKS - with TYPE)) - (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS - with SUBTYPE)) - (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) of NEWLOOKS - with SPECIALX)) - (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) of NEWLOOKS - with SPECIALY)) - (AND NEWBEFORESET (freplace (FMTSPEC FMTNEWPAGEBEFORE) of - NEWLOOKS - with NEWBEFORE)) - (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS - with NEWAFTER)) - [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) of NEWLOOKS - with (EQ HEADINGKEEP 'ON] - (AND KEEPSET (freplace (FMTSPEC FMTKEEP) of NEWLOOKS - with KEEP)) - (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) of NEWLOOKS - with BASETOBASE)) - (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) of NEWLOOKS - with HCPYMODE)) - (AND USERSET (freplace (FMTSPEC FMTUSERINFO) of NEWLOOKS - with USERINFO)) - (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) of NEWLOOKS - with REVISED)) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS - with STYLE)) - (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS - with CHARSTYLES)) - (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) of NEWLOOKS - with COLUMN)) - (AND STYLESET (replace (FMTSPEC FMTSTYLE) of NEWLOOKS - with STYLE)) - (freplace (PIECE PPARALOOKS) of NPC with (SETQ NEWLOOKS - ( - \TEDIT.UNIQUIFY.PARALOOKS - NEWLOOKS TEXTOBJ] - (T (* ; "Re-use the last set of looks; they're still what we want (this paragraph looks like the last one.)") - (freplace (PIECE PPARALOOKS) of NPC with NEWLOOKS] - [SETQ CHLIM (IMAX CHLIM (SETQ NCHLIM (SETQ START-OF-PIECE - (IPLUS START-OF-PIECE (fetch - (PIECE PLEN) - of NPC] - (COND - ((fetch (PIECE PPARALAST) of NPC) + (replace (PIECE PPARALOOKS) of NPC with D)) + (T (* ; + "Only replacing part of the looks; create a new one, and smash it.") + (COND + [(NEQ (fetch (PIECE PPARALOOKS) of NPC) + LASTLOOKS) (* ; - "We've found the end of a paragraph. Stop to see if we've run off the end yet.") - (COND - ((IGEQ NCHLIM (SUB1 (fetch (SELECTION CHLIM) of SEL))) - (RETURN))) (* ; "Make a new set of looks.") - )) - (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC))) + "only build a new FMTSPEC when they are different") + (SETQ LASTLOOKS (ffetch (PIECE PPARALOOKS) + of NPC)) + (SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS)) + (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) + of NEWLOOKS with 1STLEFT)) + (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWLOOKS + with LEFT)) + (AND RIGHT (freplace (FMTSPEC RIGHTMAR) + of NEWLOOKS with RIGHT)) + (AND LEADB (freplace (FMTSPEC LEADBEFORE) + of NEWLOOKS with LEADB)) + (AND LEADA (freplace (FMTSPEC LEADAFTER) + of NEWLOOKS with LEADA)) + (AND BLEADSET (freplace (FMTSPEC FMTBASETOBASE) + of NEWLOOKS with BLEAD)) + (AND LLEAD (freplace (FMTSPEC LINELEAD) + of NEWLOOKS with LLEAD)) + (AND TABSPECC (freplace (FMTSPEC TABSPEC) + of NEWLOOKS with TABSPECC)) + (AND QUADD (freplace (FMTSPEC QUAD) of NEWLOOKS + with QUADD)) + (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) + of NEWLOOKS with TYPE)) + (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) + of NEWLOOKS with SUBTYPE)) + (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) + of NEWLOOKS with SPECIALX)) + (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) + of NEWLOOKS with SPECIALY)) + (AND NEWBEFORESET (freplace (FMTSPEC + FMTNEWPAGEBEFORE + ) of NEWLOOKS + with NEWBEFORE)) + (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER + ) of NEWLOOKS + with NEWAFTER)) + [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) + of NEWLOOKS + with (EQ HEADINGKEEP + 'ON] + (AND KEEPSET (freplace (FMTSPEC FMTKEEP) + of NEWLOOKS with KEEP)) + (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) + of NEWLOOKS with BASETOBASE)) + (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) + of NEWLOOKS with HCPYMODE)) + (AND USERSET (freplace (FMTSPEC FMTUSERINFO) + of NEWLOOKS with USERINFO)) + (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) + of NEWLOOKS with REVISED)) + (AND STYLESET (freplace (FMTSPEC FMTSTYLE) + of NEWLOOKS with STYLE)) + (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES + ) of NEWLOOKS + with CHARSTYLES)) + (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) + of NEWLOOKS with COLUMN)) + (AND STYLESET (replace (FMTSPEC FMTSTYLE) + of NEWLOOKS with STYLE)) + (freplace (PIECE PPARALOOKS) of NPC + with (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.PARALOOKS + NEWLOOKS TEXTOBJ] + (T (* ; "Re-use the last set of looks; they're still what we want (this paragraph looks like the last one.)") + (freplace (PIECE PPARALOOKS) of NPC with NEWLOOKS + ] + [SETQ CHLIM (IMAX CHLIM (SETQ NCHLIM + (SETQ START-OF-PIECE + (IPLUS START-OF-PIECE + (fetch (PIECE PLEN) + of NPC] + (COND + ((fetch (PIECE PPARALAST) of NPC) + (* ; + "We've found the end of a paragraph. Stop to see if we've run off the end yet.") + (COND + ((IGEQ NCHLIM (SUB1 (fetch (SELECTION CHLIM) + of SEL))) + (RETURN))) (* ; "Make a new set of looks.") + )) + (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC))) (SETQ LASTLOOKS NIL) [bind (NPC _ (fetch (PIECE PREVPIECE) of PC)) while (AND NPC (NOT (fetch (PIECE PPARALAST) of NPC))) do (SETQ OLDLOOKSLIST (CONS (fetch (PIECE PPARALOOKS) of NPC) - OLDLOOKSLIST)) - [COND - (REPLACEALLFIELDS + OLDLOOKSLIST)) + [COND + (REPLACEALLFIELDS - (* ;; "We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified (and recorded in the master list) already.") + (* ;; "We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified (and recorded in the master list) already.") - (replace (PIECE PPARALOOKS) of NPC with D)) - (T (* ; - "Only replacing part of the looks; create a new one, and smash it.") - (COND - [(NEQ (fetch (PIECE PPARALOOKS) of NPC) - LASTLOOKS) (* ; - "only build a new FMTSPEC when they are different") - (SETQ LASTLOOKS (fetch (PIECE PPARALOOKS) of NPC)) - (SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS)) - (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) of NEWLOOKS - with 1STLEFT)) - (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWLOOKS with - LEFT)) - (AND RIGHT (freplace (FMTSPEC RIGHTMAR) of NEWLOOKS with - RIGHT)) - (AND LEADB (freplace (FMTSPEC LEADBEFORE) of NEWLOOKS - with LEADB)) - (AND LEADA (freplace (FMTSPEC LEADAFTER) of NEWLOOKS - with LEADA)) - (AND LLEAD (freplace (FMTSPEC LINELEAD) of NEWLOOKS with - LLEAD)) - (AND TABSPECC (freplace (FMTSPEC TABSPEC) of NEWLOOKS - with TABSPECC)) - (AND QUADD (freplace (FMTSPEC QUAD) of NEWLOOKS with QUADD)) - (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) of NEWLOOKS - with TYPE)) - (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS - with SUBTYPE)) - (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) of NEWLOOKS - with SPECIALX)) - (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) of NEWLOOKS - with SPECIALY)) - (AND NEWBEFORESET (freplace (FMTSPEC FMTNEWPAGEBEFORE) of - NEWLOOKS - with NEWBEFORE)) - (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS - with NEWAFTER)) - [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) of NEWLOOKS - with (EQ HEADINGKEEP 'ON] - (AND KEEPSET (freplace (FMTSPEC FMTKEEP) of NEWLOOKS - with KEEP)) - (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) of NEWLOOKS - with BASETOBASE)) - (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) of NEWLOOKS - with HCPYMODE)) - (AND USERSET (freplace (FMTSPEC FMTUSERINFO) of NEWLOOKS - with USERINFO)) - (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) of NEWLOOKS - with REVISED)) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS - with STYLE)) - (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS - with CHARSTYLES)) - (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) of NEWLOOKS - with COLUMN)) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS - with STYLE)) - (freplace (PIECE PPARALOOKS) of NPC with (SETQ NEWLOOKS - ( - \TEDIT.UNIQUIFY.PARALOOKS - NEWLOOKS TEXTOBJ] - (T (* ; "Re-use the last set of looks; they're still what we want (this paragraph looks like the last one.)") - (freplace (PIECE PPARALOOKS) of NPC with NEWLOOKS] - (SETQ PC1 NPC) - (SETQ OLDSTART (IDIFFERENCE OLDSTART (fetch (PIECE PLEN) of PC1))) - (SETQ NPC (fetch (PIECE PREVPIECE) of NPC)) - finally (SETQ CH# (IMIN CH# (IMAX 1 OLDSTART] + (replace (PIECE PPARALOOKS) of NPC with D)) + (T (* ; + "Only replacing part of the looks; create a new one, and smash it.") + (COND + [(NEQ (fetch (PIECE PPARALOOKS) of NPC) + LASTLOOKS) (* ; + "only build a new FMTSPEC when they are different") + (SETQ LASTLOOKS (fetch (PIECE PPARALOOKS) of NPC)) + (SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS)) + (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) of NEWLOOKS with 1STLEFT)) + (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWLOOKS with LEFT)) + (AND RIGHT (freplace (FMTSPEC RIGHTMAR) of NEWLOOKS with RIGHT)) + (AND LEADB (freplace (FMTSPEC LEADBEFORE) of NEWLOOKS with LEADB)) + (AND LEADA (freplace (FMTSPEC LEADAFTER) of NEWLOOKS with LEADA)) + (AND LLEAD (freplace (FMTSPEC LINELEAD) of NEWLOOKS with LLEAD)) + (AND TABSPECC (freplace (FMTSPEC TABSPEC) of NEWLOOKS with TABSPECC)) + (AND QUADD (freplace (FMTSPEC QUAD) of NEWLOOKS with QUADD)) + (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) of NEWLOOKS with TYPE)) + (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS with SUBTYPE + )) + (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) of NEWLOOKS with SPECIALX)) + (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) of NEWLOOKS with SPECIALY)) + (AND NEWBEFORESET (freplace (FMTSPEC FMTNEWPAGEBEFORE) of NEWLOOKS + with NEWBEFORE)) + (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS + with NEWAFTER)) + [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) of NEWLOOKS + with (EQ HEADINGKEEP 'ON] + (AND KEEPSET (freplace (FMTSPEC FMTKEEP) of NEWLOOKS with KEEP)) + (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) of NEWLOOKS with BASETOBASE) + ) + (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) of NEWLOOKS with HCPYMODE)) + (AND USERSET (freplace (FMTSPEC FMTUSERINFO) of NEWLOOKS with USERINFO)) + (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) of NEWLOOKS with REVISED)) + (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS with STYLE)) + (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS + with CHARSTYLES)) + (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) of NEWLOOKS with COLUMN)) + (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS with STYLE)) + (freplace (PIECE PPARALOOKS) of NPC with (SETQ NEWLOOKS ( + \TEDIT.UNIQUIFY.PARALOOKS + NEWLOOKS TEXTOBJ] + (T (* ; "Re-use the last set of looks; they're still what we want (this paragraph looks like the last one.)") + (freplace (PIECE PPARALOOKS) of NPC with NEWLOOKS] + (SETQ PC1 NPC) + (SETQ OLDSTART (IDIFFERENCE OLDSTART (fetch (PIECE PLEN) of PC1))) + (SETQ NPC (fetch (PIECE PREVPIECE) of NPC)) finally (SETQ CH# (IMIN CH# + (IMAX 1 OLDSTART] (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL NIL) (* ; - "Turn off the sel before updating the screen") + "Turn off the sel before updating the screen") (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 CHLIM)) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) - (* ; "Mark the document as changed.") + (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "Mark the document as changed.") (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ 'ParaLooks @@ -2000,39 +1858,36 @@ CONS pair of default width and LIST of TAB record instances") (\SHOWSEL SEL NIL T]) (TEDIT.COPY.PARALOOKS - [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 30-May-91 21:44 by jds") + [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 30-May-91 21:44 by jds") (* ;; "Copy the PARAGRAPH LOOKS from one place to another") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) LOOKS LEN) (* ; - "get the paragraph looks of the first character of SOURCE") + "get the paragraph looks of the first character of SOURCE") [SETQ LOOKS (fetch (PIECE PPARALOOKS) of (CL:TYPECASE SOURCE - ((SMALLP FIXP) (\CHTOPC SOURCE (fetch (TEXTOBJ PCTB) - of TEXTOBJ))) - (SELECTION - (\SHOWSEL SOURCE NIL NIL) - (* ; - "Turn off the looks-source selection") - (\CHTOPC (fetch (SELECTION CH#) of SOURCE) - (fetch (TEXTOBJ PCTB) of (fetch - (SELECTION \TEXTOBJ) - of SOURCE)))) - (T (\ILLEGAL.ARG SOURCE)))] + ((SMALLP FIXP) (\CHTOPC SOURCE (fetch (TEXTOBJ PCTB) of TEXTOBJ))) + (SELECTION + (\SHOWSEL SOURCE NIL NIL) (* ; + "Turn off the looks-source selection") + (\CHTOPC (fetch (SELECTION CH#) of SOURCE) + (fetch (TEXTOBJ PCTB) of (fetch (SELECTION \TEXTOBJ) + of SOURCE)))) + (T (\ILLEGAL.ARG SOURCE)))] (COND - [(type? SELECTION DEST) (* ; - "make sure that the destination selection is in this document") + [(type? SELECTION DEST) (* ; + "make sure that the destination selection is in this document") (COND ((NEQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of DEST)) (\LISPERROR "Destination selection is not in stream " STREAM] (T (* ; - "set the LEN arg for TEDIT.PARALOOKS to be 1 since we just have a char pos.") + "set the LEN arg for TEDIT.PARALOOKS to be 1 since we just have a char pos.") (SETQ LEN 1))) (TEDIT.PARALOOKS TEXTOBJ LOOKS DEST LEN]) (\TEDIT.PUT.PARALOOKS - [LAMBDA (FILE PC PARAHASH) (* ; "Edited 30-May-91 21:44 by jds") + [LAMBDA (FILE PC PARAHASH) (* ; "Edited 30-May-91 21:44 by jds") (* ;; "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1") @@ -2041,15 +1896,15 @@ CONS pair of default width and LIST of TAB record instances") (PROG ((LOOKS (fetch (PIECE PPARALOOKS) of PC)) DEFAULTTAB TABSPECS OUTPUTFORMAT) (\DWOUT FILE 0) (* ; - "Place holder for number of characters in the piece -- really taken from the charlooks.") + "Place holder for number of characters in the piece -- really taken from the charlooks.") (\SMALLPOUT FILE \PieceDescriptorPARA) (* ; - "Identify this as a paragraph looks piece") + "Identify this as a paragraph looks piece") (\SMALLPOUT FILE (GETHASH LOOKS PARAHASH]) (\TEDIT.CONVERT.TO.FORMATTED - [LAMBDA (TEXTOBJ START END) (* ; "Edited 29-Apr-93 19:47 by jds") + [LAMBDA (TEXTOBJ START END) (* ; "Edited 29-Apr-93 19:47 by jds") (* ; - "Turn an unformatted TEdit file into a formatted TEdit file.") + "Turn an unformatted TEdit file into a formatted TEdit file.") (PROG ((NEXTCR (\TEDIT.BASICFIND TEXTOBJ (MKSTRING (CHARACTER (CHARCODE CR))) (OR START 1))) (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) @@ -2057,76 +1912,72 @@ CONS pair of default width and LIST of TAB record instances") (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) PCNO PC START-OF-PIECE) [while (AND NEXTCR (ILEQ NEXTCR (OR END TEXTLEN))) - do (* ; - "Look at each CR in the range given (or whole file) and insert paragraph breaks accordingly.") - (SETQ PC (\CHTOPC NEXTCR (fetch (TEXTOBJ PCTB) of TEXTOBJ) - T)) - [COND - ((IEQP (ADD1 NEXTCR) - START-OF-PIECE) (* ; - "This para ends on a piece bound.") - ) - (T (* ; - "The CR is in mid-piece. Split just after it.") - (\SPLITPIECE PC (- (ADD1 NEXTCR) - START-OF-PIECE) - TEXTOBJ PCNO) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ] - (replace (PIECE PPARALAST) of PC with T) - (SETQ NEXTCR (\TEDIT.BASICFIND TEXTOBJ CRSTRING (ADD1 NEXTCR] + do (* ; + "Look at each CR in the range given (or whole file) and insert paragraph breaks accordingly.") + (SETQ PC (\CHTOPC NEXTCR (fetch (TEXTOBJ PCTB) of TEXTOBJ) + T)) + [COND + ((IEQP (ADD1 NEXTCR) + START-OF-PIECE) (* ; "This para ends on a piece bound.") + ) + (T (* ; + "The CR is in mid-piece. Split just after it.") + (\SPLITPIECE PC (- (ADD1 NEXTCR) + START-OF-PIECE) + TEXTOBJ PCNO) + (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ] + (replace (PIECE PPARALAST) of PC with T) + (SETQ NEXTCR (\TEDIT.BASICFIND TEXTOBJ CRSTRING (ADD1 NEXTCR] (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T) (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (OR START 1) (OR END TEXTLEN]) (\TEDIT.PARABOUNDS - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 21-Apr-93 18:22 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 21-Apr-93 18:22 by jds") (* ;; "returns the first and last chars of the paragraph bracketed by CH#") (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) PCNO NPC PC OPC BEGIN END PIECE START-OF-PIECE OLDSTART) [COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "An empty document has no paragraphs.") + ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; + "An empty document has no paragraphs.") (RETURN (CONS 1 1] (SETQ PC (\CHTOPC CH# PCTB T)) [COND ((ATOM PC) (* ; - "OOPS, we found the end-of-doc piece. Back up to the last real piece in the document.") + "OOPS, we found the end-of-doc piece. Back up to the last real piece in the document.") (SETQ PC (\CHTOPC (FETCH (TEXTOBJ TEXTLEN) OF TEXTOBJ) PCTB T] (SETQ PIECE PC) (SETQ OPC PIECE) (SETQ OLDSTART (IPLUS START-OF-PIECE (fetch (PIECE PLEN) of PC))) (repeatwhile (AND PIECE (NOT (fetch (PIECE PPARALAST) of OPC))) - do (* ; - "Find the piece that ends the paragraph") - (SETQ OPC PIECE) - (add START-OF-PIECE (fetch (PIECE PLEN) of PIECE)) - (SETQ PIECE (fetch (PIECE NEXTPIECE) of PIECE))) + do (* ; + "Find the piece that ends the paragraph") + (SETQ OPC PIECE) + (add START-OF-PIECE (fetch (PIECE PLEN) of PIECE)) + (SETQ PIECE (fetch (PIECE NEXTPIECE) of PIECE))) [SETQ END (COND (PIECE (* ; - "This is the piece that ends the para. Get the CH# of its final character") + "This is the piece that ends the para. Get the CH# of its final character") (SUB1 START-OF-PIECE)) (T (* ; - "If PIECE winds up NIL, we walked off the end of the document, so use the textlen.") + "If PIECE winds up NIL, we walked off the end of the document, so use the textlen.") (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - (bind (PIECE _ PC) repeatwhile (AND PIECE (NOT (fetch (PIECE PPARALAST) - of PIECE))) - do (* ; - "Now find the piece that ends the previous paragraph") - (add OLDSTART (IMINUS (fetch (PIECE PLEN) of PIECE))) - (SETQ PIECE (fetch (PIECE PREVPIECE) of PIECE))) + (bind (PIECE _ PC) repeatwhile (AND PIECE (NOT (fetch (PIECE PPARALAST) of PIECE))) + do (* ; + "Now find the piece that ends the previous paragraph") + (add OLDSTART (IMINUS (fetch (PIECE PLEN) of PIECE))) + (SETQ PIECE (fetch (PIECE PREVPIECE) of PIECE))) (SETQ BEGIN OLDSTART) (* ; - "Actually, NPC is pointing at the piece that starts THIS para.") + "Actually, NPC is pointing at the piece that starts THIS para.") (RETURN (CONS BEGIN END]) (\TEDIT.FORMATTABS [LAMBDA (TEXTOBJ TABSPEC THISLINE CHBASE WBASE CURTX DFLTTABX MARGINXOFFSET PRIORTAB GRAIN - CLEANINGUP) (* ; "Edited 13-Nov-90 01:09 by jds") - (* ; - "Do the formatting work for a tab.") + CLEANINGUP) (* ; "Edited 13-Nov-90 01:09 by jds") + (* ; "Do the formatting work for a tab.") (* ;; "PRIORTAB is the outstanding tab, if any, that has to be resolved. This will be a centered or flush right tab. its format is a PENDINGTAB") @@ -2161,28 +2012,24 @@ CONS pair of default width and LIST of TAB record instances") of PRIORTAB))) (fetch PTOLDTX of PRIORTAB] (\RPLPTR (fetch PTWBASE of PRIORTAB) - 0 TABWIDTH) (* ; - "Now we can fill in the real width") + 0 TABWIDTH) (* ; "Now we can fill in the real width") (add CURTX TABWIDTH)) (SHOULDNT] (SETQ DEFAULTTAB (OR (CAR TABSPEC) DFLTTABX)) (* ; - "Default Tab width, if there aren't any real tabs to use") - (SETQ NEXTTAB (for TAB in (CDR TABSPEC) when (IGREATERP (fetch TABX - of TAB) - (IDIFFERENCE CURTX - MARGINXOFFSET)) - do (RETURN TAB))) (* ; - "The next tab on this line, if any") + "Default Tab width, if there aren't any real tabs to use") + (SETQ NEXTTAB (for TAB in (CDR TABSPEC) when (IGREATERP (fetch TABX of TAB) + (IDIFFERENCE CURTX MARGINXOFFSET)) + do (RETURN TAB))) (* ; "The next tab on this line, if any") (SETQ NEXTTABTYPE (OR (AND NEXTTAB (fetch TABKIND of NEXTTAB)) 'LEFT)) (* ; - "The type of the next tab (LEFT, if we use the default spacing)") + "The type of the next tab (LEFT, if we use the default spacing)") (SETQ NEXTTABX (IPLUS [COND (NEXTTAB (* ; - "There is a real tab to go to; use its location.") + "There is a real tab to go to; use its location.") (fetch TABX of NEXTTAB)) (T (* ; - "No real tab; use the next multiple of the default spacing.") + "No real tab; use the next multiple of the default spacing.") (ITIMES DEFAULTTAB (IPLUS 1 (IQUOTIENT (IPLUS GRAIN (IDIFFERENCE CURTX @@ -2191,12 +2038,12 @@ CONS pair of default width and LIST of TAB record instances") MARGINXOFFSET)) (* ; "The next tab's X value") (COND (CLEANINGUP (* ; - "We're cleaning up at end of line, so this shouldn't have any effect.") + "We're cleaning up at end of line, so this shouldn't have any effect.") (RETURN CURTX)) (T (SELECTQ NEXTTABTYPE ((DOTTEDLEFT DOTTEDCENTERED DOTTEDRIGHT DOTTEDDECIMAL) (* ; - "This is a dotted-leader tab. Change it to Meta-TAB, so the line displayer knows.") + "This is a dotted-leader tab. Change it to Meta-TAB, so the line displayer knows.") (\RPLPTR CHBASE 0 (CHARCODE %#^I))) NIL) (SELECTQ NEXTTABTYPE @@ -2233,7 +2080,7 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (TEDIT.SUBPARALOOKS - [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 26-Apr-93 15:13 by jds") + [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 26-Apr-93 15:13 by jds") (* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.") @@ -2247,22 +2094,20 @@ CONS pair of default width and LIST of TAB record instances") CHANGEMADE) (\SHOWSEL SEL NIL NIL) (* ; "Turn off the selection, first.") [OR (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (bind (CH# _ 1) for (PC _ FIRSTPC) while PC - by (fetch (PIECE NEXTPIECE) of PC) + (bind (CH# _ 1) for (PC _ FIRSTPC) while PC by (fetch (PIECE NEXTPIECE) of PC) do (COND - ((SAMEPARALOOKS OLDLOOKS (fetch (PIECE PPARALOOKS) of PC) - FEATURELIST) - (replace (TEXTOBJ \DIRTY) of (TEXTOBJ TEXTSTREAM) with T) - (freplace (PIECE PPARALOOKS) of PC - with (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST - NEWLOOKSLIST - (fetch (PIECE PPARALOOKS) - of PC)) - (TEXTOBJ TEXTSTREAM))) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch (PIECE PLEN) - of PC))) - (SETQ CHANGEMADE T))) - (add CH# (fetch (PIECE PLEN) of PC] + ((SAMEPARALOOKS OLDLOOKS (fetch (PIECE PPARALOOKS) of PC) + FEATURELIST) + (replace (TEXTOBJ \DIRTY) of (TEXTOBJ TEXTSTREAM) with T) + (freplace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS + (\TEDIT.PARSE.PARALOOKS.LIST + NEWLOOKSLIST + (fetch (PIECE PPARALOOKS) + of PC)) + (TEXTOBJ TEXTSTREAM))) + (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch (PIECE PLEN) of PC))) + (SETQ CHANGEMADE T))) + (add CH# (fetch (PIECE PLEN) of PC] (COND ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") @@ -2273,73 +2118,43 @@ CONS pair of default width and LIST of TAB record instances") (T 'NoChangesMade]) (SAMEPARALOOKS - [LAMBDA (PARALOOK1 PARALOOK2 FEATURES) (* ; "Edited 8-Dec-92 00:44 by jds") + [LAMBDA (PARALOOK1 PARALOOK2 FEATURES) (* ; "Edited 8-Dec-92 00:44 by jds") (* ;; "Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES") (for F in FEATURES always (SELECTQ F - (STYLE (EQUAL (fetch (FMTSPEC FMTSTYLE) - of PARALOOK1) - (fetch (FMTSPEC FMTSTYLE) - of PARALOOK2))) - (LEFTMARGIN (IEQP (fetch (FMTSPEC LEFTMAR) - of PARALOOK1) - (fetch (FMTSPEC LEFTMAR) - of PARALOOK2))) - (1STLEFTMARGIN (IEQP (fetch (FMTSPEC 1STLEFTMAR) - of PARALOOK1) - (fetch (FMTSPEC 1STLEFTMAR) - of PARALOOK2))) - (RIGHTMARGIN (IEQP (fetch (FMTSPEC RIGHTMAR) - of PARALOOK1) - (fetch (FMTSPEC RIGHTMAR) - of PARALOOK2))) - (QUAD (EQ (fetch (FMTSPEC QUAD) of PARALOOK1) - (fetch (FMTSPEC QUAD) of PARALOOK2))) - (POSTPARALEADING - (IEQP (fetch (FMTSPEC LEADBEFORE) of - PARALOOK1) - (fetch (FMTSPEC LEADBEFORE) of - PARALOOK2))) - (PARALEADING (IEQP (fetch (FMTSPEC LEADBEFORE) - of PARALOOK1) - (fetch (FMTSPEC LEADBEFORE) - of PARALOOK2))) - (LINELEADING (IEQP (fetch (FMTSPEC LINELEAD) - of PARALOOK1) - (fetch (FMTSPEC LINELEAD) - of PARALOOK2))) - (TABS (EQUAL (fetch (FMTSPEC TABSPEC) of - PARALOOK1 - ) - (fetch (FMTSPEC TABSPEC) of - PARALOOK2 - ))) - (NEWPAGEBEFORE (EQ (fetch (FMTSPEC FMTNEWPAGEBEFORE - ) of PARALOOK1 - ) - (fetch (FMTSPEC FMTNEWPAGEBEFORE - ) of PARALOOK2 - ))) - (NEWPAGEAFTER (EQ (fetch (FMTSPEC FMTNEWPAGEAFTER) - of PARALOOK1) - (fetch (FMTSPEC FMTNEWPAGEAFTER) - of PARALOOK2))) - (SPECIALX (IEQP (fetch (FMTSPEC FMTSPECIALX) - of PARALOOK1) - (fetch (FMTSPEC FMTSPECIALX) - of PARALOOK2))) - (SPECIALY (IEQP (fetch (FMTSPEC FMTSPECIALY) - of PARALOOK1) - (fetch (FMTSPEC FMTSPECIALY) - of PARALOOK2))) - (HEADINGKEEP (EQ (fetch (FMTSPEC FMTHEADINGKEEP) - of PARALOOK1) - (fetch (FMTSPEC FMTHEADINGKEEP) - of PARALOOK2))) - (ERROR (CONCAT F + (STYLE (EQUAL (fetch (FMTSPEC FMTSTYLE) of PARALOOK1) + (fetch (FMTSPEC FMTSTYLE) of PARALOOK2))) + (LEFTMARGIN (IEQP (fetch (FMTSPEC LEFTMAR) of PARALOOK1) + (fetch (FMTSPEC LEFTMAR) of PARALOOK2))) + (1STLEFTMARGIN (IEQP (fetch (FMTSPEC 1STLEFTMAR) of PARALOOK1) + (fetch (FMTSPEC 1STLEFTMAR) of PARALOOK2))) + (RIGHTMARGIN (IEQP (fetch (FMTSPEC RIGHTMAR) of PARALOOK1) + (fetch (FMTSPEC RIGHTMAR) of PARALOOK2))) + (QUAD (EQ (fetch (FMTSPEC QUAD) of PARALOOK1) + (fetch (FMTSPEC QUAD) of PARALOOK2))) + (POSTPARALEADING + (IEQP (fetch (FMTSPEC LEADBEFORE) of PARALOOK1) + (fetch (FMTSPEC LEADBEFORE) of PARALOOK2))) + (PARALEADING (IEQP (fetch (FMTSPEC LEADBEFORE) of PARALOOK1) + (fetch (FMTSPEC LEADBEFORE) of PARALOOK2))) + (LINELEADING (IEQP (fetch (FMTSPEC LINELEAD) of PARALOOK1) + (fetch (FMTSPEC LINELEAD) of PARALOOK2))) + (TABS (EQUAL (fetch (FMTSPEC TABSPEC) of PARALOOK1) + (fetch (FMTSPEC TABSPEC) of PARALOOK2))) + (NEWPAGEBEFORE (EQ (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOK1) + (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOK2))) + (NEWPAGEAFTER (EQ (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOK1) + (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOK2))) + (SPECIALX (IEQP (fetch (FMTSPEC FMTSPECIALX) of PARALOOK1) + (fetch (FMTSPEC FMTSPECIALX) of PARALOOK2))) + (SPECIALY (IEQP (fetch (FMTSPEC FMTSPECIALY) of PARALOOK1) + (fetch (FMTSPEC FMTSPECIALY) of PARALOOK2))) + (HEADINGKEEP (EQ (fetch (FMTSPEC FMTHEADINGKEEP) of PARALOOK1) + (fetch (FMTSPEC FMTHEADINGKEEP) of PARALOOK2))) + (ERROR (CONCAT F " is an unknown feature of paragraph looks. Detected in SAMEPARALOOKS" - ]) + ]) ) @@ -2349,37 +2164,33 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (TEDIT.REDO.LOOKS - [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 30-May-91 21:42 by jds") - (* Set looks on the current - selection from the - TEDIT.CHARLOOKS.WINDOW) + [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 30-May-91 21:42 by jds") + (* Set looks on the current selection + from the TEDIT.CHARLOOKS.WINDOW) (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (NEWLOOKS (fetch THAUXINFO of EVENT))) (COND - ((fetch (SELECTION SET) of SEL) (* He's got something selected.) - (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action - again.) + ((fetch (SELECTION SET) of SEL) (* He's got something selected.) + (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action again.) ) (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T]) (TEDIT.REDO.PARALOOKS - [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 30-May-91 21:42 by jds") + [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 30-May-91 21:42 by jds") (* Re-set the looks on selected - paragraphs) + paragraphs) (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (NEWLOOKS (fetch THAUXINFO of EVENT))) (COND - ((fetch (SELECTION SET) of SEL) (* He's got something selected.) - (TEDIT.PARALOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action - again.) + ((fetch (SELECTION SET) of SEL) (* He's got something selected.) + (TEDIT.PARALOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action again.) ) (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T]) (TEDIT.UNDO.LOOKS - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:44 by jds") - (* Set looks on the current - selection from the - TEDIT.CHARLOOKS.WINDOW) + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:44 by jds") + (* Set looks on the current selection + from the TEDIT.CHARLOOKS.WINDOW) (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) CHLIM @@ -2389,17 +2200,15 @@ CONS pair of default width and LIST of TAB record instances") (bind (PC _ (fetch THFIRSTPIECE of EVENT)) for OLDLOOKS in OLDLOOKSLIST do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch (PIECE PLOOKS) of PC))) (* Remember this for the undo.) - (replace (PIECE PLOOKS) of PC with OLDLOOKS) - (* Give this piece its old looks) - [COND - ((EQ PC \INPC) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ - with (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (fetch (PIECE PLOOKS) - of PC] - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (replace THOLDINFO of EVENT with NEWLOOKSLIST) - (* Remember the other looks in case - we UNDO the UNDO.) + (replace (PIECE PLOOKS) of PC with OLDLOOKS) (* Give this piece its old looks) + [COND + ((EQ PC \INPC) + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY + TEXTOBJ + (fetch (PIECE PLOOKS) of PC] + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + (replace THOLDINFO of EVENT with NEWLOOKSLIST) (* Remember the other looks in case we + UNDO the UNDO.) (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch THCH# of EVENT) (fetch THLEN of EVENT) -1)) @@ -2410,25 +2219,22 @@ CONS pair of default width and LIST of TAB record instances") (\SHOWSEL SEL NIL T]) (TEDIT.UNDO.PARALOOKS - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:44 by jds") - (* Set looks on the current - selection from the - TEDIT.CHARLOOKS.WINDOW) + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:44 by jds") + (* Set looks on the current selection + from the TEDIT.CHARLOOKS.WINDOW) (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) CHLIM (OLDLOOKSLIST (fetch THOLDINFO of EVENT)) (NEWLOOKSLIST NIL)) (bind (PC _ (fetch THFIRSTPIECE of EVENT)) for OLDLOOKS in OLDLOOKSLIST - do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch (PIECE PPARALOOKS) - of PC))) + do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch (PIECE PPARALOOKS) of PC))) (* Remember this for the undo.) - (replace (PIECE PPARALOOKS) of PC with OLDLOOKS) + (replace (PIECE PPARALOOKS) of PC with OLDLOOKS) (* Give this piece its old looks) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (replace THOLDINFO of EVENT with NEWLOOKSLIST) - (* Remember the other looks in case - we UNDO the UNDO.) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + (replace THOLDINFO of EVENT with NEWLOOKSLIST) (* Remember the other looks in case we + UNDO the UNDO.) (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch THCH# of EVENT) (fetch THLEN of EVENT) -1)) @@ -2446,7 +2252,7 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (\TEDIT.MARK.REVISION - [LAMBDA (TEXTOBJ FMTSPEC IMAGESTREAM LINE) (* ; "Edited 30-May-91 21:38 by jds") + [LAMBDA (TEXTOBJ FMTSPEC IMAGESTREAM LINE) (* ; "Edited 30-May-91 21:38 by jds") (LET ((SCALE (DSPSCALE NIL IMAGESTREAM))) (BLTSHADE BLACKSHADE IMAGESTREAM (+ (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) (FIXR (CL:* 12 SCALE))) @@ -2497,13 +2303,12 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (\TEDIT.APPLY.STYLES - [LAMBDA (LOOKS PC TEXTOBJ) (* ; - "Edited 4-Jul-93 01:02 by sybalskY:MV:ENVOS") + [LAMBDA (LOOKS PC TEXTOBJ) (* ; + "Edited 4-Jul-93 01:02 by sybalskY:MV:ENVOS") (* ;; "Given a set of looks, return the looks with the proper styles expanded out.") - (\TEDIT.CHECK (type? CHARLOOKS LOOKS)) (* ; - "Incoming thing has to be a LOOKS.") + (\TEDIT.CHECK (type? CHARLOOKS LOOKS)) (* ; "Incoming thing has to be a LOOKS.") (OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*)) (CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*)) (LET ((STYLE (fetch (CHARLOOKS CLSTYLE) of LOOKS)) @@ -2513,30 +2318,28 @@ CONS pair of default width and LIST of TAB record instances") CHARSTYLES CHARSTYLE IN-PARA FMTSPEC) (SETQ STYLE (COND ((NULL STYLE) (* ; - "STYLE of NIL means don't bother. Just use the looks we got.") + "STYLE of NIL means don't bother. Just use the looks we got.") (SETQ NOSTYLE T) LOOKS) ((AND [SETQ CHARSTYLES (AND (fetch (TEXTSTREAM CURRENTPARALOOKS) of (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ)) + of TEXTOBJ)) (fetch (FMTSPEC FMTCHARSTYLES) - of (fetch (TEXTSTREAM - CURRENTPARALOOKS) - of (fetch (TEXTOBJ - STREAMHINT) - of TEXTOBJ] + of (fetch (TEXTSTREAM CURRENTPARALOOKS) + of (fetch (TEXTOBJ STREAMHINT) + of TEXTOBJ] (SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES))) (* ; - "If the paragraph we're in has character styles, and this is one of them, use it.") + "If the paragraph we're in has character styles, and this is one of them, use it.") (SETQ IN-PARA T) CHARSTYLE) ((CDR (SASSOC STYLE STYLE-SHEET))) ((AND (LITATOM STYLE) (DEFINEDP STYLE)) (* ; - "Call the guy's function to find the new looks") + "Call the guy's function to find the new looks") (APPLY* STYLE LOOKS PC TEXTOBJ)) (T (* ; - "If all else fails, return the original set of looks") + "If all else fails, return the original set of looks") (SETQ NOSTYLE T) LOOKS))) (SETQ STYLE (COND @@ -2553,13 +2356,12 @@ CONS pair of default width and LIST of TAB record instances") STYLE]) (\TEDIT.APPLY.PARASTYLES - [LAMBDA (PARALOOKS PC TEXTOBJ) (* ; - "Edited 3-Jul-93 23:15 by sybalskY:MV:ENVOS") + [LAMBDA (PARALOOKS PC TEXTOBJ) (* ; + "Edited 3-Jul-93 23:15 by sybalskY:MV:ENVOS") (* ;; "Given a set of looks, return the looks with the proper styles expanded out.") - (\TEDIT.CHECK (type? FMTSPEC PARALOOKS)) (* ; - "Incoming thing has to be a LOOKS.") + (\TEDIT.CHECK (type? FMTSPEC PARALOOKS)) (* ; "Incoming thing has to be a LOOKS.") (OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*)) (LET* [(NOSTYLE) (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ) @@ -2573,7 +2375,7 @@ CONS pair of default width and LIST of TAB record instances") ((AND (LITATOM (fetch (FMTSPEC FMTSTYLE) of PARALOOKS)) (DEFINEDP (fetch (FMTSPEC FMTSTYLE) of PARALOOKS))) (* ; - "Call the guy's function to find the new looks") + "Call the guy's function to find the new looks") (APPLY* (fetch (FMTSPEC FMTSTYLE) of PARALOOKS) PARALOOKS PC TEXTOBJ)) (T (SETQ NOSTYLE T) @@ -2587,54 +2389,54 @@ CONS pair of default width and LIST of TAB record instances") STYLE]) (TEDIT.STYLESHEET - [LAMBDA (SHEET TEXTSTREAM) (* ; - "Edited 3-Jul-93 23:19 by sybalskY:MV:ENVOS") + [LAMBDA (SHEET TEXTSTREAM) (* ; + "Edited 3-Jul-93 23:19 by sybalskY:MV:ENVOS") (* ;; "Put a new stylesheet into force. This REPLACES any existing style sheets, and forgets any pushed sheets.") (LET [(TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM] (COND (TEXTOBJ (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ; - "Clear the cache, to force reformatting") + "Clear the cache, to force reformatting") (replace (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ with SHEET)) (T (* ;; "No specific document given; change the global style sheet TEDIT.STYLES") (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ; - "Clear the cache, to force reformatting") + "Clear the cache, to force reformatting") (SETQ TEDIT.STYLES SHEET) (SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES]) (TEDIT.POP.STYLESHEET - [LAMBDA NIL (* ; - "Edited 3-Jul-93 17:42 by sybalskY:MV:ENVOS") + [LAMBDA NIL (* ; + "Edited 3-Jul-93 17:42 by sybalskY:MV:ENVOS") (* ;; "Go back to an earlier stylesheet, by popping the stack of saved sheets. You can't pop back to no sheet -- you'll always bottom out at the original style sheet.") (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ; - "Clear the cache, to force reformatting") + "Clear the cache, to force reformatting") (SETQ TEDIT.STYLES (OR (CL:POP *TEDIT-STYLESHEET-SAVE-LIST*) TEDIT.STYLES]) (TEDIT.PUSH.STYLESHEET - [LAMBDA (SHEET) (* ; - "Edited 3-Jul-93 17:40 by sybalskY:MV:ENVOS") + [LAMBDA (SHEET) (* ; + "Edited 3-Jul-93 17:40 by sybalskY:MV:ENVOS") (* ;; "Add more style definitions to the current style sheet, and remember how to get back to the old one. Think of this as PUSHING onto a stack of stylesheets, with the new sheet being a composition of SHEET and the existing styles. ") (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ; - "Clear the cache, to force reformatting") + "Clear the cache, to force reformatting") (SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES)) (CL:PUSH TEDIT.STYLES *TEDIT-STYLESHEET-SAVE-LIST*]) (TEDIT.ADD.STYLESHEET - [LAMBDA (SHEET) (* ; - "Edited 3-Jul-93 17:38 by sybalskY:MV:ENVOS") + [LAMBDA (SHEET) (* ; + "Edited 3-Jul-93 17:38 by sybalskY:MV:ENVOS") (* ;; "Add more style definitions to the current style sheet. This ADDS entries, without remembering that there was an earlier sheet. ") (SETQ *TEDIT-PARASTYLE-CACHE* NIL) (* ; - "Clear the cache, to force reformatting") + "Clear the cache, to force reformatting") (SETQ TEDIT.STYLES (APPEND SHEET TEDIT.STYLES)) (SETQ *TEDIT-STYLESHEET-SAVE-LIST* (LIST TEDIT.STYLES]) ) @@ -2665,28 +2467,26 @@ CONS pair of default width and LIST of TAB record instances") (RPAQ? *TEDIT-CURRENTPARA-CACHE* ) (RPAQ? *TEDIT-STYLESHEET-SAVE-LIST* ) -(PUTPROPS TEDITLOOKS COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 - 1990 1991 1992 1993 1994 1999)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8534 61591 (CHARLOOKS.FROM.FONT 8544 . 10228) (EQCLOOKS 10230 . 12750) (SAMECLOOKS -12752 . 18828) (\TEDIT.UNIQUIFY.CHARLOOKS 18830 . 19391) (TEDIT.CARETLOOKS 19393 . 21069) ( -TEDIT.COPY.LOOKS 21071 . 23183) (\TEDIT.GET.CHARLOOKS 23185 . 26163) (\TEDIT.UNPARSE.CHARLOOKS.LIST -26165 . 29043) (TEDIT.MODIFYLOOKS 29045 . 30827) (TEDIT.NEW.FONT 30829 . 31264) (\TEDIT.PUT.CHARLOOKS -31266 . 33059) (\TEDIT.CARETLOOKS.VERIFY 33061 . 34192) (\TEDIT.GET.INSERT.CHARLOOKS 34194 . 37958) ( -\TEDIT.GET.TERMSA.WIDTHS 37960 . 38394) (\TEDIT.LOOKS.UPDATE 38396 . 50020) ( -\TEDIT.PARSE.CHARLOOKS.LIST 50022 . 58755) (\TEDIT.FLUSH.UNUSED.LOOKS 58757 . 61589)) (61639 64190 ( -TEDIT.SUBLOOKS 61649 . 64188)) (64191 94025 (\TEDIT.CHANGE.LOOKS 64201 . 83729) (TEDIT.LOOKS 83731 . -85641) (\TEDIT.LOOKS 85643 . 88868) (\TEDIT.FONTCOPY 88870 . 90144) (TEDIT.GET.LOOKS 90146 . 94023)) ( -94068 148145 (\TEDIT.GET.PARALOOKS 94078 . 94558) (EQFMTSPEC 94560 . 98042) (\TEDIT.UNIQUIFY.PARALOOKS - 98044 . 98606) (TEDIT.GET.PARALOOKS 98608 . 100046) (\TEDIT.UNPARSE.PARALOOKS.LIST 100048 . 103449) ( -\TEDIT.PARSE.PARALOOKS.LIST 103451 . 111477) (TEDIT.PARALOOKS 111479 . 132937) (TEDIT.COPY.PARALOOKS -132939 . 134999) (\TEDIT.PUT.PARALOOKS 135001 . 135891) (\TEDIT.CONVERT.TO.FORMATTED 135893 . 137906) -(\TEDIT.PARABOUNDS 137908 . 140707) (\TEDIT.FORMATTABS 140709 . 148143)) (148205 156686 ( -TEDIT.SUBPARALOOKS 148215 . 150773) (SAMEPARALOOKS 150775 . 156684)) (156729 162561 (TEDIT.REDO.LOOKS -156739 . 157630) (TEDIT.REDO.PARALOOKS 157632 . 158436) (TEDIT.UNDO.LOOKS 158438 . 160653) ( -TEDIT.UNDO.PARALOOKS 160655 . 162559)) (162600 163134 (\TEDIT.MARK.REVISION 162610 . 163132)) (163196 -163865 (\CREATE.TEDIT.DEFAULT.FMTSPEC 163206 . 163487) (\CREATE.TEDIT.FACE.MENU 163489 . 163661) ( -\CREATE.TEDIT.SIZE.MENU 163663 . 163863)) (163902 172479 (\TEDIT.APPLY.STYLES 163912 . 167502) ( -\TEDIT.APPLY.PARASTYLES 167504 . 169439) (TEDIT.STYLESHEET 169441 . 170485) (TEDIT.POP.STYLESHEET -170487 . 171134) (TEDIT.PUSH.STYLESHEET 171136 . 171855) (TEDIT.ADD.STYLESHEET 171857 . 172477))))) + (FILEMAP (NIL (8377 56776 (CHARLOOKS.FROM.FONT 8387 . 9892) (EQCLOOKS 9894 . 12309) (SAMECLOOKS 12311 + . 16155) (\TEDIT.UNIQUIFY.CHARLOOKS 16157 . 16712) (TEDIT.CARETLOOKS 16714 . 18316) (TEDIT.COPY.LOOKS + 18318 . 20588) (\TEDIT.GET.CHARLOOKS 20590 . 23319) (\TEDIT.UNPARSE.CHARLOOKS.LIST 23321 . 26046) ( +TEDIT.MODIFYLOOKS 26048 . 27868) (TEDIT.NEW.FONT 27870 . 28290) (\TEDIT.PUT.CHARLOOKS 28292 . 30027) ( +\TEDIT.CARETLOOKS.VERIFY 30029 . 31104) (\TEDIT.GET.INSERT.CHARLOOKS 31106 . 34560) ( +\TEDIT.GET.TERMSA.WIDTHS 34562 . 34978) (\TEDIT.LOOKS.UPDATE 34980 . 46131) ( +\TEDIT.PARSE.CHARLOOKS.LIST 46133 . 54180) (\TEDIT.FLUSH.UNUSED.LOOKS 54182 . 56774)) (56824 59209 ( +TEDIT.SUBLOOKS 56834 . 59207)) (59210 86410 (\TEDIT.CHANGE.LOOKS 59220 . 77134) (TEDIT.LOOKS 77136 . +78970) (\TEDIT.LOOKS 78972 . 82154) (\TEDIT.FONTCOPY 82156 . 83522) (TEDIT.GET.LOOKS 83524 . 86408)) ( +86453 139794 (\TEDIT.GET.PARALOOKS 86463 . 86947) (EQFMTSPEC 86949 . 90450) (\TEDIT.UNIQUIFY.PARALOOKS + 90452 . 91017) (TEDIT.GET.PARALOOKS 91019 . 92339) (\TEDIT.UNPARSE.PARALOOKS.LIST 92341 . 95532) ( +\TEDIT.PARSE.PARALOOKS.LIST 95534 . 103137) (TEDIT.PARALOOKS 103139 . 125355) (TEDIT.COPY.PARALOOKS +125357 . 127186) (\TEDIT.PUT.PARALOOKS 127188 . 128086) (\TEDIT.CONVERT.TO.FORMATTED 128088 . 130018) +(\TEDIT.PARABOUNDS 130020 . 132703) (\TEDIT.FORMATTABS 132705 . 139792)) (139854 145740 ( +TEDIT.SUBPARALOOKS 139864 . 142341) (SAMEPARALOOKS 142343 . 145738)) (145783 151119 (TEDIT.REDO.LOOKS +145793 . 146574) (TEDIT.REDO.PARALOOKS 146576 . 147334) (TEDIT.UNDO.LOOKS 147336 . 149393) ( +TEDIT.UNDO.PARALOOKS 149395 . 151117)) (151158 151696 (\TEDIT.MARK.REVISION 151168 . 151694)) (151758 +152427 (\CREATE.TEDIT.DEFAULT.FMTSPEC 151768 . 152049) (\CREATE.TEDIT.FACE.MENU 152051 . 152223) ( +\CREATE.TEDIT.SIZE.MENU 152225 . 152425)) (152464 160866 (\TEDIT.APPLY.STYLES 152474 . 155842) ( +\TEDIT.APPLY.PARASTYLES 155844 . 157740) (TEDIT.STYLESHEET 157742 . 158809) (TEDIT.POP.STYLESHEET +158811 . 159479) (TEDIT.PUSH.STYLESHEET 159481 . 160221) (TEDIT.ADD.STYLESHEET 160223 . 160864))))) STOP diff --git a/library/TEDITLOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM similarity index 59% rename from library/TEDITLOOKS.LCOM rename to library/tedit/TEDIT-LOOKS.LCOM index a7737d2213e79d801c8725f7305f34242c65b424..43129dcaddf9ec914ee129f578a60733646c911c 100644 GIT binary patch delta 1444 zcmb_bZERCj7|t!-*O^$rLN}21(6FQh+U#~K+wMrQtOYCW%6iwuInCCsoix2`XE$U7 zOE+RNlKs$mh?_xHw(fglw7ZEB6G=$;A&3cy(HK7x;}0Vy>OaklCcbYw7H0UT{qa2K zJn#2=dqy5AuKc8U`$Uou!*Q3}+2C{9o1G4-=c`RGoRLhHN{fZ^hXremP+g;^27Ono zr#CExf;1MTdP>ea#FL35XZk|%K3gQvD+Qu9Db^K`Y(1f%6gpRBw%X3d;*oIlRa0KE zN#V|TAb!r)9}0&1ZBWbAY;t>(-jkxao;UuhaFxK<36(W^LObK3jnbik-gsYyK%=q# z(~y~lp_Su)x0^oRwApOd(_jF~JSit{(HkG1IQfK;twMF(|2SfPLRcnWYptfjDW9{& z<@Jju2P~XQWb?*(fw#cy|EYX5bawNSa~)I}3FESArQoO~vQ@FdDTsk33N-RxTO^Jn za=5@)$Pu=;jc0dC6CfOW%7A)g>kb9b1(h0!ZLd%Q-Q0N#Zv$m}(B*RZYe}jNg@j?QhE`=&u=mo|B(Gd>ayi-wjX(>%Mvh zsMYf!+IM)1p(L0btX=E@;WKdvi+fu-FeLNhMV!PmqLqEE_aFd9SOxQgwo4e@`ic)5 zUJgVEP?_|c3OpiP{qoBBWwf^?ijcZ4s4!>WU@21a;ur>LhB>72krXy?^R2ZUjxxvS zX^^jvCeZib(ek zy?+oM0(_$euSbMGr|*=#sfj*%AnQ6c7!J_-dP-Q&wM*NGk>*~lxbDW3ll~%-4`J<- z?U0ts?qlCi+Tf&{8VA(Q*xA}t1>Vy^z~8e??29z4nLSLSziYZ%Nie@|Y8SgZ-3*d; zrn`t>*$q|2GBf_1rH&n)-3O<@Y$xEISxm8it_kqwpY$(4XExe;(&))nW2j#6lSH%MR0`wK{;%T4|P2$#LR delta 1550 zcmb7^Z%kWN6u{F8%nj}Utqul(%QI+;Yx7>qpT4rxJ=-!m`j5VL8-qm(Eu*fsT?+() zY)Z^#BxZwaWacZY`bMqV&eUbF}emfBj5YPs&j z3(06K5~hhbeK7mbA@*7Q(UD3(4vWQ|4B$?ildVlwcs?n;GHLl2Z;gb1d3-b6`vZzz5!lBRu$ zY75mid1RU`*O0B3bv9`_bu^iZ3`7(C>1?uK#u@AMQvV^nSW5-oQdes+@%Nwhe3UgvA6;WQy)#a%O^zAjS(dDCUZ*b3ojF>;~?}O3Kh=zVrx+(z4Aco+zJw2%@f4ehZs9`q?Jf z7-T!Up-t!E6-F~#5vj6IcYQM$6q!CkrX`u z*U`4x`!M7HW*OLgBfpH9bnWd#*R}nlSmUm-3MJBZ3yh(-)m*%_jwOdR${+1Xj1W8M z$12_r9o_=s>DaD9uslkF%FW>=JdclTLNRc(5Mv*IDIdke=p;JToKT_IF*c1!+&=kx zmg8*ScrU0w7#~4f>l=9}9B*nchXa$Z0KcC69C+>YS8%}I8pQL0GuQBZ?d-?ElT%~B zvgv8yd(&rh*(R}h-7<8l-zT-Ut~bwpHPvcsXk#NKZ1mi#g+vDp2H)&Pi?Qu9!90@f zHa0Nx9E5~MVEPPUzs*=-SAYIA@YC}>n~1hG=nXj7a>m16yHEt$t*fo<#|!Y_6SL^p zIop#%@S0n*&u4ukHgK^T{NVPiwwir-F_=9O+1|M-SPjl~0q@SCd*gg7@b&pH@R#`> zVB4hwz;`dQ;X68It$?S^~92{Tl0DiaF3AA5s15RDW(5fXF z7+gZl@{)gIdK)XbQm!T(yLYyPd9K{c$M;x&9*z~gy`2TF{`!D!>r^>AvivjncdmpV zU!MiC%PZN}U)gSR!N+rVr2<+OAD`XfOIb;V1N+9zP9PisCo@>YpP5h*2{_#j+3$5r z9v%D$ORQp|(b*lqzgBr5uOLH;2e_hC0`DkQ@QxV&8AhfmVC?#W0iWON+xQo=|24IF zeQkc{?&bhY+&zijIE=gXNkpHd`y;8uAhjh@$wVsD7fr-DDu`wi0_KNku0zx#8W3iL cNPr?tS5XuYFt0=rUAE%P5k(Qw_c&eTZ&cdV7XSbN diff --git a/library/TEDITMENU b/library/tedit/TEDIT-MENU similarity index 73% rename from library/TEDITMENU rename to library/tedit/TEDIT-MENU index de2c36c7..142fb1fc 100644 --- a/library/TEDITMENU +++ b/library/tedit/TEDIT-MENU @@ -1,24 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Jan-2022 22:54:59" {DSK}kaplan>Local>medley3.5>my-medley>library>TEDITMENU.;3 275091 +(FILECREATED "14-Jul-2022 16:55:50"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-MENU.;1 270108 - :CHANGES-TO (FNS \TEXTMENU.DOC.CREATE) - - :PREVIOUS-DATE "26-Oct-2021 08:44:02" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITMENU.;2) + :PREVIOUS-DATE "14-Jul-2022 13:10:07" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-MENU.;3) -(* ; " -Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-MENUCOMS) -(PRETTYCOMPRINT TEDITMENUCOMS) - -(RPAQQ TEDITMENUCOMS - [(FILES TEDITDCL) +(RPAQQ TEDIT-MENUCOMS + [(FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) [COMS (* ; "Simple Menu Button support") (FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME @@ -96,7 +91,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (NLAML) (LAMA]) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -108,7 +103,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) @@ -118,10 +113,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (MB.BUTTONEVENTINFN - [LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM)(* ; "Edited 30-May-91 22:15 by jds") + [LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM) (* ; "Edited 30-May-91 22:15 by jds") (* There was a buttn event inside a menu button. - Make sure that the button gets turned OFF when the mouse moves outside it.) + Make sure that the button gets turned OFF when the mouse moves outside it.) (PROG [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX] (replace (SELECTION SELKIND) of SEL with 'VOLATILE) @@ -129,23 +124,22 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED) (* This button is still active from an earlier hit. - Don't let it be selected again.) + Don't let it be selected again.) (RETURN 'DON'T)) ((AND (IGEQ RELX 0) (IGEQ RELY 0) (ILEQ RELX (fetch XSIZE of OBJBOX)) - (ILEQ RELY (fetch YSIZE of OBJBOX))) - (* We're really inside the thing. - Return an indication that we're to - be left alone.) + (ILEQ RELY (fetch YSIZE of OBJBOX))) (* We're really inside the thing. + Return an indication that we're to be + left alone.) (RETURN T)) (T (* He's moved outside the button. - Don't permit the selection.) + Don't permit the selection.) (RETURN 'DON'T]) (MB.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 11-Jan-89 16:58 by jds") + [LAMBDA (OBJ STREAM MODE) (* ; "Edited 11-Jan-89 16:58 by jds") (* ;; "Display the innards of a menu button") @@ -160,13 +154,11 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((IMAGEOBJPROP OBJ 'BITCACHE)) (T (MB.SETIMAGE OBJ) (IMAGEOBJPROP OBJ 'BITCACHE] - [BITBLT BITMAP 0 0 STREAM X (SETQ Y (IDIFFERENCE Y (fetch YDESC - of OBJBOX] + [BITBLT BITMAP 0 0 STREAM X (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX] (* ; "Display the button's image") (COND ((EQ (IMAGEOBJPROP OBJ 'STATE) - 'ON) (* ; - "If the button is ON, mark it so.") + 'ON) (* ; "If the button is ON, mark it so.") (BITBLT NIL 0 0 STREAM X Y (fetch XSIZE of OBJBOX) (fetch YSIZE of OBJBOX) 'TEXTURE @@ -174,17 +166,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (PROG (BITMAP DS (FONT (IMAGEOBJPROP OBJ 'MBFONT)) (TEXT (IMAGEOBJPROP OBJ 'MBTEXT)) OLOOKS) (* ; - "Going to some output image stream. Use the actual text.") + "Going to some output image stream. Use the actual text.") (SETQ OLOOKS (DSPFONT (FONTCOPY FONT 'DEVICE STREAM) STREAM)) (* ; - "Change to the font for this menu button.") + "Change to the font for this menu button.") (PRIN1 TEXT STREAM) (* ; "Print the button text") - (DSPFONT OLOOKS STREAM) (* ; - "And put the font back as it was.") + (DSPFONT OLOOKS STREAM) (* ; "And put the font back as it was.") ]) (MB.SETIMAGE - [LAMBDA (OBJ) (* jds "23-Aug-84 13:22") + [LAMBDA (OBJ) (* jds "23-Aug-84 13:22") (PROG ((MBFONT (IMAGEOBJPROP OBJ 'MBFONT)) (MBTEXT (IMAGEOBJPROP OBJ 'MBTEXT)) BOX BITMAP DS) @@ -207,28 +198,27 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN OBJ]) (MB.SELFN - [LAMBDA (OBJ SEL W FN) (* ; "Edited 30-May-91 22:15 by jds") + [LAMBDA (OBJ SEL W FN) (* ; "Edited 30-May-91 22:15 by jds") (* Calls a menu-button's associated - function, then turns off the - highlighting of the menu button.) + function, then turns off the + highlighting of the menu button.) (PROG [(TSEL (create SELECTION)) (BUTTONFN (OR FN (IMAGEOBJPROP OBJ 'MBFN] (\COPYSEL SEL TSEL) (* Save the selection that points to - the menu button.) + the menu button.) (replace (SELECTION SELKIND) of SEL with 'CHAR) (replace (SELECTION SET) of SEL with NIL) - (replace (SELECTION ONFLG) of SEL with NIL) - (* Call the button's function) + (replace (SELECTION ONFLG) of SEL with NIL) (* Call the button's function) (COND ((NEQ (AND BUTTONFN (APPLY* BUTTONFN OBJ SEL W)) - 'DON'T) (* If the button fn left the - selection alone,) + 'DON'T) (* If the button fn left the selection + alone,) (\FIXSEL TSEL (fetch (SELECTION \TEXTOBJ) of TSEL)) (\SHOWSEL TSEL NIL NIL))) (* Turn off the button hilite) ]) (MB.SIZEFN - [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* jds "30-Aug-84 11:24") + [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* jds "30-Aug-84 11:24") (* Tell the size of a menu button) (PROG ((FONT (IMAGEOBJPROP OBJ 'MBFONT)) BOX) @@ -249,7 +239,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN BOX]) (MB.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* jds " 7-Feb-84 14:20") + [LAMBDA (OBJ DS OPERATION SEL) (* jds " 7-Feb-84 14:20") (SELECTQ OPERATION (HIGHLIGHTED (MB.SHOWSELFN OBJ SEL T DS)) (UNHIGHLIGHTED (MB.SHOWSELFN OBJ SEL NIL DS)) @@ -258,7 +248,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL]) (MB.COPYFN - [LAMBDA (OBJ) (* jds "23-May-84 11:32") + [LAMBDA (OBJ) (* jds "23-May-84 11:32") (* Copy a menu button object.) (create IMAGEOBJ OBJECTDATUM _ (COPY (fetch (IMAGEOBJ OBJECTDATUM) of OBJ)) @@ -280,28 +270,24 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (MB.PUTFN [LAMBDA (OBJ FILE) (* ; "Edited 20-Aug-87 16:17 by jds") - - (* ;; - "Write a menu button from a file; suitable for re-reading using the image objects GETFN.") + + (* ;; "Write a menu button from a file; suitable for re-reading using the image objects GETFN.") (PROG [(TEXT (IMAGEOBJPROP OBJ 'MBTEXT)) (MBFN (IMAGEOBJPROP OBJ 'MBFN)) (FONT (IMAGEOBJPROP OBJ 'MBFONT] (HELP) (\STRINGOUT FILE TEXT) (* ; "The button's image") - (\ATMOUT FILE MBFN) (* ; "The FN called when hit") - (\ATMOUT FILE (FONTPROP FONT 'FAMILY)) (\SMALLPOUT FILE (FONTPROP FONT 'SIZE)) (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) (MB.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 11-Jan-89 16:35 by jds") + [LAMBDA (OBJ SEL ON DS) (* ; "Edited 11-Jan-89 16:35 by jds") (LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX] (OR (IMAGEOBJPROP OBJ 'BITCACHE) - (MB.DISPLAY OBJ)) (* ; - "MAKE SURE THE DISPLAY FORM EXISTS") + (MB.DISPLAY OBJ)) (* ; "MAKE SURE THE DISPLAY FORM EXISTS") (BITBLT (IMAGEOBJPROP OBJ 'BITCACHE) 0 0 DS 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) (fetch (IMAGEBOX YSIZE) of OBJBOX) @@ -317,7 +303,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'INVERT BLACKSHADE]) (MBUTTON.CREATE - [LAMBDA (MBTEXT MBFN MBFONT IMAGEFNS) (* ; "Edited 11-Jan-89 16:10 by jds") + [LAMBDA (MBTEXT MBFN MBFONT IMAGEFNS) (* ; "Edited 11-Jan-89 16:10 by jds") (* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields") @@ -330,19 +316,18 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. XKERN _ 0)) BITMAP DS) (IMAGEOBJPROP OBJ 'MBFN MBFN) (* ; - "The function to be called when the button is pushed") - (IMAGEOBJPROP OBJ 'MBTEXT MBTEXT) (* ; - "The text displayed in the button") + "The function to be called when the button is pushed") + (IMAGEOBJPROP OBJ 'MBTEXT MBTEXT) (* ; "The text displayed in the button") (IMAGEOBJPROP OBJ 'MBFONT REAL-FONT) (* ; "The font that text appears in") - (MB.SETIMAGE OBJ) (* ; - "Set up the image for the button, so we don't create it repeatedly.") + (MB.SETIMAGE OBJ) (* ; + "Set up the image for the button, so we don't create it repeatedly.") OBJ]) (MBUTTON.CHANGENAME - [LAMBDA (TEXTOBJ OBJ NEWNAME) (* jds "23-Aug-84 13:26") - - (* Change the text that appears in a button, and redisplay the button if it's - visible) + [LAMBDA (TEXTOBJ OBJ NEWNAME) (* jds "23-Aug-84 13:26") + + (* Change the text that appears in a button, and redisplay the button if it's + visible) (PROG (BOX BITMAP DS) (IMAGEOBJPROP OBJ 'MBTEXT NEWNAME) @@ -350,7 +335,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (TEDIT.OBJECT.CHANGED TEXTOBJ OBJ]) (MBUTTON.FIND.BUTTON - [LAMBDA (LABEL TEXTSTREAM CH#) (* ; "Edited 22-Apr-93 15:40 by jds") + [LAMBDA (LABEL TEXTSTREAM CH#) (* ; "Edited 22-Apr-93 15:40 by jds") (* "27-Sep-84 00:52" gbn) (* * returns the piece no containing the imageobj with MBTEXT prop LABEL) @@ -359,38 +344,38 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. OBJ STARTPCNO (PCTB (fetch (TEXTOBJ PCTB) of (TEXTOBJ TEXTSTREAM))) START-OF-PIECE PC) (RETURN (first (SETQ PC (\CHTOPC (OR CH# 1) - PCTB T)) while (AND PC (NOT (ATOM PC))) + PCTB T)) while (AND PC (NOT (ATOM PC))) do (SETQ OBJ (fetch (PIECE POBJ) of PC)) - (COND - ([AND OBJ (EQ LABELATOM (MKATOM (IMAGEOBJPROP OBJ 'MBTEXT] - (RETURN PCNO))) - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) + (COND + ([AND OBJ (EQ LABELATOM (MKATOM (IMAGEOBJPROP OBJ 'MBTEXT] + (RETURN PCNO))) + (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) (MBUTTON.FIND.NEXT.BUTTON - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 22-Apr-93 16:39 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 22-Apr-93 16:39 by jds") (* ;; "Finds the next instance of an OBJECT which looks like a menu button, 3-state button, or menuobj. If none is found, return NIL") (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) START-OF-PIECE) (RETURN (bind PC OBJ first (SETQ PC (\CHTOPC CH# PCTB T)) - while (AND PC (NOT (ATOM PC))) - do (* ; - "Loo thru the piece table, looking for pieces with objects in them") - (SETQ OBJ (fetch (PIECE POBJ) of PC)) - [COND - ((AND OBJ (OR (type? MBUTTON OBJ) - (type? MARGINBAR OBJ) - (type? NWAYBUTTON OBJ))) + while (AND PC (NOT (ATOM PC))) do (* ; + "Loo thru the piece table, looking for pieces with objects in them") + (SETQ OBJ (fetch (PIECE POBJ) of PC)) + [COND + ((AND OBJ (OR (type? MBUTTON OBJ) + (type? MARGINBAR OBJ) + (type? NWAYBUTTON OBJ))) (* ; - "Which are some kind of menu-buttonish object") - (RETURN (CONS OBJ START-OF-PIECE] - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) + "Which are some kind of menu-buttonish object") + (RETURN (CONS OBJ START-OF-PIECE] + (add START-OF-PIECE (fetch (PIECE PLEN) + of PC)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) (MBUTTON.FIND.NEXT.FIELD - [LAMBDA (TEXTOBJ CH# DON'TFIX) (* ; "Edited 22-Apr-93 16:53 by jds") + [LAMBDA (TEXTOBJ CH# DON'TFIX) (* ; "Edited 22-Apr-93 16:53 by jds") (* ;; "Starting from CH#, find the next fill-in area (usually surrounded by a {-} pair), and select any text it contains. Returns the TEXTOBJ's SCRATCHSEL with the text selected. (If no insert point is found, NIL.)") @@ -400,43 +385,41 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (COND ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; - "Can't look past the end of the document") + "Can't look past the end of the document") (RETURN NIL))) (SETQ PC (\CHTOPC CH# PCTB T)) - (while PC do (* ; - "Look thru the pieces for one which starts a user-fill-in area") - (COND - ((fetch (CHARLOOKS CLSELHERE) of (fetch (PIECE PLOOKS) - of PC)) + (while PC do (* ; + "Look thru the pieces for one which starts a user-fill-in area") + (COND + ((fetch (CHARLOOKS CLSELHERE) of (fetch (PIECE PLOOKS) of PC)) (* ; "Found it, so return") + (RETURN))) + (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + (COND + (PC (* ; + "We found a starting point for a type-in field") + (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) + (SETQ CH1 START-OF-PIECE) (* ; + "Remember the starting character number") + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + (while PC do (COND + ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) + of PC)) (RETURN))) (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (COND - (PC (* ; - "We found a starting point for a type-in field") - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ CH1 START-OF-PIECE) (* ; - "Remember the starting character number") - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (while PC do (COND - ((fetch (CHARLOOKS CLPROTECTED) - of (fetch (PIECE PLOOKS) of PC)) - (RETURN))) - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) (SETQ LEN (IDIFFERENCE START-OF-PIECE CH1)) (replace (SELECTION CH#) of SCRATCHSEL with CH1) - (replace (SELECTION CHLIM) of SCRATCHSEL with (IPLUS CH1 - (IMAX 0 LEN))) + (replace (SELECTION CHLIM) of SCRATCHSEL with (IPLUS CH1 (IMAX 0 LEN))) (replace (SELECTION DCH) of SCRATCHSEL with LEN) (replace (SELECTION SELOBJ) of SCRATCHSEL with NIL) (replace (SELECTION POINT) of SCRATCHSEL with 'LEFT) (* ; - "So if it's used, it'll be in the correct spot.") + "So if it's used, it'll be in the correct spot.") (replace (SELECTION SELKIND) of SCRATCHSEL with 'CHAR)) (T (* ; - "No fill-in blank found, so return an indication.") + "No fill-in blank found, so return an indication.") (RETURN NIL))) (COND ((NOT DON'TFIX) @@ -444,7 +427,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN SCRATCHSEL]) (MBUTTON.INIT - [LAMBDA NIL (* jds "12-Feb-85 14:32") + [LAMBDA NIL (* jds "12-Feb-85 14:32") (SETQ MBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAY) (FUNCTION MB.SIZEFN) (FUNCTION MB.PUTFN) @@ -461,16 +444,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'TEditMenuButton]) (MBUTTON.NEXT.FIELD.AS.NUMBER - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 12-Jun-90 19:00 by mitani") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 12-Jun-90 19:00 by mitani") (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) (NUMBERP (MKATOM (TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ]) (MBUTTON.NEXT.FIELD.AS.PIECES - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-Mar-94 16:02 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-Mar-94 16:02 by jds") (* ;; - "Find the next fill-in field in the menu after CH#, and return its contents as A LIST OF PIECES.") + "Find the next fill-in field in the menu after CH#, and return its contents as A LIST OF PIECES.") (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) (TEDIT.SELECTED.PIECES TEXTOBJ (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) @@ -478,7 +461,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'CL:IDENTITY]) (MBUTTON.NEXT.FIELD.AS.TEXT - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 22-Apr-93 16:14 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 22-Apr-93 16:14 by jds") (* ;; "Find the next fill-in field in the menu after CH#, and return its contents as a string.") @@ -487,23 +470,23 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ]) (MBUTTON.NEXT.FIELD.AS.ATOM - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 12-Jun-90 19:00 by mitani") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 12-Jun-90 19:00 by mitani") - (* Find the next fill-in field, and return its contents as an atom. - If the field is empty, return NIL.) + (* Find the next fill-in field, and return its contents as an atom. + If the field is empty, return NIL.) - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) (* Move to the next fill-in blank.) + (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) (* Move to the next fill-in blank.) (PROG [(STR (TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ] (COND - ((ZEROP (NCHARS STR)) (* The field is empty.) + ((ZEROP (NCHARS STR)) (* The field is empty.) (RETURN NIL)) - (T (* It's non-empty. - Convert the string to an atom.) + (T (* It's non-empty. Convert the string + to an atom.) (RETURN (MKATOM STR]) (MBUTTON.SET.FIELD - [LAMBDA (TEXTSTREAM FIELD VALUE) (* ; "Edited 22-Apr-93 10:56 by jds") + [LAMBDA (TEXTSTREAM FIELD VALUE) (* ; "Edited 22-Apr-93 10:56 by jds") (* ;; "Makes the contents of the field with name FIELD be VALUE.") @@ -513,13 +496,12 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ PCNO (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM)) (COND (PCNO [SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch (PCTNODE CHNUM) - of (FINDNODE-INDEX - PCTB PCNO] + of (FINDNODE-INDEX PCTB PCNO] (* ; - "select the field following this button.") + "select the field following this button.") (COND (FIELD.SEL (* ; - "there are contents to set for this button") + "there are contents to set for this button") (\FIXSEL FIELD.SEL TEXTOBJ) (TEDIT.SETSEL TEXTSTREAM (fetch (SELECTION CH#) of FIELD.SEL) (fetch (SELECTION DCH) of FIELD.SEL) @@ -528,40 +510,38 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ NEW-STRING (MKSTRING VALUE)) (COND ((ZEROP (NCHARS NEW-STRING)) (* ; - "Nothing to replace, so just delete it.") + "Nothing to replace, so just delete it.") (TEDIT.DELETE TEXTSTREAM)) - (T (* ; - "there IS new info, so insert it.") + (T (* ; "there IS new info, so insert it.") (TEDIT.INSERT TEXTSTREAM (MKSTRING VALUE]) (MBUTTON.SET.NEXT.FIELD - [LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* ; "Edited 30-May-91 22:15 by jds") + [LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* ; "Edited 30-May-91 22:15 by jds") - (* SET the text content of the next fill-in field in this document to be - NEWVALUE) + (* SET the text content of the next fill-in field in this document to be NEWVALUE) (PROG ((SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ))) - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) (* Find the next menu fill-in field) + (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) (* Find the next menu fill-in field) (\FIXSEL SCRATCHSEL TEXTOBJ) (* Fix up the SELECTION that describes its contents, so we've got the right - screen coordinates &c) + screen coordinates &c) (OR (ZEROP (fetch (SELECTION DCH) of SCRATCHSEL)) (\TEDIT.DELETE SCRATCHSEL TEXTOBJ T)) (* If there is text in that fill-in, - delete it to make room for ours) + delete it to make room for ours) (COND (NEWVALUE (* Only insert something if there IS - something to insert.) + something to insert.) (TEDIT.\INSERT (MKSTRING NEWVALUE) SCRATCHSEL TEXTOBJ))) (* Then fill it with out new value.) ]) (MBUTTON.SET.NEXT.BUTTON.STATE - [LAMBDA (TEXTOBJ STARTINGCH NEWSTATE) (* jds "31-Jul-85 22:09") - - (* * Find the next menu button in the document, and set its state to NEWSTATE. - Return 1 + the CH# of the button, for further searchers) + [LAMBDA (TEXTOBJ STARTINGCH NEWSTATE) (* jds "31-Jul-85 22:09") + + (* * Find the next menu button in the document, and set its state to NEWSTATE. + Return 1 + the CH# of the button, for further searchers) (PROG* ((NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ STARTINGCH)) (BUTTON (CAR NEXTB))) @@ -569,10 +549,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN (ADD1 (CDR NEXTB]) (TEDITMENU.STREAM - [LAMBDA (TEXTSTREAM) (* jds "13-Aug-84 14:10") - - (* returns the textstream of the teditmenu attached to this stream if any) - + [LAMBDA (TEXTSTREAM) (* jds "13-Aug-84 14:10") + (* returns the textstream of the + teditmenu attached to this stream if + any) (PROG (MENUW (MAINWINDOW (\TEDIT.MAINW TEXTSTREAM))) [SETQ MENUW (for W in (ATTACHEDWINDOWS MAINWINDOW) thereis (AND (WINDOWPROP W 'TEDITMENU) @@ -582,10 +562,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (MENUW (TEXTSTREAM MENUW]) (\TEDITMENU.SELSCREENER - [LAMBDA (TEXTOBJ SEL SELECTMODE FINAL?) (* ; "Edited 30-May-91 22:15 by jds") + [LAMBDA (TEXTOBJ SEL SELECTMODE FINAL?) (* ; "Edited 30-May-91 22:15 by jds") (* Called to screen potential selections in the TEdit menu window; - if an edit op is in progress, no selection will be permitted.-) + if an edit op is in progress, no selection will be permitted.-) (PROG ((MAINW (WINDOWPROP (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) 'MAINWINDOW)) @@ -629,7 +609,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (MB.CREATE.THREESTATEBUTTON - [LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* jds "24-Sep-86 00:49") + [LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* jds "24-Sep-86 00:49") (PROG ((OBJ (IMAGEOBJCREATE NIL THREESTATEIMAGEFNS)) (BOX (create IMAGEBOX XSIZE _ (STRINGWIDTH TEXT FONT) @@ -657,7 +637,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN OBJ]) (MB.THREESTATE.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* jds "30-Aug-84 13:53") + [LAMBDA (OBJ STREAM MODE) (* jds "30-Aug-84 13:53") (* Display the innards of a menu  button) (PROG (DS (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) @@ -687,16 +667,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (BITBLT BITMAP 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) X Y 'INPUT 'PAINT) (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON - - (* The button is ON. Display it as white text on black background) - + (ON (* The button is ON. + Display it as white text on black + background) (BITBLT NIL 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) X Y 'TEXTURE 'INVERT BLACKSHADE)) - (OFF - - (* The button is OFF. Mark it with a diagonal line thru it.) - + (OFF (* The button is OFF. + Mark it with a diagonal line thru it.) (DRAWLINE CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) (SUB1 (IPLUS CURX X)) (SUB1 (IPLUS (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) @@ -708,32 +685,32 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL]) (MB.THREESTATE.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 30-May-91 22:16 by jds") + [LAMBDA (OBJ SEL ON DS) (* ; "Edited 30-May-91 22:16 by jds") (PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) (IMAGEBOX OBJ DS] (COND (ON (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* Switch from ON to NEUTRAL) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (OFF (* Switch from OFF to ON) - (BITBLT (IMAGEOBJPROP OBJ 'BITCACHE) - 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INPUT - 'REPLACE) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (NEUTRAL (* Switch from NEUTRAL to OFF) - (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX)) - (SUB1 (fetch YSIZE of IMAGEBOX)) - 1 - 'PAINT DS)) - NIL)) + (ON (* Switch from ON to NEUTRAL) + (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) + (fetch YSIZE of IMAGEBOX) + 'TEXTURE + 'INVERT BLACKSHADE)) + (OFF (* Switch from OFF to ON) + (BITBLT (IMAGEOBJPROP OBJ 'BITCACHE) + 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) + (fetch YSIZE of IMAGEBOX) + 'INPUT + 'REPLACE) + (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) + (fetch YSIZE of IMAGEBOX) + 'TEXTURE + 'INVERT BLACKSHADE)) + (NEUTRAL (* Switch from NEUTRAL to OFF) + (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX)) + (SUB1 (fetch YSIZE of IMAGEBOX)) + 1 + 'PAINT DS)) + NIL)) ((fetch (SELECTION SET) of SEL) (SELECTQ (IMAGEOBJPROP OBJ 'STATE) (ON (* Switch from NEUTRAL to ON) @@ -759,29 +736,28 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL]) (MB.THREESTATE.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") - (* Handle operations on a - three-state button) + [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") + (* Handle operations on a three-state + button) (SELECTQ OPERATION (HIGHLIGHTED (* It is being hilighted) (MB.THREESTATE.SHOWSELFN OBJ SEL T DS)) (UNHIGHLIGHTED (* And being de-hilighted) (MB.THREESTATE.SHOWSELFN OBJ SEL NIL DS)) (SELECTED (* It's being selected) - (MB.THREESTATEBUTTON.FN OBJ SEL DS) (* Run the state-changing function) - (replace (SELECTION SET) of SEL with NIL) - (* And mar the selection turned off, - so others can use it without - trashing us) + (MB.THREESTATEBUTTON.FN OBJ SEL DS) (* Run the state-changing function) + (replace (SELECTION SET) of SEL with NIL) (* And mar the selection turned off, + so others can use it without trashing + us) (replace (SELECTION ONFLG) of SEL with NIL) (replace (SELECTION SET) of TEDIT.SELECTION with NIL)) (DESELECTED) NIL]) (MB.THREESTATEBUTTON.FN - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:16 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:16 by jds") (* MBFN for TEdit default menu item - buttons.) + buttons.) (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) OFILE CH NEWSTATE) @@ -791,14 +767,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (NEUTRAL 'OFF) 'ON)) (if STATECHANGEFN - then (* apply the user supplied state - change fn if she supplied one) - (APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ))) + then (* apply the user supplied state + change fn if she supplied one) + (APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ))) (IMAGEOBJPROP OBJ 'STATE NEWSTATE) (replace (SELECTION ONFLG) of SEL with NIL]) (THREESTATE.INIT - [LAMBDA NIL (* jds " 9-Feb-86 15:17") + [LAMBDA NIL (* jds " 9-Feb-86 15:17") (* Initialize the IMAGEFNS for 3-state  menu button IMAGEOBJs) (SETQ THREESTATEIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.THREESTATE.DISPLAY) @@ -828,7 +804,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (MB.CREATE.NWAYBUTTON - [LAMBDA (BUTTONS FONT CHANGESTATEFN INITSTATE MAXITEMS/LINE) + [LAMBDA (BUTTONS FONT CHANGESTATEFN INITSTATE MAXITEMS/LINE) (* gbn "24-Sep-84 15:31") (PROG ((OBJECT (IMAGEOBJCREATE NIL NWAYBUTTONIMAGEFNS)) HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS WIDTHS TWIDTHS) @@ -870,9 +846,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (T (IPLUS (CAR WIDTHS) (for WIDTH in (CDR WIDTHS) sum (IPLUS WIDTH SPACING] - - (* At most, we're as wide as the N widest buttons put together) - + (* At most, we're as wide as the N + widest buttons put together) (IMAGEOBJPROP OBJECT 'MAXHEIGHT (ITIMES (IPLUS HEIGHT 2) (LENGTH BUTTONS))) (IMAGEOBJPROP OBJECT 'ITEMSPACE SPACING) @@ -890,7 +865,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN OBJECT]) (MB.NB.DISPLAYFN - [LAMBDA (OBJ STREAM MODE) (* jds "28-Aug-84 15:07") + [LAMBDA (OBJ STREAM MODE) (* jds "28-Aug-84 15:07") (* Display the innards of a menu  button) (PROG (BITMAP DS (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) @@ -926,24 +901,24 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL NIL 'INVERT 'REPLACE]) (MB.NB.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") + [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") (SELECTQ OPERATION (HIGHLIGHTED (* (MB.SHOWSELFN OBJ SEL T DS))) (UNHIGHLIGHTED (* (MB.SHOWSELFN OBJ SEL NIL DS))) - (SELECTED (* There may be a side-effect to - occur upon selection.) + (SELECTED (* There may be a side-effect to occur + upon selection.) [PROG ((STATE (IMAGEOBJPROP OBJ 'STATE)) FN) (for BUTTON in (IMAGEOBJPROP OBJ 'BUTTONS) as SIDEFN in (IMAGEOBJPROP OBJ 'SIDEEFFECTFNS) when (EQ STATE BUTTON) do (COND - (SIDEFN (MB.SELFN OBJ SEL DS SIDEFN] + (SIDEFN (MB.SELFN OBJ SEL DS SIDEFN] (replace (SELECTION SET) of SEL with NIL)) (DESELECTED) NIL]) (MB.NB.SIZEFN - [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* jds " 6-Sep-84 14:19") + [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* jds " 6-Sep-84 14:19") (* Tell the size of an n-way menu) (PROG ((OLDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) BOX @@ -960,16 +935,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. BUTTONX BUTTONY BUTTONINFO WIDTH HEIGHT) [COND ((AND (IGEQ SLACK MAXWIDTH) - (NOT MAXITEMS/LINE)) - - (* There's space for all the items on one line. - Use it) - + (NOT MAXITEMS/LINE)) (* There's space for all the items on + one line. Use it) (SETQ WIDTH MAXWIDTH) (SETQ HEIGHT MINHEIGHT) [SETQ BUTTONX (bind (CURX _ 0) for ITEM in BUTTONWIDTHS - collect (PROG1 CURX (add CURX SPACING) - (add CURX ITEM] + collect (PROG1 CURX + (add CURX SPACING) + (add CURX ITEM))] (SETQ BUTTONY (for ITEM in BUTTONWIDTHS collect 0))) [(ILEQ SLACK MINWIDTH) (* Have to stack it vertically.) (SETQ WIDTH MINWIDTH) @@ -1004,7 +977,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN BOX]) (MB.NWAYBUTTON.SELFN - [LAMBDA (OBJ W SEL MOUSEX MOUSEY) (* ; "Edited 30-May-91 22:16 by jds") + [LAMBDA (OBJ W SEL MOUSEX MOUSEY) (* ; "Edited 30-May-91 22:16 by jds") (* Selecting an NWAY button.) (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) @@ -1017,42 +990,43 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (BUTTONLIST (IMAGEOBJPROP OBJ 'BUTTONLIST)) (BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT)) CH STATE) - [for BUTTON in BUTTONLIST as X in BUTTONX as Y in BUTTONY - as WIDTH in BUTTONWIDTHS as IMAGE in BUTTONIMAGES + [for BUTTON in BUTTONLIST as X in BUTTONX as Y in BUTTONY as WIDTH in BUTTONWIDTHS + as IMAGE in BUTTONIMAGES do (COND - ((INSIDE? (create REGION - LEFT _ X - BOTTOM _ Y - WIDTH _ WIDTH - HEIGHT _ BUTTONHEIGHT) - MOUSEX MOUSEY) (* The mouse is pointing here. - Select this.) - (SETQ STATE BUTTON) - (BITBLT IMAGE 0 0 W X Y NIL NIL 'INVERT 'REPLACE)) - ((EQ OLDSTATE BUTTON) (* This was the old selection - (and it's different, too)%. - Unselect it) - (BITBLT IMAGE 0 0 W X Y NIL NIL 'INPUT 'REPLACE] + ((INSIDE? (create REGION + LEFT _ X + BOTTOM _ Y + WIDTH _ WIDTH + HEIGHT _ BUTTONHEIGHT) + MOUSEX MOUSEY) (* The mouse is pointing here. + Select this.) + (SETQ STATE BUTTON) + (BITBLT IMAGE 0 0 W X Y NIL NIL 'INVERT 'REPLACE)) + ((EQ OLDSTATE BUTTON) (* This was the old selection + (and it's different, too)%. + Unselect it) + (BITBLT IMAGE 0 0 W X Y NIL NIL 'INPUT 'REPLACE] (IMAGEOBJPROP OBJ 'STATE STATE) (RETURN T]) (MB.NWAYMENU.NEWBUTTON - [LAMBDA (TEXTOBJ CH# OLDBUTTON NEWBUTTON) (* jds " 8-Feb-84 19:41") - - (* Given a hook on an existing button, and an insertion point, insert a new - button) + [LAMBDA (TEXTOBJ CH# OLDBUTTON NEWBUTTON) (* jds " 8-Feb-84 19:41") + + (* Given a hook on an existing button, and an insertion point, insert a new + button) (PROG ((ARBITRATOR (IMAGEOBJPROP OLDBUTTON 'ARBITRATOR)) BUTTON) (IMAGEOBJPROP BUTTON 'ARBITRATOR ARBITRATOR) (TEDIT.INSERT.OBJECT BUTTON TEXTOBJ CH#) (TEDIT.INSERT TEXTOBJ " " (ADD1 CH#)) - (TEDIT.LOOKS TEXTOBJ '(PROTECTED ON) (ADD1 CH#) + (TEDIT.LOOKS TEXTOBJ '(PROTECTED ON) + (ADD1 CH#) 2) (RETURN BUTTON]) (NWAYBUTTON.INIT - [LAMBDA (BUTTONS FONT INITSTATE) (* jds " 9-Feb-86 15:17") + [LAMBDA (BUTTONS FONT INITSTATE) (* jds " 9-Feb-86 15:17") (SETQ NWAYBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NB.DISPLAYFN) (FUNCTION MB.NB.SIZEFN) (FUNCTION MB.PUTFN) @@ -1069,12 +1043,12 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'NWayButton]) (MB.NB.PACKITEMS - [LAMBDA (WIDTH ITEMWIDTHS SPACING MAXITEMS/LINE) (* jds "24-Oct-84 17:42") - - (* * Pack items into lines WIDTH wide. Item widths are in ITEMWIDTHS, and each - pair of items on a line is separated by SPACING. - Returns a list of lists, one per line packed, of the relative X starts of the - items) + [LAMBDA (WIDTH ITEMWIDTHS SPACING MAXITEMS/LINE) (* jds "24-Oct-84 17:42") + + (* * Pack items into lines WIDTH wide. Item widths are in ITEMWIDTHS, and each + pair of items on a line is separated by SPACING. + Returns a list of lists, one per line packed, of the relative X starts of the + items) (PROG ((CURX 0) (LINES NIL) @@ -1103,10 +1077,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN LINES]) (MB.NWAYBUTTON.ADDITEM - [LAMBDA (OBJECT NEWBUTTON) (* jds "11-Jul-85 12:44") - - (* Given an existing n-way choice menu button, add another choice to the list) - + [LAMBDA (OBJECT NEWBUTTON) (* jds "11-Jul-85 12:44") + (* Given an existing n-way choice menu + button, add another choice to the list) (PROG ([BUTTONS (CONS NEWBUTTON (IMAGEOBJPROP OBJECT 'BUTTONS] HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS WIDTHS FONT) (SETQ FONT (IMAGEOBJPROP OBJECT 'MBFONT)) @@ -1171,10 +1144,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TEXTMENU.TOGGLE.CREATE - [LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* gbn "24-Sep-84 14:45") - - (* Creates a TOGGLE menu button, that can turn off and on alternately.) - + [LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* gbn "24-Sep-84 14:45") + (* Creates a TOGGLE menu button, that + can turn off and on alternately.) (PROG ((OBJ (IMAGEOBJCREATE NIL \TOGGLEIMAGEFNS)) (BOX (create IMAGEBOX XSIZE _ (STRINGWIDTH TEXT FONT) @@ -1188,9 +1160,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (IMAGEOBJPROP OBJ 'MBFONT FONT) (IMAGEOBJPROP OBJ 'MBFN '\TEXTMENU.TOGGLEFN) (IMAGEOBJPROP OBJ 'STATECHANGEFN STATECHANGEFN) - - (* a function to be called on finalization of selection of this button to - provide for user side-effects) + + (* a function to be called on finalization of selection of this button to provide + for user side-effects) (IMAGEOBJPROP OBJ 'STATE (OR INITSTATE 'OFF)) (SETQ BITMAP (BITMAPCREATE X Y)) @@ -1206,7 +1178,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN OBJ]) (\TEXTMENU.TOGGLE.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* gbn "27-Sep-84 01:23") + [LAMBDA (OBJ STREAM MODE) (* gbn "27-Sep-84 01:23") (* "27-Sep-84 01:11" gbn) (* Display the innards of a menu  toggle) @@ -1238,10 +1210,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (BITBLT BITMAP 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) X Y 'INPUT 'PAINT) (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON - - (* The button is ON. Display it as white text on black background) - + (ON (* The button is ON. + Display it as white text on black + background) (BITBLT NIL 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) X Y 'TEXTURE 'INVERT BLACKSHADE)) (OFF (* The button is OFF. @@ -1249,28 +1220,28 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (ERROR "Invalid state in toggle button " OBJ]) (\TEXTMENU.TOGGLE.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 30-May-91 22:16 by jds") + [LAMBDA (OBJ SEL ON DS) (* ; "Edited 30-May-91 22:16 by jds") (PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) (IMAGEBOX OBJ DS] (COND (ON (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* Switch from ON to - (NEUTRAL (* Switch from OFF to - NEUTRAL) (BITBLT (IMAGEOBJPROP OBJ - (QUOTE BITCACHE)) 0 0 DS 0 0 - (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - (QUOTE INPUT) (QUOTE REPLACE)))) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (OFF (* Switch from OFF to ON) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - NIL)) + (ON (* Switch from ON to + (NEUTRAL (* Switch from OFF to NEUTRAL) + (BITBLT (IMAGEOBJPROP OBJ + (QUOTE BITCACHE)) 0 0 DS 0 0 + (fetch XSIZE of IMAGEBOX) + (fetch YSIZE of IMAGEBOX) + (QUOTE INPUT) (QUOTE REPLACE)))) + (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) + (fetch YSIZE of IMAGEBOX) + 'TEXTURE + 'INVERT BLACKSHADE)) + (OFF (* Switch from OFF to ON) + (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) + (fetch YSIZE of IMAGEBOX) + 'TEXTURE + 'INVERT BLACKSHADE)) + NIL)) ((fetch (SELECTION SET) of SEL) (SELECTQ (IMAGEOBJPROP OBJ 'STATE) (ON (* Switch from OFF to ON) @@ -1286,29 +1257,28 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL]) (\TEXTMENU.TOGGLE.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") - (* Handle operations on a - three-state button) + [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") + (* Handle operations on a three-state + button) (SELECTQ OPERATION (HIGHLIGHTED (* It is being hilighted) (\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL T DS)) (UNHIGHLIGHTED (* And being de-hilighted) (\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL NIL DS)) (SELECTED (* It's being selected) - (\TEXTMENU.TOGGLEFN OBJ SEL DS) (* Run the state-changing function) - (replace (SELECTION SET) of SEL with NIL) - (* And mar the selection turned off, - so others can use it without - trashing us) + (\TEXTMENU.TOGGLEFN OBJ SEL DS) (* Run the state-changing function) + (replace (SELECTION SET) of SEL with NIL) (* And mar the selection turned off, + so others can use it without trashing + us) (replace (SELECTION ONFLG) of SEL with NIL) (replace (SELECTION SET) of TEDIT.SELECTION with NIL)) (DESELECTED) NIL]) (\TEXTMENU.TOGGLEFN - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:16 by jds") - (* MBFN for TOGGLE buttons--cycle - back and forthe betwen states.) + [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:16 by jds") + (* MBFN for TOGGLE buttons--cycle back + and forthe betwen states.) (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) OFILE CH NEWSTATE) @@ -1318,14 +1288,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'ON)) (COND (STATECHANGEFN (* apply the user supplied state - change fn if he supplied one) + change fn if he supplied one) (APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ) SEL))) (IMAGEOBJPROP OBJ 'STATE NEWSTATE) (replace (SELECTION ONFLG) of SEL with NIL]) (\TEXTMENU.TOGGLE.INIT - [LAMBDA NIL (* jds " 9-Feb-86 15:18") + [LAMBDA NIL (* jds " 9-Feb-86 15:18") (SETQ \TOGGLEIMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEXTMENU.TOGGLE.DISPLAY) (FUNCTION MB.SIZEFN) (FUNCTION MB.PUTFN) @@ -1342,10 +1312,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'ToggleButton]) (\TEXTMENU.SET.TOGGLE - [LAMBDA (TEXT VALUE TEXTSTREAM) (* ; "Edited 12-Jun-90 19:02 by mitani") + [LAMBDA (TEXT VALUE TEXTSTREAM) (* ; "Edited 12-Jun-90 19:02 by mitani") - (* * finds the button with MBTEXT field TEXT in TEXTSTREAM and sets its state - to VALUE) + (* * finds the button with MBTEXT field TEXT in TEXTSTREAM and sets its state to + VALUE) (PROG ((PCNO (MBUTTON.FIND.BUTTON TEXT TEXTSTREAM)) OBJ PC) @@ -1353,11 +1323,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((NOT PCNO) (ERROR TEXT " was not found as a button."))) [SETQ OBJ (fetch (PIECE POBJ) of (SETQ PC (fetch (PCTNODE PCE) - of (FINDNODE-INDEX - (fetch (TEXTOBJ PCTB) - of (TEXTOBJ TEXTSTREAM) - ) - PCNO] + of (FINDNODE-INDEX (fetch (TEXTOBJ PCTB) + of (TEXTOBJ TEXTSTREAM)) + PCNO] (IMAGEOBJPROP OBJ 'STATE VALUE) (IMAGEOBJPROP OBJ 'BITCACHE 'JUNK) (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM)) @@ -1383,9 +1351,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (DRAWMARGINSCALE - [LAMBDA (W UNIT) (* ; "Edited 12-Jun-90 18:59 by mitani") + [LAMBDA (W UNIT) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* ;; " Draw the margin-bar scale -- the markings across the bottom of the margin bar that show you the margin values. Draws the scale in window W, according to UNIT = 1 for points, or 12 for picas.") + (* ;; " Draw the margin-bar scale -- the markings across the bottom of the margin bar that show you the margin values. Draws the scale in window W, according to UNIT = 1 for points, or 12 for picas.") (PROG ((WREG (DSPCLIPPINGREGION NIL W)) (OLDOP (DSPOPERATION 'REPLACE W))) @@ -1395,41 +1363,38 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. WIDTH _ (fetch (REGION WIDTH) of WREG) HEIGHT _ 24) WHITESHADE - 'REPLACE W) (* ; "CLEAR IT OUT FIRST.") + 'REPLACE W) (* ; "CLEAR IT OUT FIRST.") (SELECTQ UNIT - (1 (* ; "Straight Points") + (1 (* ; "Straight Points") [for X from 4 by 3 to (fetch (REGION WIDTH) of WREG) do + (* ;; "Put a tick every 3 points, with a number every inch.") - (* ;; "Put a tick every 3 points, with a number every inch.") - - (COND - ((ZEROP (IREMAINDER (IDIFFERENCE X 4) - 72)) - (BITBLT NIL 0 0 W X 8 1 16 'TEXTURE 'REPLACE BLACKSHADE) - (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH (IDIFFERENCE X 4)) - 1)) - 10 W) - (PRIN1 (IDIFFERENCE X 4) - W)) - (T (BITBLT NIL 0 0 W X 20 1 4 'TEXTURE 'REPLACE BLACKSHADE]) - (12 (* ; "Picas") - (for X from 4 by 12 to (fetch (REGION WIDTH) of WREG) - as NOMX from 0 + (COND + ((ZEROP (IREMAINDER (IDIFFERENCE X 4) + 72)) + (BITBLT NIL 0 0 W X 8 1 16 'TEXTURE 'REPLACE BLACKSHADE) + (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH (IDIFFERENCE X 4)) + 1)) + 10 W) + (PRIN1 (IDIFFERENCE X 4) + W)) + (T (BITBLT NIL 0 0 W X 20 1 4 'TEXTURE 'REPLACE BLACKSHADE]) + (12 (* ; "Picas") + (for X from 4 by 12 to (fetch (REGION WIDTH) of WREG) as NOMX from 0 do + (* ;; "Put a tick every half-pica, with a number every inch.") - (* ;; "Put a tick every half-pica, with a number every inch.") - - (COND - ((ZEROP (IREMAINDER NOMX 6)) - (BITBLT NIL 0 0 W X 8 1 16 'TEXTURE 'REPLACE BLACKSHADE) - (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH NOMX) - 1)) - 10 W) - (PRIN1 NOMX W)) - (T (BITBLT NIL 0 0 W X 20 1 4 'TEXTURE 'REPLACE BLACKSHADE))) - (BITBLT NIL 0 0 W (IPLUS X 6) - 22 1 2 'TEXTURE 'REPLACE BLACKSHADE))) + (COND + ((ZEROP (IREMAINDER NOMX 6)) + (BITBLT NIL 0 0 W X 8 1 16 'TEXTURE 'REPLACE BLACKSHADE) + (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH NOMX) + 1)) + 10 W) + (PRIN1 NOMX W)) + (T (BITBLT NIL 0 0 W X 20 1 4 'TEXTURE 'REPLACE BLACKSHADE))) + (BITBLT NIL 0 0 W (IPLUS X 6) + 22 1 2 'TEXTURE 'REPLACE BLACKSHADE))) NIL) (BITBLT NIL 0 0 W 4 23 (fetch (REGION WIDTH) of WREG) 1 @@ -1453,9 +1418,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DSPOPERATION OLDOP W]) (MARGINBAR - [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* Given a set of margins and a - unit, show the margin bar properly) + [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* ; "Edited 12-Jun-90 18:59 by mitani") + (* Given a set of margins and a unit, + show the margin bar properly) (PROG ((OLDOP (DSPOPERATION 'ERASE W)) (SCALEDL1 (MSCALE L1 UNIT)) (SCALEDLN (MSCALE LN UNIT)) @@ -1470,33 +1435,32 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ LN (MKSTRING (ABS LN))) (SETQ R (MKSTRING (ABS R))) [COND - [(ILESSP SCALEDR 4) (* Unset right margin. - Show specially, but at its usual - place.) + [(ILESSP SCALEDR 4) (* Unset right margin. + Show specially, but at its usual + place.) (SETQ FLOATINGRIGHT T) (SETQ SCALEDR (IPLUS 4 (IDIFFERENCE 4 SCALEDR] - ((ILEQ SCALEDR 4) (* Floating right margin => marked - specially) + ((ILEQ SCALEDR 4) (* Floating right margin => marked + specially) (SETQ FLOATINGRIGHT T) (SETQ SCALEDR RIGHTLIM)) - ((IGREATERP SCALEDR RIGHTLIM) (* Not floating, so just limit it to - the rightmost that can be seen.) + ((IGREATERP SCALEDR RIGHTLIM) (* Not floating, so just limit it to + the rightmost that can be seen.) (SETQ EXTENDEDRIGHT T) (SETQ SCALEDR (IDIFFERENCE RIGHTLIM 8] [COND - ((ILESSP SCALEDL1 4) (* Unset right FIRST LEFT margin. - Show specially, but at its usual - place.) + ((ILESSP SCALEDL1 4) (* Unset right FIRST LEFT margin. + Show specially, but at its usual + place.) (SETQ UNSETL1 T) (SETQ SCALEDL1 (IPLUS 4 (IDIFFERENCE 4 SCALEDL1] [COND - ((ILESSP SCALEDLN 4) (* Unset LEFT margin. - Show specially, but at its usual - place.) + ((ILESSP SCALEDLN 4) (* Unset LEFT margin. + Show specially, but at its usual + place.) (SETQ UNSETLN T) (SETQ SCALEDLN (IPLUS 4 (IDIFFERENCE 4 SCALEDLN] - (BITBLT NIL 0 0 W 1 26 (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION - NIL W)) + (BITBLT NIL 0 0 W 1 26 (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL W)) 3) 32 'TEXTURE @@ -1510,8 +1474,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'TEXTURE 'REPLACE BLACKSHADE) (COND - (UNSETL1 (* 1st left margin isn't set, tho it - has a value. Mark it neutral) + (UNSETL1 (* 1st left margin isn't set, tho it + has a value. Mark it neutral) (BITBLT NIL 0 0 W SCALEDL1 42 (IPLUS (STRINGWIDTH L1 W) 2) 16 @@ -1526,8 +1490,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 44 W) (PRIN1 L1 W))) (COND - (UNSETLN (* left margin isn't set, tho it has - a value. Mark it neutral) + (UNSETLN (* left margin isn't set, tho it has a + value. Mark it neutral) (BITBLT NIL 0 0 W SCALEDLN 26 (IPLUS (STRINGWIDTH LN W) 2) 16 @@ -1542,8 +1506,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 28 W) (PRIN1 LN W))) [COND - (FLOATINGRIGHT (* Floating right margin is marked - by a light gray marker) + (FLOATINGRIGHT (* Floating right margin is marked by + a light gray marker) (BITBLT NIL 0 0 W (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W) 2)) 26 @@ -1553,9 +1517,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'TEXTURE 'REPLACE EDITGRAY) (DSPOPERATION 'PAINT W)) - (EXTENDEDRIGHT (* A non-visible right margin is - marked by two wavy lines indicating - a break) + (EXTENDEDRIGHT (* A non-visible right margin is + marked by two wavy lines indicating a + break) (BITBLT TEDIT.EXTENDEDRIGHTMARK 0 0 W SCALEDR 26 8 32 'INPUT 'REPLACE] (MOVETO (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W) 2)) @@ -1563,16 +1527,15 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (PRIN1 R W) (DSPOPERATION OLDOP W) (COND - ((EQ TABS 'NEUTRAL) (* All tabs have been neutralized. - Just lay down a grey pattern over - them.) + ((EQ TABS 'NEUTRAL) (* All tabs have been neutralized. + Just lay down a grey pattern over + them.) (DSPFILL (create REGION LEFT _ 2 BOTTOM _ 1 HEIGHT _ 8 - WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of ( - DSPCLIPPINGREGION - NIL W)) + WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL W) + ) 4)) EDITGRAY 'REPLACE W)) @@ -1580,20 +1543,19 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. LEFT _ 2 BOTTOM _ 1 HEIGHT _ 8 - WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) - of (DSPCLIPPINGREGION NIL W)) + WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION + NIL W)) 4)) WHITESHADE 'REPLACE W) - (for TAB in TABS do (* Run thru the tabs, putting them - down in place.) - (MB.MARGINBAR.SHOWTAB W TAB UNIT 'PAINT]) + (for TAB in TABS do (* Run thru the tabs, putting them + down in place.) + (MB.MARGINBAR.SHOWTAB W TAB UNIT 'PAINT]) (MARGINBAR.CREATE - [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* Create an instance of the - margin-setting ruler for TEdit's - use.) + [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (* ; "Edited 12-Jun-90 18:59 by mitani") + (* Create an instance of the + margin-setting ruler for TEdit's use.) (PROG ((BOX (create IMAGEBOX XSIZE _ 1008 YSIZE _ 62 @@ -1611,15 +1573,15 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. MARTABTYPE _ MARTABTYPE)) MARGINBARIMAGEFNS)) - (* Create an IMAGEOBJ, containing an instance of the record to hold margin and - tab info) + (* Create an IMAGEOBJ, containing an instance of the record to hold margin and + tab info) (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX) - (fetch YSIZE of BOX))) (* A cache for the ruler's screen - image) + (fetch YSIZE of BOX))) (* A cache for the ruler's screen + image) (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) (* And a displaystream for modifying - that image) + (SETQ DS (DSPCREATE BITMAP)) (* And a displaystream for modifying + that image) (IMAGEOBJPROP OBJ 'DSPCACHE DS) (DSPXOFFSET 0 DS) (DSPYOFFSET 0 DS) @@ -1637,22 +1599,21 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL DS))) - (* Fill in the cache with the original value This does the time-consuming part - of drawing the ticks on the ruler and such, which would make drawing it on the - fly unbearable.) + (* Fill in the cache with the original value This does the time-consuming part of + drawing the ticks on the ruler and such, which would make drawing it on the fly + unbearable.) (IMAGEOBJPROP OBJ 'NEEDSUPDATE T) - (* And tell the display function that it needs to be updated when first - displayed. Which is the faster part.) + (* And tell the display function that it needs to be updated when first + displayed. Which is the faster part.) (RETURN OBJ]) (MB.MARGINBAR.SELFN - [LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) - (* ; "Edited 12-Jun-90 18:59 by mitani") - (* ; - "Let the user adjust margins and tabs using the mouse.") + [LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) (* ; "Edited 12-Jun-90 18:59 by mitani") + (* ; + "Let the user adjust margins and tabs using the mouse.") (PROG [(OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) (IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) (IMAGEBOX OBJ STREAM 'DISPLAY] @@ -1662,19 +1623,18 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (TABS (fetch MARTABS of OBJDATUM)) [SCALEDTABS (COND ((LISTP (fetch MARTABS of OBJDATUM)) - (* ; - "Only scale the tabs if there are any, and they're not neutralized.") + (* ; + "Only scale the tabs if there are any, and they're not neutralized.") (for TAB in (fetch MARTABS of OBJDATUM) collect (MSCALE (fetch TABX of TAB) - (fetch MARUNIT of OBJDATUM] + (fetch MARUNIT of OBJDATUM] (UNIT (fetch MARUNIT of OBJDATUM)) (CLIP (create REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (fetch XSIZE of IMAGEBOX) HEIGHT _ (fetch YSIZE of IMAGEBOX))) - (RIGHTLIM (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL - SELWINDOW)) + (RIGHTLIM (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL SELWINDOW)) 4)) TAB TABX OL1 OLN OR) (SETQ OL1 L1) @@ -1688,20 +1648,20 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. BOTTOM _ 42 WIDTH _ 16 HEIGHT _ 16) - RELX RELY) (* ; "Move the 1st-line left margin.") + RELX RELY) (* ; "Move the 1st-line left margin.") (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) + (INSIDE? CLIP (LASTMOUSEX STREAM) + (LASTMOUSEY STREAM))) do (SETQ L1 (MAX 0 (MDESCALE (LASTMOUSEX STREAM) - UNIT))) - [COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right mouse button UNsets the margin.") - (SETQ L1 (MINUS L1] - (COND - ((NOT (EQUAL OL1 L1)) - (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) - (SETQ OL1 L1] + UNIT))) + [COND + ((\TEDIT.MOUSESTATE RIGHT) (* ; + "Right mouse button UNsets the margin.") + (SETQ L1 (MINUS L1] + (COND + ((NOT (EQUAL OL1 L1)) + (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) + (SETQ OL1 L1] [(INSIDE? (create REGION LEFT _ (IDIFFERENCE (MSCALE (ABS LN) UNIT) @@ -1709,27 +1669,27 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. BOTTOM _ 26 WIDTH _ 16 HEIGHT _ 16) - RELX RELY) (* ; "Move the skirt's left margin") + RELX RELY) (* ; "Move the skirt's left margin") (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) + (INSIDE? CLIP (LASTMOUSEX STREAM) + (LASTMOUSEY STREAM))) do (SETQ LN (MAX 0 (MDESCALE (LASTMOUSEX STREAM) - UNIT))) - [COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right mouse button UNsets the margin.") - (SETQ LN (MINUS LN] - (COND - ((NOT (EQUAL OLN LN)) - (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) - (SETQ OLN LN] + UNIT))) + [COND + ((\TEDIT.MOUSESTATE RIGHT) (* ; + "Right mouse button UNsets the margin.") + (SETQ LN (MINUS LN] + (COND + ((NOT (EQUAL OLN LN)) + (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) + (SETQ OLN LN] [(OR (INSIDE? (create REGION LEFT _ (IDIFFERENCE (IMIN (MSCALE (ABS R) UNIT) (fetch XSIZE of IMAGEBOX) (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL - SELWINDOW))) + SELWINDOW))) 16) BOTTOM _ 26 WIDTH _ 16 @@ -1737,60 +1697,57 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. RELX RELY) (AND (ZEROP (IABS (FIXR R))) (INSIDE? (create REGION - LEFT _ (IDIFFERENCE (IMIN (fetch XSIZE of - IMAGEBOX - ) + LEFT _ (IDIFFERENCE (IMIN (fetch XSIZE of IMAGEBOX) (fetch (REGION WIDTH) of (DSPCLIPPINGREGION - NIL SELWINDOW))) + NIL SELWINDOW))) 16) BOTTOM _ 26 WIDTH _ 16 HEIGHT _ 32) - RELX RELY))) (* ; "Move the right margin") + RELX RELY))) (* ; "Move the right margin") (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) + (INSIDE? CLIP (LASTMOUSEX STREAM) + (LASTMOUSEY STREAM))) do (SETQ R (MAX 0 (MDESCALE (LASTMOUSEX STREAM) - UNIT))) - [COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right mouse button UNsets the margin.") - (SETQ R (MINUS R] - (COND - ((NOT (EQUAL OR R)) - (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) - (SETQ OR R] + UNIT))) + [COND + ((\TEDIT.MOUSESTATE RIGHT) (* ; + "Right mouse button UNsets the margin.") + (SETQ R (MINUS R] + (COND + ((NOT (EQUAL OR R)) + (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) + (SETQ OR R] ((INSIDE? (create REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (fetch (REGION WIDTH) of CLIP) HEIGHT _ 16) - RELX RELY) (* ; "We're in the tab ruler region") + RELX RELY) (* ; "We're in the tab ruler region") (COND - ((MOUSESTATE LEFT) (* ; "MOVE a tab") + ((MOUSESTATE LEFT) (* ; "MOVE a tab") [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] (AND TAB (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB))) - [(MOUSESTATE MIDDLE) (* ; "ADD/CHANGE a tab") + [(MOUSESTATE MIDDLE) (* ; "ADD/CHANGE a tab") (COND ((EQ (fetch MARTABS of OBJDATUM) - 'NEUTRAL) (* ; - "The tabs used to be NEUTRAL. Clear the tab region, and start afresh.") + 'NEUTRAL) (* ; + "The tabs used to be NEUTRAL. Clear the tab region, and start afresh.") (replace MARTABS of OBJDATUM with NIL) - (* ; - "So we don't come this way again.") + (* ; "So we don't come this way again.") (DSPFILL (create REGION LEFT _ 2 BOTTOM _ 1 HEIGHT _ 8 WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL - SELWINDOW)) + SELWINDOW)) 4)) WHITESHADE - 'REPLACE SELWINDOW) (* ; - "Make the tab region look non-neutral, too, so that tabs look OK on it.") + 'REPLACE SELWINDOW) (* ; + "Make the tab region look non-neutral, too, so that tabs look OK on it.") )) (COND ((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS @@ -1802,15 +1759,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (ILEQ (LASTMOUSEX STREAM) (IPLUS TABX 2))) (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'ERASE) - (replace TABKIND of TAB with (OR (fetch MARTABTYPE - of OBJDATUM) - 'LEFT)) + (replace TABKIND of TAB with (OR (fetch MARTABTYPE of OBJDATUM) + 'LEFT)) (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'PAINT) (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB)) ([OR (NOT TAB) (NOT (EQP (fetch TABX of TAB) (MDESCALE (LASTMOUSEX STREAM) - UNIT] (* ; "Really create a new tab") + UNIT] (* ; "Really create a new tab") [SETQ TAB (create TAB TABX _ (MDESCALE (LASTMOUSEX STREAM) UNIT) @@ -1819,7 +1775,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ TABS (CONS TAB TABS)) (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'PAINT) (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB] - ((MOUSESTATE RIGHT) (* ; "DELETE a tab.") + ((MOUSESTATE RIGHT) (* ; "DELETE a tab.") (COND ((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] @@ -1838,7 +1794,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. T]) (MB.MARGINBAR.SIZEFN - [LAMBDA (OBJ) (* jds " 5-Sep-84 14:10") + [LAMBDA (OBJ) (* jds " 5-Sep-84 14:10") (PROG ((BOX (create IMAGEBOX XSIZE _ 1008 YSIZE _ 62 @@ -1848,9 +1804,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN BOX]) (MB.MARGINBAR.DISPLAYFN - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* Display the innards of a menu - button) + [LAMBDA (OBJ STREAM MODE) (* ; "Edited 12-Jun-90 18:59 by mitani") + (* Display the innards of a menu + button) (PROG ((IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) (IMAGEBOX OBJ STREAM MODE))) (OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) @@ -1860,16 +1816,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (COND [[SETQ WASON (SETQ BITMAP (IMAGEOBJPROP OBJ 'BITCACHE] - (* The marginbar existed already as an image. - Don't bother re-creating it, and remember that we're allowed to MODIFY the old - image instead of creating a new one.) + (* The marginbar existed already as an image. + Don't bother re-creating it, and remember that we're allowed to MODIFY the old + image instead of creating a new one.) (SETQ DS (IMAGEOBJPROP OBJ 'DSPCACHE] - (T (* Have to create an image for the - margin bar) + (T (* Have to create an image for the + margin bar) (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of IMAGEBOX) (fetch YSIZE of IMAGEBOX))) - (* Create a cache bitmap) + (* Create a cache bitmap) (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) (SETQ DS (DSPCREATE BITMAP)) (IMAGEOBJPROP OBJ 'DSPCACHE DS) @@ -1888,17 +1844,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (fetch (MARGINBAR MARUNIT) of OBJDATUM) (OR WASON (IMAGEOBJPROP OBJ 'NEEDSUPDATE NIL)) (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL STREAM))) - (* Update the image, if it needs it) + (* Update the image, if it needs it) (BITBLT BITMAP 0 0 STREAM (IDIFFERENCE (DSPXPOSITION NIL STREAM) 4) (IDIFFERENCE (DSPYPOSITION NIL STREAM) (fetch YDESC of IMAGEBOX]) (MDESCALE - [LAMBDA (VAL UNIT) (* jds " 4-NOV-83 17:29") - - (* Convert a value from screen offset units to marginbar units) - + [LAMBDA (VAL UNIT) (* jds " 4-NOV-83 17:29") + (* Convert a value from screen offset + units to marginbar units) (COND ((IEQP UNIT 12) (QUOTIENT (IQUOTIENT (LLSH (IDIFFERENCE VAL 4) @@ -1909,17 +1864,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. UNIT]) (MSCALE - [LAMBDA (VAL UNIT) (* jds " 4-NOV-83 17:31") + [LAMBDA (VAL UNIT) (* jds " 4-NOV-83 17:31") (* Convert from marginbar units to a  screen X offset) (IPLUS 4 (FIXR (TIMES VAL (OR UNIT 1]) (MB.MARGINBAR.SHOWTAB - [LAMBDA (W TAB UNIT MODE) (* jds "22-Mar-85 17:36") - - (* Paint/erase/otherwise display the sign for a TAB in window WINDOW, using - units UNIT) - + [LAMBDA (W TAB UNIT MODE) (* jds "22-Mar-85 17:36") + (* Paint/erase/otherwise display the + sign for a TAB in window WINDOW, using + units UNIT) (PROG ((TABX (MSCALE (fetch TABX of TAB) UNIT))) (SELECTQ (fetch TABKIND of TAB) @@ -1950,9 +1904,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NIL]) (MB.MARGINBAR.TABTRACK - [LAMBDA (STREAM OBJ TAB) (* jds " 8-Feb-84 20:38") - - (* Given that the mouse is down over a tab, track the tab as the mouse moves.) + [LAMBDA (STREAM OBJ TAB) (* jds " 8-Feb-84 20:38") + + (* Given that the mouse is down over a tab, track the tab as the mouse moves.) (PROG ((UNIT (fetch MARUNIT of OBJ)) (CLIP (DSPCLIPPINGREGION NIL STREAM)) @@ -1972,23 +1926,23 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ OLDX X]) (\TEDIT.TABTYPE.SET - [LAMBDA (OBJ SEL W) (* ; - "Edited 24-Apr-95 12:03 by sybalsky:mv:envos") - (* Change the kind of TAB that will - be set in the succeeding marginbar.) + [LAMBDA (OBJ SEL W) (* ; + "Edited 24-Apr-95 12:03 by sybalsky:mv:envos") + (* Change the kind of TAB that will be + set in the succeeding marginbar.) (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) STATE DOTTEDBUTTON) (SETQ STATE (IMAGEOBJPROP OBJ 'STATE)) (* Find out roughly what kind of TAB - this is to be.) + this is to be.) [SETQ STATE (U-CASE (COND ((LISTP STATE) (CAR STATE)) (T STATE] (* Make sure it's upper case, and an - atom.) + atom.) (SETQ DOTTEDBUTTON (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))) (* Find out if this is to be a tab - with a dotted leader.) + with a dotted leader.) [COND ((EQ (IMAGEOBJPROP DOTTEDBUTTON 'STATE) 'ON) (* Yes. Make this a DOTTEDxxx tab.) @@ -1996,23 +1950,22 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PC PCNO FNARG) (* Now run thru the rest of the document until we find the margin bar. - Replace the tab type of that margin bar with the new type.) + Replace the tab type of that margin bar with the new type.) (COND ((AND (IGREATERP CH# (CAR FNARG)) (fetch (PIECE POBJ) of PC) (type? MARGINBAR (fetch (PIECE POBJ) - of PC))) + of PC))) (replace MARTABTYPE of (IMAGEOBJPROP (fetch (PIECE POBJ) - of PC) - 'OBJECTDATUM) with - (CDR FNARG)) + of PC) + 'OBJECTDATUM) with (CDR FNARG)) 'STOP] (CONS CH# STATE]) (MARGINBAR.INIT - [LAMBDA NIL (* jds " 9-Feb-86 15:18") + [LAMBDA NIL (* jds " 9-Feb-86 15:18") (SETQ MARGINBARIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.MARGINBAR.DISPLAYFN) (FUNCTION MB.MARGINBAR.SIZEFN) (FUNCTION MB.MARGINBAR.PUTFN) @@ -2067,9 +2020,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TEXTMENU.START - [LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ; "Edited 26-Oct-2021 08:43 by rmk:") - (* ; - "Edited 4-Jun-93 11:59 by sybalsky:mv:envos") + [LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ; "Edited 26-Oct-2021 08:43 by rmk:") + (* ; + "Edited 4-Jun-93 11:59 by sybalsky:mv:envos") (* ;; "Create a TEdit-based menu for a given main window.") @@ -2083,13 +2036,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (COND ((AND MAINWINDOW (WINDOWPROP MAINWINDOW 'TEDITMENU)) (* ; - "This is a menu window. It can't have a menu, so bail out.") + "This is a menu window. It can't have a menu, so bail out.") (RETURN)) ([AND MAINWINDOW (for WW in (ATTACHEDWINDOWS MAINWINDOW) thereis (EQUAL (OR TITLE "TEdit Menu") - (WINDOWPROP WW 'TEDITMENU] + (WINDOWPROP WW 'TEDITMENU] (* ; - "If this main window already has a menu, don't add another.") + "If this main window already has a menu, don't add another.") (RETURN))) (SETQ MENUW (CREATEW (SETQ WREG (COND (MAINWINDOW (create REGION @@ -2104,21 +2057,19 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (OR TITLE "TEdit Menu"))) (WINDOWADDPROP MENUW 'CLOSEFN 'TEXTMENU.CLOSEFN) (WINDOWPROP MENUW 'TEDITMENU (OR TITLE "TEdit Menu")) - (* ; - "Mark this as a TEDIT MENU window") + (* ; "Mark this as a TEDIT MENU window") (ATTACHWINDOW MENUW MAINWINDOW 'TOP 'JUSTIFY 'LOCALCLOSE) [SETQ HEIGHT (FETCH (REGION HEIGHT) OF (WINDOWPROP MENUW 'REGION] (WINDOWPROP MENUW 'MAXSIZE (CONS 64000 HEIGHT)) (WINDOWPROP MENUW 'MINSIZE (CONS 0 HEIGHT)) (SETQ MENUTEXT MENU) - (replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - with T) + (replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T) [AND MAINWINDOW (WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW] - [TEDIT MENUTEXT MENUW NIL (LIST 'TITLEMENUFN 'DON'T 'PROMPTWINDOW (fetch (TEXTOBJ - PROMPTWINDOW) - of (TEXTOBJ - MAINWINDOW - ] + [TEDIT MENUTEXT MENUW NIL (LIST 'TITLEMENUFN 'DON'T 'PROMPTWINDOW (fetch (TEXTOBJ + PROMPTWINDOW + ) + of (TEXTOBJ MAINWINDOW + ] (AND MAINWINDOW (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS]) (\TEXTMENU.DOC.CREATE @@ -2260,41 +2211,39 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN MENUTEXT]) (TEXTMENU.CLOSEFN - [LAMBDA (W) (* ; "Edited 12-Jun-90 18:59 by mitani") + [LAMBDA (W) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* ;; "CLOSE a TEdit menu window: Detach the menu, then reshape the remaining windows to take up the remaining space") + (* ;; "CLOSE a TEdit menu window: Detach the menu, then reshape the remaining windows to take up the remaining space") (PROG ((MAINW (WINDOWPROP W 'MAINWINDOW)) TEXTOBJ HEIGHT OHEIGHT OBOTTOM WBOTTOM WINDOWS) - (FREEATTACHEDWINDOW W) (* (DETACHWINDOW W) - (* ; "So detach this window.") - (COND ((IGREATERP (FLENGTH - (ATTACHEDWINDOWS MAINW)) 1) - (SETQ OHEIGHT (fetch - (REGION HEIGHT) of - (WINDOWPROP W (QUOTE REGION)))) - (SETQ OBOTTOM (fetch - (REGION BOTTOM) of - (WINDOWPROP W (QUOTE REGION)))) - (CLOSEW W) (SETQ WINDOWS - (SORT (ATTACHEDWINDOWS MAINW) - (FUNCTION (LAMBDA (WW) - (fetch (REGION BOTTOM) of - (WINDOWPROP WW (QUOTE REGION))))))) - (for WW in WINDOWS when - (IGEQ (SETQ WBOTTOM - (fetch (REGION BOTTOM) of - (WINDOWPROP WW (QUOTE REGION)))) - OBOTTOM) do (MOVEW WW - (fetch (REGION LEFT) of - (WINDOWPROP WW (QUOTE REGION))) - (IDIFFERENCE WBOTTOM OHEIGHT)))))) + (FREEATTACHEDWINDOW W) (* (DETACHWINDOW W) (* ; + "So detach this window.") + (COND ((IGREATERP (FLENGTH + (ATTACHEDWINDOWS MAINW)) 1) + (SETQ OHEIGHT (fetch + (REGION HEIGHT) of (WINDOWPROP W + (QUOTE REGION)))) (SETQ OBOTTOM + (fetch (REGION BOTTOM) of + (WINDOWPROP W (QUOTE REGION)))) + (CLOSEW W) (SETQ WINDOWS + (SORT (ATTACHEDWINDOWS MAINW) + (FUNCTION (LAMBDA (WW) + (fetch (REGION BOTTOM) of + (WINDOWPROP WW (QUOTE REGION))))))) + (for WW in WINDOWS when + (IGEQ (SETQ WBOTTOM (fetch + (REGION BOTTOM) of (WINDOWPROP WW + (QUOTE REGION)))) OBOTTOM) do + (MOVEW WW (fetch (REGION LEFT) of + (WINDOWPROP WW (QUOTE REGION))) + (IDIFFERENCE WBOTTOM OHEIGHT)))))) (COND - ((SETQ TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (* ; - "Then, if this window still has a textobj under it, kill off that edit process.") + ((SETQ TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (* ; + "Then, if this window still has a textobj under it, kill off that edit process.") (TEDIT.KILL TEXTOBJ) - (* ;; "This has to be TEDIT.KILL to avoid problems with the TTY being handed from main back to menu, causing main never to finish off; menu would quit and hand TTY to top level window.") + (* ;; "This has to be TEDIT.KILL to avoid problems with the TTY being handed from main back to menu, causing main never to finish off; menu would quit and hand TTY to top level window.") ]) ) @@ -2312,7 +2261,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TEDITMENU.CREATE - [LAMBDA NIL (* gbn "27-Sep-84 01:04") + [LAMBDA NIL (* gbn "27-Sep-84 01:04") (* Creates the TEdit Expanded Menu) (SETQ TEDIT.EXPANDED.MENU (\TEXTMENU.DOC.CREATE TEDIT.EXPANDEDMENU.SPEC]) @@ -2330,9 +2279,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (\TEXTMENU.SET.TOGGLE "Unformatted" 'ON CHARMENUTEXTSTREAM]) (MB.DEFAULTBUTTON.FN - [LAMBDA (OBJ SEL W) (* ; "Edited 30-Mar-94 15:46 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 30-Mar-94 15:46 by jds") (* ; - "MBFN for TEdit default menu item buttons.") + "MBFN for TEdit default menu item buttons.") (PROG* ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'TEXTOBJ)) @@ -2354,12 +2303,12 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((AND (SETQ PROC (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'PROCESS)) (PROCESSP PROC)) (* ; - "THE MAIN window has a live process behind it; go evaluate the button fn there.") + "THE MAIN window has a live process behind it; go evaluate the button fn there.") (PROCESS.EVAL PROC (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL ))) ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) (* ; - "This window has a live process behind it; go evaluate the button fn there.") + "This window has a live process behind it; go evaluate the button fn there.") (PROCESS.EVAL PROC (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL ))) (T (ADD.PROCESS (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL] @@ -2371,7 +2320,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((OR (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) (EQ (WINDOWPROP W 'PROCESS) (TTY.PROCESS))) (* ; - "If the TEDIT MENU still has the tty, give it back to the real TEdit.") + "If the TEDIT MENU still has the tty, give it back to the real TEdit.") (SETQ TEDIT.SELPENDING NIL) (GIVE.TTY.PROCESS (WINDOWPROP W 'MAINWINDOW] @@ -2380,7 +2329,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (RETURN 'DON'T]) (\TEDITMENU.RECORD.UNFORMATTED - [LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* jds " 7-Feb-85 09:44") + [LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* jds " 7-Feb-85 09:44") (PROG ((FLG (COND ((EQ NEWSTATE 'ON) T) @@ -2389,9 +2338,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (TEXTPROP TEXTOBJ 'UNFORMATTEDPUT/GET FLG]) (MB.DEFAULTBUTTON.ACTIONFN - [LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* ; "Edited 30-Mar-94 16:04 by jds") + [LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* ; "Edited 30-Mar-94 16:04 by jds") (* ; - "MBFN for TEdit default menu item buttons.") + "MBFN for TEdit default menu item buttons.") (PROG (OFILE CH %#COPIES PRINTHOST PRINTOPTIONS %#SIDES MSG) [ERSETQ (RESETLST [RESETSAVE (\TEDIT.MARKACTIVE MAINTEXT) @@ -2401,27 +2350,26 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. [RESETSAVE (PROG1 OBJ (IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T)) '(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL] - (replace (TEXTOBJ EDITOPACTIVE) of MAINTEXT - with (OR (IMAGEOBJPROP OBJ 'MBTEXT) - T)) (* ; - "So we can tell the guy WHAT op is active.") + (replace (TEXTOBJ EDITOPACTIVE) of MAINTEXT with (OR (IMAGEOBJPROP OBJ + 'MBTEXT) + T)) + (* ; + "So we can tell the guy WHAT op is active.") (SELECTQ (IMAGEOBJPROP OBJ 'MBTEXT) (Put [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) - of SEL] + (fetch (SELECTION CH#) of SEL] [COND (OFILE (* ; - "Only try this if he really typed a file name") + "Only try this if he really typed a file name") (TEDIT.PUT MAINTEXT OFILE NIL (TEXTPROP TEXTOBJ 'UNFORMATTEDPUT/GET]) (Get [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) - of SEL] + (fetch (SELECTION CH#) of SEL] [COND (OFILE (* ; - "Only try this if he really typed a file name") + "Only try this if he really typed a file name") (TEDIT.GET MAINTEXT OFILE (TEXTPROP TEXTOBJ 'UNFORMATTEDPUT/GET]) (Include [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT @@ -2430,13 +2378,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. of SEL] (COND (OFILE (TEDIT.INCLUDE MAINTEXT OFILE)))) - (Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) of SEL))) + (Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (fetch (SELECTION + CH#) + of SEL))) [COND ((ZEROP (NCHARS OFILE)) (* ; "NOTHING--HE HIT DEL.") ) (OFILE (* ; - "There's something to do. Go do it.") + "There's something to do. Go do it.") (TEDIT.PROMPTPRINT MAINTEXT "Searching..." T) [SETQ CH (CAR (ERSETQ (TEDIT.FIND MAINTEXT OFILE NIL NIL T] (COND @@ -2446,19 +2395,19 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (replace (SELECTION CH#) of MAINSEL with (CAR CH)) (* ; - "Set up SELECTION to be the found text") + "Set up SELECTION to be the found text") (replace (SELECTION CHLIM) of MAINSEL with (ADD1 (CADR CH))) [replace (SELECTION DCH) of MAINSEL with (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] + (CAR CH] (replace (SELECTION POINT) of MAINSEL with 'RIGHT) (replace (TEXTOBJ CARETLOOKS) of MAINTEXT with (\TEDIT.GET.INSERT.CHARLOOKS MAINTEXT - MAINSEL)) + MAINSEL)) (* ; - "Set the caret looks to match those of the new selection") + "Set the caret looks to match those of the new selection") (TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL) (* ; "And never pending a deletion.") (\FIXSEL MAINSEL MAINTEXT) @@ -2473,18 +2422,17 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. TEXTOBJ (fetch (SELECTION CHLIM) of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + of TEXTOBJ] CONFIRM? KEEPLOOKS? LOC) [SETQ LOC (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CHLIM) of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + of TEXTOBJ] [SETQ CONFIRM? (EQ 'ON (IMAGEOBJPROP (CAR LOC) 'STATE] - [SETQ LOC (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (ADD1 (CDR LOC] + [SETQ LOC (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ + (ADD1 (CDR LOC] [SETQ KEEPLOOKS? (EQ 'ON (IMAGEOBJPROP (CAR LOC) 'STATE] (COND @@ -2492,27 +2440,25 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (* ; "NOTHING--HE HIT DEL.") ) (PATTERN (* ; - "There's something to do. Go do it.") + "There's something to do. Go do it.") [COND (KEEPLOOKS? (SETQ REPLACEMENT - ( - MBUTTON.NEXT.FIELD.AS.PIECES + (MBUTTON.NEXT.FIELD.AS.PIECES TEXTOBJ SAVECH#] (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.SUBSTITUTE (fetch (TEXTOBJ - STREAMHINT) + (TEDIT.SUBSTITUTE (fetch (TEXTOBJ + STREAMHINT + ) of MAINTEXT) PATTERN REPLACEMENT CONFIRM?))]) (Quit (* ; "He wants to QUIT the edit.") (COND ((\TEDIT.QUIT (\TEDIT.PRIMARYW MAINTEXT) T) - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ - with T)))) + (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T)))) (Page% Layout (* ; "Page layout menu") - (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU - T) + (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) (\TEDIT.PRIMARYW MAINTEXT) "Page Layout Menu" (HEIGHTIFWINDOW 135 5))) @@ -2528,39 +2474,36 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (replace (SELECTION CH#) of MAINSEL with 1) (replace (SELECTION CHLIM) of MAINSEL with (ADD1 (fetch (TEXTOBJ TEXTLEN) of MAINTEXT))) - (replace (SELECTION DCH) of MAINSEL - with (fetch (TEXTOBJ TEXTLEN) of MAINTEXT)) - (replace (SELECTION POINT) of MAINSEL with - 'LEFT) + (replace (SELECTION DCH) of MAINSEL with (fetch (TEXTOBJ TEXTLEN) + of MAINTEXT)) + (replace (SELECTION POINT) of MAINSEL with 'LEFT) (replace (SELECTION SET) of MAINSEL with T) (\FIXSEL MAINSEL MAINTEXT) (\SHOWSEL MAINSEL NIL T)))) - (Hardcopy [SETQ PRINTHOST (\TEDIT.MAKEFILENAME ( - MBUTTON.NEXT.FIELD.AS.TEXT + (Hardcopy [SETQ PRINTHOST (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION - CH#) + (fetch (SELECTION CH#) of SEL] (COND ((NOT PRINTHOST) (* ; - "If he didn't specify a particular host, defer to his defaults.") + "If he didn't specify a particular host, defer to his defaults.") (TEDIT.PROMPTPRINT MAINTEXT "Using default print server."))) [SETQ %#COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ - (fetch (SELECTION CH#) - of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + (fetch (SELECTION CH#) of (fetch (TEXTOBJ + SCRATCHSEL + ) + of TEXTOBJ] (* ; - "Grab the field that specifies number of copies.") + "Grab the field that specifies number of copies.") [COND (%#COPIES (SETQ PRINTOPTIONS (LIST '%#COPIES %#COPIES] (SETQ %#SIDES (SELECTQ (IMAGEOBJPROP [CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CHLIM) - of (fetch (TEXTOBJ - SCRATCHSEL) - of TEXTOBJ] + of (fetch (TEXTOBJ SCRATCHSEL) + of TEXTOBJ] 'STATE) (One% Side 1) (Duplex 2) @@ -2571,21 +2514,19 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. [SETQ MSG (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (fetch (SELECTION CH#) - of (fetch (TEXTOBJ - SCRATCHSEL) - of TEXTOBJ] + of (fetch (TEXTOBJ SCRATCHSEL) + of TEXTOBJ] [COND (MSG (push PRINTOPTIONS MSG) (push PRINTOPTIONS 'MESSAGE] (TEDIT.HARDCOPY MAINTEXT NIL NIL NIL PRINTHOST PRINTOPTIONS)) (ERROR)))] - (replace (SELECTION SET) of SEL with T)(* ; - "Now turn the menu button highlighting off.") + (replace (SELECTION SET) of SEL with T) (* ; + "Now turn the menu button highlighting off.") (replace (SELECTION ONFLG) of SEL with T) (\SHOWSEL SEL NIL NIL) - (replace (SELECTION SET) of SEL with NIL) - (* ; - "And forget that anything is selected.") + (replace (SELECTION SET) of SEL with NIL) (* ; + "And forget that anything is selected.") ]) ) (DEFINEQ @@ -2593,7 +2534,6 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (\TEDIT.CHARLOOKSMENU.CREATE [LAMBDA NIL (* ; "Edited 20-Aug-87 16:50 by jds") (* ; "Creates the TEdit Expanded Menu") - (SETQ TEDIT.CHARLOOKS.MENU (\TEXTMENU.DOC.CREATE (APPEND (LIST (create MB.BUTTON MBLABEL _ 'APPLY MBBUTTONEVENTFN _ @@ -2609,6 +2549,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (create MB.BUTTON MBLABEL _ 'NEUTRAL MBBUTTONEVENTFN _ + ' \TEDIT.NEUTRALIZE.CHARLOOKS ) @@ -2619,8 +2560,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (\TEDIT.EXPANDEDCHARLOOKS.MENU [LAMBDA (STREAM) (* ; "Edited 20-Aug-87 16:49 by jds") - - (* ;; "Open a character-looks menu.") + + (* ;; "Open a character-looks menu.") (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.CHARLOOKS.MENU T) (\TEDIT.PRIMARYW STREAM) @@ -2628,16 +2569,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (HEIGHTIFWINDOW 68 T]) (\TEDIT.APPLY.BOLDNESS - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:55") + [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:55") (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) (ON (CONS 'WEIGHT (CONS 'BOLD NEWLOOKS))) (OFF (CONS 'WEIGHT (CONS 'MEDIUM NEWLOOKS))) NEWLOOKS]) (\TEDIT.APPLY.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:17 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:17 by jds") (* MBFN for TEdit default menu item - buttons.) + buttons.) (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'TEXTOBJ)) @@ -2649,26 +2590,25 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (* And over the NEUTRAL button.) (SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ CH#)) (* Now Parse the menu, to give us a - looks spec.) - (TEDIT.LOOKS MAINTEXT NEWLOOKS (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) - of MAINTEXT)) + looks spec.) + (TEDIT.LOOKS MAINTEXT NEWLOOKS (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of MAINTEXT)) (fetch (SELECTION DCH) of (fetch (TEXTOBJ SEL) of MAINTEXT))) (* Make the change in looks) (\SHOWSEL SEL NIL NIL) (* And turn off the APPLY button.) (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'PROCESS)) (* Leave him typing in the real - document) + document) ]) (\TEDIT.APPLY.OLINE - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") + [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) (ON (CONS 'OVERLINE (CONS 'ON NEWLOOKS))) (OFF (CONS 'OVERLINE (CONS 'OFF NEWLOOKS))) NEWLOOKS]) (\TEDIT.SHOW.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:17 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:17 by jds") (* ;; "Set the CHARLOOKS menu from the looks of the currently selected character.") @@ -2687,21 +2627,19 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (replace (SELECTION SET) of SEL with NIL) (SETQ PC (\CHTOPC MAINCH# (fetch (TEXTOBJ PCTB) of MAINTEXT))) (* ; - "The PIECE containing the text to describe") - (SETQ NEWLOOKS (fetch (PIECE PLOOKS) of PC)) - (* ; - "Get the looks for those characters.") - (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ CH# - NEWLOOKS)) - (* ; - "Fill in the menu blanks with that info") + "The PIECE containing the text to describe") + (SETQ NEWLOOKS (fetch (PIECE PLOOKS) of PC)) (* ; + "Get the looks for those characters.") + (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ CH# NEWLOOKS + )) (* ; + "Fill in the menu blanks with that info") ]) (\TEDIT.NEUTRALIZE.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:18 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:18 by jds") (* Handle the NEUTRAL button on a character looks menu. - Sets all the menu settings neutral.) + Sets all the menu settings neutral.) (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) @@ -2710,13 +2648,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. PC SCRATCHSEL OFILE CH NEWLOOKS NEXTB BUTTON TEXT OFFSET) (\SHOWSEL SEL NIL NIL) (replace (SELECTION SET) of SEL with NIL) - (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU TEXTOBJ CH#) (* Fill in the menu blanks with that - info) + (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU TEXTOBJ CH#) (* Fill in the menu blanks with that + info) (TEDIT.UPDATE.SCREEN TEXTOBJ) (* And update the screen image.) ]) (\TEDIT.FILL.IN.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "Edited 30-May-91 22:28 by jds") + [LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "Edited 30-May-91 22:28 by jds") (* ;; "Given a TEXTOBJ describing a charlooks menu, the CH# of the start of the charlooks menu, and a set of looks, fill in the menu fields.") @@ -2727,88 +2665,79 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) [for PROP in (LIST (fetch (CHARLOOKS CLBOLD) of NEWLOOKS) - (fetch (CHARLOOKS CLITAL) of NEWLOOKS) - (fetch (CHARLOOKS CLULINE) of NEWLOOKS) - (fetch (CHARLOOKS CLSTRIKE) of NEWLOOKS) - (fetch (CHARLOOKS CLOLINE) of NEWLOOKS)) + (fetch (CHARLOOKS CLITAL) of NEWLOOKS) + (fetch (CHARLOOKS CLULINE) of NEWLOOKS) + (fetch (CHARLOOKS CLSTRIKE) of NEWLOOKS) + (fetch (CHARLOOKS CLOLINE) of NEWLOOKS)) do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - [COND - (PROP (* ; "Must set the property") - (IMAGEOBJPROP (CAR NEXTB) - 'STATE - 'ON)) - (T (* ; "Must reset it.") + [COND + (PROP (* ; "Must set the property") (IMAGEOBJPROP (CAR NEXTB) 'STATE - 'OFF] - (SETQ CH# (ADD1 (CDR NEXTB] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (* ; "Get to the start of the text.") + 'ON)) + (T (* ; "Must reset it.") + (IMAGEOBJPROP (CAR NEXTB) + 'STATE + 'OFF] + (SETQ CH# (ADD1 (CDR NEXTB] + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))(* ; "Get to the start of the text.") (SETQ BUTTON (CAR NEXTB)) [for ITEM in (IMAGEOBJPROP BUTTON 'BUTTONS) - do (* ; - "Loop thru the font FAMILY name button list, looking for one that matches this text's looks") - (COND - ((STRING-EQUAL [COND - ((AND (type? FONTCLASS (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - (NEQ (fetch FONTCLASSNAME - of (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - 'DEFAULTFONT)) - (CONCAT (fetch FONTCLASSNAME of (fetch - (CHARLOOKS CLFONT) - of NEWLOOKS)) - '-class)) - ((FONTP (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) - (FONTPROP (fetch (CHARLOOKS CLFONT) of NEWLOOKS) - 'FAMILY] - ITEM) - (IMAGEOBJPROP BUTTON 'STATE ITEM) - (RETURN))) finally (* ; - "This font wasn't found in the list. Add it.") - [MB.NWAYBUTTON.ADDITEM - BUTTON - (COND - ((type? FONTCLASS (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - (PACK* (fetch FONTCLASSNAME - of (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - '-class)) - ((FONTP (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) - (FONTPROP (fetch (CHARLOOKS CLFONT) of NEWLOOKS) - 'FAMILY] (* ; - "Add this family to the list of items") - (IMAGEOBJPROP BUTTON 'STATE (U-CASE - (FONTPROP (fetch - (CHARLOOKS CLFONT) - of NEWLOOKS) - 'FAMILY] + do (* ; + "Loop thru the font FAMILY name button list, looking for one that matches this text's looks") + (COND + ((STRING-EQUAL [COND + ((AND (type? FONTCLASS (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) + (NEQ (fetch FONTCLASSNAME of (fetch (CHARLOOKS CLFONT) + of NEWLOOKS)) + 'DEFAULTFONT)) + (CONCAT (fetch FONTCLASSNAME of (fetch (CHARLOOKS CLFONT) + of NEWLOOKS)) + '-class)) + ((FONTP (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) + (FONTPROP (fetch (CHARLOOKS CLFONT) of NEWLOOKS) + 'FAMILY] + ITEM) + (IMAGEOBJPROP BUTTON 'STATE ITEM) + (RETURN))) finally (* ; + "This font wasn't found in the list. Add it.") + [MB.NWAYBUTTON.ADDITEM BUTTON + (COND + ((type? FONTCLASS (fetch (CHARLOOKS CLFONT) + of NEWLOOKS)) + (PACK* (fetch FONTCLASSNAME + of (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) + '-class)) + ((FONTP (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) + (FONTPROP (fetch (CHARLOOKS CLFONT) of NEWLOOKS) + 'FAMILY] (* ; - "Now find which text button was 'on'") + "Add this family to the list of items") + (IMAGEOBJPROP BUTTON 'STATE (U-CASE (FONTPROP + (fetch (CHARLOOKS CLFONT) + of NEWLOOKS) + 'FAMILY] + (* ; + "Now find which text button was 'on'") (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - NIL) (* ; - "Clean out the 'other font' field") + NIL) (* ; "Clean out the 'other font' field") (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (fetch (CHARLOOKS CLSIZE) of NEWLOOKS)) - (* ; "Set the value in the SIZE field") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + (fetch (CHARLOOKS CLSIZE) of NEWLOOKS)) (* ; "Set the value in the SIZE field") + [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] (* ; - "Move forward to the SUPERSCRIPT/SUBSCRIPT button") + "Move forward to the SUPERSCRIPT/SUBSCRIPT button") (SETQ BUTTON (CAR NEXTB)) (SETQ OFFSET (fetch (CHARLOOKS CLOFFSET) of NEWLOOKS)) (* ; - "Remember the offset value for later") + "Remember the offset value for later") [COND ((OR (NOT (fetch (CHARLOOKS CLOFFSET) of NEWLOOKS)) (ZEROP (fetch (CHARLOOKS CLOFFSET) of NEWLOOKS))) (* ; - "There is no subscript or superscript. Mark the text NORMAL.") + "There is no subscript or superscript. Mark the text NORMAL.") (IMAGEOBJPROP BUTTON 'STATE 'Normal) (SETQ OFFSET NIL) (* ; - "Mark there as being no offset value") + "Mark there as being no offset value") ) ((ILESSP OFFSET 0) (* ; "SUBSCRIPTING") (IMAGEOBJPROP BUTTON 'STATE 'Subscript)) @@ -2816,113 +2745,108 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (IMAGEOBJPROP BUTTON 'STATE 'Superscript] (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) (AND OFFSET (IABS OFFSET))) (* ; - "Now move up to the offset distance fill-in field.") + "Now move up to the offset distance fill-in field.") (\SHOWSEL SCRATCHSEL NIL NIL) (replace (SELECTION SET) of SCRATCHSEL with NIL) (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL]) (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-May-91 22:18 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-May-91 22:18 by jds") (* ;; -"Set all the fields in the CHARLOOKS menu specified by TEXTOBJ, starting at CH# to neutral values.") + "Set all the fields in the CHARLOOKS menu specified by TEXTOBJ, starting at CH# to neutral values.") (PROG ((SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) PC OFILE CH NEXTB BUTTON TEXT OFFSET) (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL [for PROP in '(BOLD ITAL ULINE STRIKE OLINE) - do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ CH#)) - (IMAGEOBJPROP (CAR NEXTB) - 'STATE - 'NEUTRAL) - (SETQ CH# (ADD1 (CDR NEXTB] + do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH# + )) + (IMAGEOBJPROP (CAR NEXTB) + 'STATE + 'NEUTRAL) + (SETQ CH# (ADD1 (CDR NEXTB] (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) (* ; "Get to the start of the text.") (SETQ BUTTON (CAR NEXTB)) (IMAGEOBJPROP BUTTON 'STATE NIL) (* ; - "Now find which text button was 'on'") + "Now find which text button was 'on'") (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - NIL) (* ; - "Clean out the 'other font' field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + NIL) (* ; "Clean out the 'other font' field") + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL) (* ; "Set the value in the SIZE field") [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + of SCRATCHSEL] (* ; - "Move forward to the SUPERSCRIPT/SUBSCRIPT button") + "Move forward to the SUPERSCRIPT/SUBSCRIPT button") (SETQ BUTTON (CAR NEXTB)) (* ; - "Remember the offset value for later") + "Remember the offset value for later") (IMAGEOBJPROP BUTTON 'STATE NIL) (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) NIL) (* ; - "Now move up to the offset distance fill-in field.") + "Now move up to the offset distance fill-in field.") ]) (\TEDIT.PARSE.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-May-91 22:18 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-May-91 22:18 by jds") (* MBFN for TEdit default menu item - buttons.) + buttons.) (PROG (SCRATCHSEL CH NEWLOOKS SIZE SUPER SUB NEXTB BUTTON TEXT OFFSET) (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) [for BUTTON in '(BOLD ITALIC UNDERLINE STRIKEOUT OVERSCORE) - do (* Set the character properties - which are independent) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SELECTQ BUTTON - (BOLD (SETQ NEWLOOKS (\TEDIT.APPLY.BOLDNESS (CAR NEXTB) - NEWLOOKS))) - (ITALIC (SETQ NEWLOOKS (\TEDIT.APPLY.SLOPE (CAR NEXTB) + do (* Set the character properties which + are independent) + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) + (SELECTQ BUTTON + (BOLD (SETQ NEWLOOKS (\TEDIT.APPLY.BOLDNESS (CAR NEXTB) + NEWLOOKS))) + (ITALIC (SETQ NEWLOOKS (\TEDIT.APPLY.SLOPE (CAR NEXTB) + NEWLOOKS))) + (UNDERLINE (SETQ NEWLOOKS (\TEDIT.APPLY.ULINE (CAR NEXTB) NEWLOOKS))) - (UNDERLINE (SETQ NEWLOOKS (\TEDIT.APPLY.ULINE (CAR NEXTB) - NEWLOOKS))) - (STRIKEOUT (SETQ NEWLOOKS (\TEDIT.APPLY.STRIKEOUT (CAR NEXTB) - NEWLOOKS))) - (OVERSCORE (SETQ NEWLOOKS (\TEDIT.APPLY.OLINE (CAR NEXTB) - NEWLOOKS))) - NIL) - (SETQ CH# (ADD1 (CDR NEXTB] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (* Get to the start of the text.) + (STRIKEOUT (SETQ NEWLOOKS (\TEDIT.APPLY.STRIKEOUT (CAR NEXTB) + NEWLOOKS))) + (OVERSCORE (SETQ NEWLOOKS (\TEDIT.APPLY.OLINE (CAR NEXTB) + NEWLOOKS))) + NIL) + (SETQ CH# (ADD1 (CDR NEXTB] + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))(* Get to the start of the text.) (SETQ BUTTON (CAR NEXTB)) [AND BUTTON (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (Other (* Have to get and add in a new - font.) + (Other (* Have to get and add in a new font.) (COND ([SETQ TEXT (MBUTTON.NEXT.FIELD.AS.ATOM TEXTOBJ (ADD1 (CDR NEXTB] - (* He wants some font not on the - list. Add it to the list.) + (* He wants some font not on the list. + Add it to the list.) (SETQ NEWLOOKS (CONS 'FAMILY (CONS (U-CASE TEXT) NEWLOOKS))) (COND ([NOT (FMEMB (U-CASE TEXT) (U-CASE (IMAGEOBJPROP BUTTON 'BUTTONS] (* This font name isn't in the list - already; add it.) + already; add it.) (MB.NWAYBUTTON.ADDITEM BUTTON TEXT) (IMAGEOBJPROP BUTTON 'STATE TEXT)) (T [IMAGEOBJPROP BUTTON 'STATE (for NAME in (IMAGEOBJPROP BUTTON - 'BUTTONS) + 'BUTTONS) suchthat (EQ (U-CASE TEXT) - (U-CASE NAME] + (U-CASE NAME] (* Select the newly-specified font.) )) (TEDIT.DELETE TEXTOBJ SCRATCHSEL) - (* Delete the new font's name from - the fill-in field.) + (* Delete the new font's name from the + fill-in field.) (TEDIT.OBJECT.CHANGED TEXTOBJ BUTTON)) (T (* He didn't specify a font. - Complain but keep on.) + Complain but keep on.) (TEDIT.PROMPTPRINT TEXTOBJ "'Other' font not specified; no change made." T)))) (COND ((STRPOS '-class (IMAGEOBJPROP BUTTON 'STATE)) (* It's a font class. - Grab the name and evaluate it.) + Grab the name and evaluate it.) (SETQ NEWLOOKS (CONS 'FONT (CONS [EVAL (MKATOM (SUBSTRING (IMAGEOBJPROP BUTTON 'STATE) 1 @@ -2935,63 +2859,61 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (T (SETQ NEWLOOKS (CONS 'FAMILY (CONS (U-CASE (IMAGEOBJPROP BUTTON 'STATE)) NEWLOOKS))) (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) - (* Skip over the "other text" - fill-in.) + (* Skip over the "other text" fill-in.) ] (* Now find which text button was "on") - [SETQ SIZE (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - (* Read the contents of the SIZE - menu field) + [SETQ SIZE (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL + ] + (* Read the contents of the SIZE menu + field) [COND (SIZE (* He specified one. - Set it.) + Set it.) (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] (* Get a handle on the - SUPERSCRIPT/SUBSCRIPT button) + SUPERSCRIPT/SUBSCRIPT button) (SETQ BUTTON (CAR NEXTB)) (SETQ SUPER (IMAGEOBJPROP BUTTON 'STATE)) (* Decide which kind it is) [SETQ OFFSET (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (CDR NEXTB] (* And get the offset distance, in - points.) + points.) (SELECTQ SUPER (Superscript - (* He called for SUPERSCRIPTing. Offset the characters by either the distance - he gave, or 2 pts.) + (* He called for SUPERSCRIPTing. Offset the characters by either the distance he + gave, or 2 pts.) (SETQ NEWLOOKS (CONS 'SUPERSCRIPT (CONS (OR OFFSET 2) NEWLOOKS)))) (Subscript (* He called for SUBSCRIPTING. Offset the characters by either the distance he - gave, or 2 pts if he gave no distance.) + gave, or 2 pts if he gave no distance.) (SETQ NEWLOOKS (CONS 'SUBSCRIPT (CONS (OR OFFSET 2) NEWLOOKS)))) (Normal (* NORMAL => Turn off all super and - subscripting) + subscripting) (SETQ NEWLOOKS (CONS 'SUPERSCRIPT (CONS 0 NEWLOOKS)))) NIL) (RETURN NEWLOOKS]) (\TEDIT.APPLY.SLOPE - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") + [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) (ON (CONS 'SLOPE (CONS 'ITALIC NEWLOOKS))) (OFF (CONS 'SLOPE (CONS 'REGULAR NEWLOOKS))) NEWLOOKS]) (\TEDIT.APPLY.STRIKEOUT - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") + [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) (ON (CONS 'STRIKEOUT (CONS 'ON NEWLOOKS))) (OFF (CONS 'STRIKEOUT (CONS 'OFF NEWLOOKS))) NEWLOOKS]) (\TEDIT.APPLY.ULINE - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") + [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) (ON (CONS 'UNDERLINE (CONS 'ON NEWLOOKS))) (OFF (CONS 'UNDERLINE (CONS 'OFF NEWLOOKS))) @@ -3000,21 +2922,20 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TEDITPARAMENU.CREATE - [LAMBDA NIL (* jds " 2-Aug-84 15:32") + [LAMBDA NIL (* jds " 2-Aug-84 15:32") (* Creates the TEdit Expanded  Paragraph Menu) (SETQ TEDIT.EXPANDEDPARA.MENU (\TEXTMENU.DOC.CREATE TEDIT.PARAMENU.SPEC]) (\TEDIT.EXPANDEDPARA.MENU [LAMBDA (STREAM) (* ; "Edited 20-Aug-87 16:51 by jds") - (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDEDPARA.MENU T) (\TEDIT.PRIMARYW (TEXTOBJ STREAM)) "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T]) (\TEDIT.APPLY.PARALOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 22-Apr-93 16:45 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 22-Apr-93 16:45 by jds") (* ;; "Handler for the Paragraph Menu's APPLY button. Collects the specs from the paragraph menu and calls TEDIT.PARALOOKS to effect the change.") @@ -3030,10 +2951,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (* ; "and the NEUTRAL button.") (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) (SETQ NEWLOOKS NIL) (* ; - "The list we'll be collecting the looks changes in.") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (* ; - "Get the JUSTIFICATION button: Left/Right/Centered/Justified") + "The list we'll be collecting the looks changes in.") + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))(* ; + "Get the JUSTIFICATION button: Left/Right/Centered/Justified") (SETQ BUTTON (CAR NEXTB)) [COND ((AND (SETQ QUAD (IMAGEOBJPROP BUTTON 'STATE)) @@ -3045,8 +2965,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ BUTTON (CAR NEXTB)) [COND ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'ON) (* ; - "This paragraph IS a page heading.") + 'ON) (* ; "This paragraph IS a page heading.") (SETQ NEWLOOKS (CONS 'TYPE (CONS 'PAGEHEADING NEWLOOKS))) (* ; "Tell him that it's a heading.") (SETQ NEWLOOKS (CONS 'SUBTYPE (CONS [MKATOM (MBUTTON.NEXT.FIELD.AS.TEXT @@ -3056,67 +2975,61 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ) ((EQ (IMAGEOBJPROP BUTTON 'STATE) 'OFF) (* ; - "This paragraph IS NOT a page heading.") + "This paragraph IS NOT a page heading.") (SETQ NEWLOOKS (CONS 'TYPE (CONS NIL NEWLOOKS))) - (* ; - "Tell him that it's NOT a heading.") + (* ; "Tell him that it's NOT a heading.") (SETQ NEWLOOKS (CONS 'SUBTYPE (CONS NIL NEWLOOKS))) (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB))) (* ; "And say what kind.") ) (T (* ; - "No change specified. Skip over the heading-type fill-in.") + "No change specified. Skip over the heading-type fill-in.") (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB] [COND ((SETQ LINELEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (fetch (SELECTION CH#) - of SCRATCHSEL))) + of SCRATCHSEL))) (* ; "Get any line leading") (SETQ NEWLOOKS (CONS 'LINELEADING (CONS LINELEAD NEWLOOKS] [COND - ([SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL] + ([SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL] (* ; "Get any paragraph leading") (SETQ NEWLOOKS (CONS 'PARALEADING (CONS PARALEAD NEWLOOKS] [COND - ([SETQ SPECIALX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL] + ([SETQ SPECIALX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL] (* ; - "Get any special X position for the paragraph") + "Get any special X position for the paragraph") (SETQ NEWLOOKS (CONS 'SPECIALX (CONS (FIXR (TIMES 12 SPECIALX)) NEWLOOKS] [COND - ([SETQ SPECIALY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL] + ([SETQ SPECIALY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL] (* ; - "Get special Y positioning for the paragraph") + "Get special Y positioning for the paragraph") (SETQ NEWLOOKS (CONS 'SPECIALY (CONS (FIXR (TIMES 12 SPECIALY)) NEWLOOKS] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of - SCRATCHSEL - ))) + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL))) (SETQ BUTTON (CAR NEXTB)) [COND [(EQ (IMAGEOBJPROP BUTTON 'STATE) 'ON) (* ; - "This paragraph starts on a new page (or col or box, as apprpopriate)") + "This paragraph starts on a new page (or col or box, as apprpopriate)") (SETQ NEWLOOKS (CONS 'NEWPAGEBEFORE (CONS T NEWLOOKS] ((EQ (IMAGEOBJPROP BUTTON 'STATE) 'OFF) (* ; - "This paragraph IS NOT a page heading.") + "This paragraph IS NOT a page heading.") (SETQ NEWLOOKS (CONS 'NEWPAGEBEFORE (CONS NIL NEWLOOKS] [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] (SETQ BUTTON (CAR NEXTB)) [COND [(EQ (IMAGEOBJPROP BUTTON 'STATE) 'ON) (* ; - "The next paragraph starts on a new page....") + "The next paragraph starts on a new page....") (SETQ NEWLOOKS (CONS 'NEWPAGEAFTER (CONS T NEWLOOKS] ((EQ (IMAGEOBJPROP BUTTON 'STATE) 'OFF) (* ; - "The next paragraph DOESN'T START on a new page....") + "The next paragraph DOESN'T START on a new page....") (SETQ NEWLOOKS (CONS 'NEWPAGEAFTER (CONS NIL NEWLOOKS] [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] (SETQ BUTTON (CAR NEXTB)) @@ -3140,63 +3053,57 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (* ;;; "THE DEFAULT TAB WIDTH") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of - SCRATCHSEL - ))) + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL))) (SETQ BUTTON (CAR NEXTB)) (SETQ DEFAULTTAB (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (CDR NEXTB))) - (while (NOT (type? MARGINBAR BUTTON)) do (SETQ NEXTB ( - MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (fetch (SELECTION - CH#) - of SCRATCHSEL))) - (SETQ BUTTON (CAR NEXTB))) + (while (NOT (type? MARGINBAR BUTTON)) do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON + TEXTOBJ + (fetch (SELECTION CH#) of SCRATCHSEL) + )) + (SETQ BUTTON (CAR NEXTB))) (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) [COND ((IGEQ [SETQ L1 (FIXR (TIMES (fetch MARL1 of BUTTONDATA) (fetch MARUNIT of BUTTONDATA] 0) (* ; - "The 1stleftmargin is set, and non-neutral.") + "The 1stleftmargin is set, and non-neutral.") (SETQ NEWLOOKS (CONS '1STLEFTMARGIN (CONS L1 NEWLOOKS] [COND ((IGEQ [SETQ LN (FIXR (TIMES (fetch MARLN of BUTTONDATA) (fetch MARUNIT of BUTTONDATA] 0) (* ; - "The LEFTMARGIN is set, and non-neutral.") + "The LEFTMARGIN is set, and non-neutral.") (SETQ NEWLOOKS (CONS 'LEFTMARGIN (CONS LN NEWLOOKS] [COND ((IGEQ [SETQ R (FIXR (TIMES (fetch MARR of BUTTONDATA) (fetch MARUNIT of BUTTONDATA] 0) (* ; - "The RIGHTMARGIN is set, and non-neutral.") + "The RIGHTMARGIN is set, and non-neutral.") (SETQ NEWLOOKS (CONS 'RIGHTMARGIN (CONS R NEWLOOKS] [COND ((NEQ (fetch MARTABS of BUTTONDATA) 'NEUTRAL) (* ; - "If the tab settings are neutral, don't change anything.") + "If the tab settings are neutral, don't change anything.") (SETQ NEWLOOKS (CONS 'TABS (CONS [CONS DEFAULTTAB (SORT (for TAB in (fetch MARTABS of BUTTONDATA) collect (CONS (FIXR (TIMES (CAR TAB) - (fetch MARUNIT - of BUTTONDATA))) - (CDR TAB))) + (fetch MARUNIT of BUTTONDATA))) + (CDR TAB))) (FUNCTION (LAMBDA (A B) (ILEQ (CAR A) (CAR B] NEWLOOKS] - (TEDIT.PARALOOKS MAINTEXT NEWLOOKS (fetch (SELECTION CH#) of (fetch - (TEXTOBJ SEL) - of MAINTEXT)) + (TEDIT.PARALOOKS MAINTEXT NEWLOOKS (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) + of MAINTEXT)) (fetch (SELECTION DCH) of (fetch (TEXTOBJ SEL) of MAINTEXT))) (\SHOWSEL SEL NIL NIL) (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'PROCESS]) (\TEDIT.SHOW.PARALOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 6-Jul-92 09:42 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 6-Jul-92 09:42 by jds") (* ;; "Fill in the PARAGRAPH LOOKS menu from the para looks for a selected character") @@ -3210,18 +3117,15 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (\SHOWSEL SEL NIL NIL) (replace (SELECTION SET) of SEL with NIL) (COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of MAINTEXT)) - (* ; - "If there is no text to take the formatting from, don't bother") + ((ZEROP (fetch (TEXTOBJ TEXTLEN) of MAINTEXT)) (* ; + "If there is no text to take the formatting from, don't bother") (RETURN))) (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL [SETQ FMTSPEC (fetch (PIECE PPARALOOKS) - of (\CHTOPC [IMAX 1 (IMIN (fetch (TEXTOBJ TEXTLEN) - of MAINTEXT) - (fetch (SELECTION CH#) - of (fetch (TEXTOBJ SEL) - of MAINTEXT] - (fetch (TEXTOBJ PCTB) of MAINTEXT] + of (\CHTOPC [IMAX 1 (IMIN (fetch (TEXTOBJ TEXTLEN) of MAINTEXT) + (fetch (SELECTION CH#) + of (fetch (TEXTOBJ SEL) of MAINTEXT] + (fetch (TEXTOBJ PCTB) of MAINTEXT] (* ; "Get to the start of the text.") [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] (* ; "Skip the NEUTRAL button.") @@ -3230,46 +3134,39 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ BUTTON (CAR NEXTB)) [for ITEM in (IMAGEOBJPROP BUTTON 'BUTTONS) do (COND - ([EQ (fetch (FMTSPEC QUAD) of FMTSPEC) - (U-CASE (COND - ((LISTP ITEM) - (CAR ITEM)) - (T ITEM] (* ; "Turn this button on.") - (IMAGEOBJPROP BUTTON 'STATE ITEM) - (RETURN] (* ; - "Now find which text button was 'on'") + ([EQ (fetch (FMTSPEC QUAD) of FMTSPEC) + (U-CASE (COND + ((LISTP ITEM) + (CAR ITEM)) + (T ITEM] (* ; "Turn this button on.") + (IMAGEOBJPROP BUTTON 'STATE ITEM) + (RETURN] (* ; + "Now find which text button was 'on'") [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] (* ; "Find the 'Page Heading' button") (SETQ BUTTON (CAR NEXTB)) (COND ((EQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) 'PAGEHEADING) (* ; - "This IS a page heading. Turn the button ON and set the heading type field") + "This IS a page heading. Turn the button ON and set the heading type field") (IMAGEOBJPROP BUTTON 'STATE 'ON) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) (fetch (FMTSPEC FMTPARASUBTYPE) of FMTSPEC))) (T (* ; - "This isn't a page heading; make sure the type field is empty.") + "This isn't a page heading; make sure the type field is empty.") (IMAGEOBJPROP BUTTON 'STATE 'OFF) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL))) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) (fetch (FMTSPEC LINELEAD) of FMTSPEC)) (* ; "Update the LINE LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) (fetch (FMTSPEC LEADBEFORE) of FMTSPEC)) (* ; "Update the PARA LEADING field") [MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (LET ((VAL (/ (FIXR (IQUOTIENT (OR (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC - ) + (LET ((VAL (/ (FIXR (IQUOTIENT (OR (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) 0) 3)) 4))) @@ -3280,8 +3177,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. [MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (LET ((VAL (/ (FIXR (IQUOTIENT (OR (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC - ) + (LET ((VAL (/ (FIXR (IQUOTIENT (OR (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) 0) 3)) 4))) @@ -3289,9 +3185,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((FIXP VAL) VAL) (T (FLOAT VAL] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL] + [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL] (SETQ BUTTON (CAR NEXTB)) [COND ((fetch (FMTSPEC FMTNEWPAGEBEFORE) of FMTSPEC) @@ -3312,61 +3207,53 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (COND ((fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) (* ; - "This para is to be formatted for hardcopy on the display") + "This para is to be formatted for hardcopy on the display") 'ON) (T 'OFF] (* ;; "HEADING KEEP") - [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB - (COND - ((fetch (FMTSPEC FMTHEADINGKEEP) of FMTSPEC) + [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (COND + ((fetch (FMTSPEC + FMTHEADINGKEEP + ) + of FMTSPEC) (* ; - "This para is to be formatted for hardcopy on the display") - 'ON) - (T 'OFF] + "This para is to be formatted for hardcopy on the display") + 'ON) + (T 'OFF] (* ;; "DEFAULT TAB WIDTH") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB (CAR (fetch (FMTSPEC TABSPEC) - of FMTSPEC))) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB (CAR (fetch (FMTSPEC TABSPEC) of FMTSPEC))) (* ; - "Update the DEFAULT TAB SPACING field") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) - of SCRATCHSEL))) + "Update the DEFAULT TAB SPACING field") + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL) + )) (SETQ BUTTON (CAR NEXTB)) - (while (NOT (type? MARGINBAR BUTTON)) - do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB))) + (while (NOT (type? MARGINBAR BUTTON)) do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON + TEXTOBJ + (ADD1 (CDR NEXTB] + (SETQ BUTTON (CAR NEXTB))) (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) (* ; - "(IMAGEOBJPROP BUTTON (QUOTE IMAGECACHE) NIL)") + "(IMAGEOBJPROP BUTTON (QUOTE IMAGECACHE) NIL)") (* ; "Tell it to reformat itself.") - (replace MARL1 of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC - 1STLEFTMAR - ) - of FMTSPEC) - (fetch MARUNIT - of BUTTONDATA))) - (replace MARLN of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC - LEFTMAR) - of FMTSPEC) - (fetch MARUNIT - of BUTTONDATA))) - (replace MARR of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC - RIGHTMAR) - of FMTSPEC) - (fetch MARUNIT of - BUTTONDATA)) - ) + (replace MARL1 of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC 1STLEFTMAR) + of FMTSPEC) + (fetch MARUNIT of BUTTONDATA))) + (replace MARLN of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC LEFTMAR) of FMTSPEC) + (fetch MARUNIT of BUTTONDATA))) + (replace MARR of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) + (fetch MARUNIT of BUTTONDATA))) (replace MARTABS of BUTTONDATA with (for TAB in (CDR (fetch (FMTSPEC TABSPEC) of FMTSPEC)) - collect (CONS (FQUOTIENT (CAR TAB) - (fetch MARUNIT of BUTTONDATA)) - (CDR TAB]) + collect (CONS (FQUOTIENT (CAR TAB) + (fetch MARUNIT of BUTTONDATA)) + (CDR TAB]) (\TEDIT.NEUTRALIZE.PARALOOKS.MENU - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:18 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:18 by jds") (* ;; "Set all the fields of a PARAGRAPH LOOKS menu to neutral settings.") @@ -3375,111 +3262,100 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. SCRATCHSEL FMTSPEC BUTTON NEXTB ARB BUTTONDATA) (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) (* ; "Get to the start of the text.") - (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE - TEXTOBJ CH# 'NIL)) + (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ CH# + 'NIL)) (* ; - "Neutralize the justification N-Way button") + "Neutralize the justification N-Way button") (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) (* ; "Find the 'Page Heading' button") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL) (* ; "Update the LINE LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL) (* ; "Update the PARA LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - )) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) NIL) - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) + (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL)) 'NEUTRAL)) (* ; "New page before") (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) (* ; "New page after") (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) (* ; "Hardcopy formatting mode") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB NIL) - (* ; - "Update the DEFAULT TAB SPACING field") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) - of SCRATCHSEL))) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB NIL) (* ; + "Update the DEFAULT TAB SPACING field") + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL)) + ) (SETQ BUTTON (CAR NEXTB)) - (while (NOT (type? MARGINBAR BUTTON)) - do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB))) + (while (NOT (type? MARGINBAR BUTTON)) do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON + TEXTOBJ + (ADD1 (CDR NEXTB] + (SETQ BUTTON (CAR NEXTB))) (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) (* ; - "(IMAGEOBJPROP BUTTON (QUOTE IMAGECACHE) NIL)") + "(IMAGEOBJPROP BUTTON (QUOTE IMAGECACHE) NIL)") (* ; "Tell it to reformat itself.") - [replace MARL1 of BUTTONDATA - with (COND - ((ILESSP (fetch MARL1 of BUTTONDATA) - 0) - (fetch MARL1 of BUTTONDATA)) - (T (IMIN -0.5 (IMINUS (fetch MARL1 of BUTTONDATA] - [replace MARLN of BUTTONDATA - with (COND - ((ILESSP (fetch MARLN of BUTTONDATA) - 0) - (fetch MARLN of BUTTONDATA)) - (T (IMIN -0.5 (IMINUS (fetch MARLN of BUTTONDATA] - [replace MARR of BUTTONDATA - with (COND - ((ILESSP (fetch MARR of BUTTONDATA) - 0) - (fetch MARR of BUTTONDATA)) - ((ZEROP (fetch MARR of BUTTONDATA)) - (IMINUS (IQUOTIENT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - 20) - 12))) - (T (IMIN -0.5 (IMINUS (fetch MARR of BUTTONDATA] + [replace MARL1 of BUTTONDATA with (COND + ((ILESSP (fetch MARL1 of BUTTONDATA) + 0) + (fetch MARL1 of BUTTONDATA)) + (T (IMIN -0.5 (IMINUS (fetch MARL1 of + BUTTONDATA + ] + [replace MARLN of BUTTONDATA with (COND + ((ILESSP (fetch MARLN of BUTTONDATA) + 0) + (fetch MARLN of BUTTONDATA)) + (T (IMIN -0.5 (IMINUS (fetch MARLN of + BUTTONDATA + ] + [replace MARR of BUTTONDATA with (COND + ((ILESSP (fetch MARR of BUTTONDATA) + 0) + (fetch MARR of BUTTONDATA)) + ((ZEROP (fetch MARR of BUTTONDATA)) + (IMINUS (IQUOTIENT (IDIFFERENCE + (fetch (TEXTOBJ WRIGHT) + of TEXTOBJ) + 20) + 12))) + (T (IMIN -0.5 (IMINUS (fetch MARR of BUTTONDATA] (replace MARTABS of BUTTONDATA with 'NEUTRAL]) (\TEDIT.RECORD.TABLEADERS - [LAMBDA (BUTTON NEWSTATE TEXTSTREAM SEL) (* ; "Edited 30-May-91 22:18 by jds") + [LAMBDA (BUTTON NEWSTATE TEXTSTREAM SEL) (* ; "Edited 30-May-91 22:18 by jds") (* Toggle the dotted-leader state of the margin bar tab-setter. - This is called when the user hits the "dotted leader" toggle button in the menu) + This is called when the user hits the "dotted leader" toggle button in the menu) (PROG* [(FLG (COND ((EQ NEWSTATE 'ON) T) (T NIL))) (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (MARGINBAR (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SEL] + (MARGINBAR (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SEL] (replace MARTABTYPE of (IMAGEOBJPROP MARGINBAR 'OBJECTDATUM) - with (SELECTQ (OR (fetch MARTABTYPE of (IMAGEOBJPROP MARGINBAR - 'OBJECTDATUM)) - 'LEFT) - (LEFT 'DOTTEDLEFT) - (DOTTEDLEFT 'LEFT) - (CENTERED 'DOTTEDCENTERED) - (DOTTEDCENTERED - 'CENTERED) - (RIGHT 'DOTTEDRIGHT) - (DOTTEDRIGHT 'RIGHT) - (DECIMAL 'DOTTEDDECIMAL) - (DOTTEDDECIMAL 'DECIMAL) - (SHOULDNT]) + with (SELECTQ (OR (fetch MARTABTYPE of (IMAGEOBJPROP MARGINBAR 'OBJECTDATUM)) + 'LEFT) + (LEFT 'DOTTEDLEFT) + (DOTTEDLEFT 'LEFT) + (CENTERED 'DOTTEDCENTERED) + (DOTTEDCENTERED + 'CENTERED) + (RIGHT 'DOTTEDRIGHT) + (DOTTEDRIGHT 'RIGHT) + (DECIMAL 'DOTTEDDECIMAL) + (DOTTEDDECIMAL 'DECIMAL) + (SHOULDNT]) ) (DEFINEQ (\TEDIT.SHOW.PAGEFORMATTING - [LAMBDA (OBJ SEL W) (* ; "Edited 4-Feb-92 16:38 by jds") + [LAMBDA (OBJ SEL W) (* ; "Edited 4-Feb-92 16:38 by jds") (* ;;; "Take a document's page formatting, and display it in the menu.") @@ -3518,50 +3394,46 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (* ;; "Now replace the button values, fill-in fields, etc.") - (SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of - MAINTEXT - ) + (SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXT) TEDIT.PAGE.FRAMES)) [COND ((LISTP OPAGEFRAMES) (* ; - "No problem, this is already just a list of first-recto-verso frames") + "No problem, this is already just a list of first-recto-verso frames") ) (T (* ; - "This is probably a parsed-up version of the thing. Fix it to a list.") + "This is probably a parsed-up version of the thing. Fix it to a list.") (COND - [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of - OPAGEFRAMES - ) + [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of OPAGEFRAMES) 'SEQUENCE) (SETQ FIRST (CAR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES))) (SETQ REST (CADR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES))) (COND - [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of - REST) + [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REST) 'ALTERNATE) - (SETQ OPAGEFRAMES (CONS FIRST (fetch (PAGEREGION - REGIONSUBBOXES) + (SETQ OPAGEFRAMES (CONS FIRST (fetch (PAGEREGION + REGIONSUBBOXES + ) of REST] (T (SETQ OPAGEFRAMES NIL] (T (SETQ OPAGEFRAMES NIL] (COND ((NOT OPAGEFRAMES) (* ; - "If the formatting isn't in our simplified 3-way format, punt out of this.") + "If the formatting isn't in our simplified 3-way format, punt out of this.") (TEDIT.PROMPTPRINT MAINTEXT "Format too complex to edit." T) (SETQ PAGEID NIL))) (SELECTQ PAGEID (FIRST (SETQ NEWLOOKS (CAR OPAGEFRAMES))) (LEFT (SETQ NEWLOOKS (CADR OPAGEFRAMES)) (SETQ PAPERSIZE (LISTGET [CAR (FLAST ( - TEDIT.UNPARSE.PAGEFORMAT + TEDIT.UNPARSE.PAGEFORMAT (CAR OPAGEFRAMES) 'PICAS] 'PAPERSIZE))) (RIGHT (SETQ NEWLOOKS (CADDR OPAGEFRAMES)) (SETQ PAPERSIZE (LISTGET [CAR (FLAST ( - TEDIT.UNPARSE.PAGEFORMAT + TEDIT.UNPARSE.PAGEFORMAT (CAR OPAGEFRAMES) 'PICAS] 'PAPERSIZE))) @@ -3574,11 +3446,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((EQ PAGEID 'FIRST) (SETQ PAPERSIZE (LISTGET PAGEPROPS 'PAPERSIZE] (SETQ CH# (ADD1 (CDR NEXTB))) - (* ; - "Move past the kind-of-page button") + (* ; "Move past the kind-of-page button") (SETQ STARTINGPAGE# (LISTGET PAGEPROPS 'STARTINGPAGE#)) (* ; - "Grab a potential starting page number.") + "Grab a potential starting page number.") (MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# STARTINGPAGE#) (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) (SETQ CH# (ADD1 (CDR NEXTB))) @@ -3593,7 +3464,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((LISTGET PAGEPROPS 'LANDSCAPE?) 'ON) (T 'OFF] (* ; - "Tell whether the page is to be landscape or not.") + "Tell whether the page is to be landscape or not.") (SETQ FOLIOINFO (LISTGET PAGEPROPS 'FOLIOINFO)) (* ; "Page number fomratting info") (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) @@ -3608,17 +3479,16 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) (pop NEWLOOKS)) (* ; "Page # X location") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Page # Y location") (SETQ PFONT (pop NEWLOOKS)) (* ; "Skip the font info for now.") [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - ] + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] (SETQ CH# (ADD1 (CDR NEXTB))) (SETQ BUTTON (CAR NEXTB)) (IMAGEOBJPROP BUTTON 'STATE (SELECTQ (pop FOLIOINFO) @@ -3638,66 +3508,67 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'Centered)) (MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# (pop FOLIOINFO)) (* ; - "The text to surround the page number") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + "The text to surround the page number") + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop FOLIOINFO)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Left Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Right Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Top margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Bottom Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "# of columns") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Column width") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION + CH#) + of SCRATCHSEL)) (pop NEWLOOKS)) (* ; "Intercolumn spacing") (SETQ HEADINGS (pop NEWLOOKS)) (for HEADING# from 1 to 8 do + (* ;; + "Insert info about up to 8 headings (the # of spots in the menu)") - (* ;; - "Insert info about up to 8 headings (the # of spots in the menu)") - - (SETQ HEADING (pop HEADINGS)) - (MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL) - ) - (pop HEADING)) - (MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL) - ) - (pop HEADING)) - (MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL) - ) - (pop HEADING))) + (SETQ HEADING (pop HEADINGS)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (pop HEADING)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (pop HEADING)) + (MBUTTON.SET.NEXT.FIELD TEXTOBJ + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) + (pop HEADING))) (COND (HEADINGS (* ;; - "There were headings left over, so warn user.") + "There were headings left over, so warn user.") (PROMPTPRINT "WARNING: This document has more kinds of page heading than the menu has room for. Some will be lost if you APPLY this menu." ))) @@ -3705,11 +3576,11 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) (OR PFONT TEDIT.DEFAULT.FOLIO.LOOKS)) (* ; - "The font for the page numbers to appear in.") + "The font for the page numbers to appear in.") ]) (\TEDITPAGEMENU.CREATE - [LAMBDA NIL (* gbn " 8-Oct-84 18:25") + [LAMBDA NIL (* gbn " 8-Oct-84 18:25") (* Creates the TEdit Expanded Menu) (SETQ TEDIT.EXPANDED.PAGEMENU (\TEXTMENU.DOC.CREATE (APPEND TEDIT.PAGEMENU.SPEC TEDIT.MENUDIVIDER.SPEC @@ -3722,8 +3593,8 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. TEDIT.CHARLOOKSMENU.SPEC]) (\TEDIT.APPLY.PAGEFORMATTING - [LAMBDA (OBJ SEL W) (* ; - "Edited 4-Jun-93 12:04 by sybalsky:mv:envos") + [LAMBDA (OBJ SEL W) (* ; + "Edited 4-Jun-93 12:04 by sybalsky:mv:envos") (* ;;; "Change the page formatting for this document") @@ -3755,13 +3626,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (SETQ PAPERSIZE (OR (IMAGEOBJPROP (CAR NEXTB) 'STATE) 'Letter)) (* ; - "Get the size of paper this is to be formatted for") + "Get the size of paper this is to be formatted for") (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) (SETQ CH# (ADD1 (CDR NEXTB))) (SETQ LANDSCAPE? (EQ (IMAGEOBJPROP (CAR NEXTB) 'STATE) 'ON)) (* ; - "Decide if this kind of page is to be printed landscape....") + "Decide if this kind of page is to be printed landscape....") (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) (SETQ CH# (ADD1 (CDR NEXTB))) (SELECTQ (IMAGEOBJPROP (CAR NEXTB) @@ -3770,11 +3641,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (Yes (SETQ PAGENOS T)) NIL) (* ; "Find about page numbers") (SETQ PX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#)) - [SETQ PY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + [SETQ PY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] [COND (PAGENOS (* ; - "If he wants page numbers, make sure he said WHERE to put them.") + "If he wants page numbers, make sure he said WHERE to put them.") (COND ((AND PX PY)) (T (TEDIT.PROMPTPRINT MAINTEXT @@ -3782,10 +3652,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. T) (TEDIT.PROMPTFLASH MAINTEXT) (RETURN] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] (* ; - "Get to the numbering-format button") + "Get to the numbering-format button") (SETQ BUTTON (CAR NEXTB)) (SETQ FOLIOFORMAT (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) (123 (* ; "arabic numbers") @@ -3797,66 +3666,62 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'ARABIC)) [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] (* ; - "Get to the number alignment button") + "Get to the number alignment button") (SETQ BUTTON (CAR NEXTB)) [SETQ ALIGNMENT (U-CASE (IMAGEOBJPROP BUTTON 'STATE] (* ; "PX PY PFONT ALIGNMENT") - (* ; - "Margins: LEFT, RIGHT, TOP, BOTTOM") + (* ; "Margins: LEFT, RIGHT, TOP, BOTTOM") (SETQ CH# (ADD1 (CDR NEXTB))) (SETQ FOLIOPRETEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ CH#)) - [SETQ FOLIOPOSTTEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL] + [SETQ FOLIOPOSTTEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL] (* ;;; "Now get the margins on the paper") - [SETQ LEFT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - [SETQ RIGHT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - [SETQ TOP (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + [SETQ LEFT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL + ] + [SETQ RIGHT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of + SCRATCHSEL + ] + [SETQ TOP (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] [SETQ BOTTOM (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + of SCRATCHSEL] (COND [(SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + of SCRATCHSEL] (T (TEDIT.PROMPTPRINT MAINTEXT "Please specify how many columns there should be." T) (TEDIT.PROMPTFLASH MAINTEXT))) [SETQ COLWIDTH (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + of SCRATCHSEL] [SETQ INTERCOL (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + of SCRATCHSEL] (* ; "Col count, width, spacing") (SETQ HEADINGS (for HEADING# from 1 to 8 when (PROG1 [SETQ HEADINGTYPE (MBUTTON.NEXT.FIELD.AS.ATOM - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - [SETQ HEADINGX (MBUTTON.NEXT.FIELD.AS.NUMBER - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - [SETQ HEADINGY (MBUTTON.NEXT.FIELD.AS.NUMBER - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL]) + TEXTOBJ + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL + ] + [SETQ HEADINGX (MBUTTON.NEXT.FIELD.AS.NUMBER + TEXTOBJ + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] + [SETQ HEADINGY (MBUTTON.NEXT.FIELD.AS.NUMBER + TEXTOBJ + (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL]) collect (COND - ((AND HEADINGX HEADINGY)) - (T (TEDIT.PROMPTPRINT MAINTEXT (CONCAT + ((AND HEADINGX HEADINGY)) + (T (TEDIT.PROMPTPRINT MAINTEXT (CONCAT "You need to say WHERE " - HEADINGTYPE - " headings go.") - T) - (TEDIT.PROMPTFLASH MAINTEXT) - (SETQ HEADINGINVALID T))) + HEADINGTYPE + " headings go.") + T) + (TEDIT.PROMPTFLASH MAINTEXT) + (SETQ HEADINGINVALID T))) (LIST HEADINGTYPE HEADINGX HEADINGY))) (COND (HEADINGINVALID (* ; "Headings invalid.") (RETURN))) - [SETQ PFONT (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + [SETQ PFONT (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL + ] (* ;;; "Glom all the oddball options (starting page, folio format &c) together") @@ -3865,7 +3730,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (push PAGEOPTIONS 'FOLIOINFO) [COND (LANDSCAPE? (* ; - "The pages are to be printed landscape. Remember that fact.") + "The pages are to be printed landscape. Remember that fact.") (push PAGEOPTIONS T) (push PAGEOPTIONS 'LANDSCAPE?] (SETQ NPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT (AND (NEQ ALIGNMENT @@ -3878,10 +3743,10 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. ((NOT (LISTP OPAGEFRAMES)) (COND ((EQ PAGEID 'FIRST) (* ; - "Setting the first page sets them all") + "Setting the first page sets them all") (SETQ PAGEOPTIONS (COPY PAGEOPTIONS)) (LISTPUT PAGEOPTIONS 'STARTINGPAGE# NIL) (* ; - "Starting page nubmer makes no sense on other than first pages.") + "Starting page nubmer makes no sense on other than first pages.") (SETQ NFPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT (AND (NEQ ALIGNMENT 'OFF) ALIGNMENT) @@ -3889,7 +3754,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 'PICAS PAGEOPTIONS PAPERSIZE)) (SETQ OPAGEFRAMES (LIST NPAGEFORMAT NFPAGEFORMAT NFPAGEFORMAT))) (T (* ; - "Otherwise, start from the default page layout") + "Otherwise, start from the default page layout") (SETQ OPAGEFRAMES (COPY TEDIT.PAGE.FRAMES] (SELECTQ PAGEID (FIRST (RPLACA OPAGEFRAMES NPAGEFORMAT)) @@ -3899,16 +3764,15 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. NPAGEFORMAT)) NIL) (TEDIT.PAGEFORMAT MAINTEXT OPAGEFRAMES) - (replace (TEXTOBJ \DIRTY) of MAINTEXT with T) - (* ; - "Mark the document as having changed.") + (replace (TEXTOBJ \DIRTY) of MAINTEXT with T) (* ; + "Mark the document as having changed.") (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'PROCESS]) (TEDIT.UNPARSE.PAGEFORMAT - [LAMBDA (PAGEREGION UNITS) (* ; "Edited 12-Jun-90 18:59 by mitani") + [LAMBDA (PAGEREGION UNITS) (* ; "Edited 12-Jun-90 18:59 by mitani") -(* ;;; "Take a page layout and unparse it into a PList of specs.") +(* ;;; "Take a page layout and unparse it into a PList of specs.") (LET* ((PAPER (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)) (PAPERWIDTH (fetch (REGION WIDTH) of PAPER)) @@ -3919,79 +3783,79 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (INTERCOL 0) SPECS PAGENOS (OLDRIGHT NIL) SCALEFACTOR HEADINGS) - [for REGION in REGIONS - do + [for REGION in REGIONS do + (* ;; + "Run thru the regions on the page, calculating information about the page as a whole.") - (* ;; - "Run thru the regions on the page, calculating information about the page as a whole.") - - (COND - ((EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION) - 'FOLIO) (* ; - "A page-number (%"Folio%") region") - (SETQ PAGENOS T) - (SETQ PX (fetch (REGION LEFT) of (fetch REGIONSPEC of REGION)) - ) - (SETQ PY (fetch (REGION BOTTOM) of (fetch REGIONSPEC of REGION - ))) - (SETQ SPECS (fetch REGIONLOCALINFO of REGION)) - (SETQ PFONT (LISTGET SPECS 'CHARLOOKS)) - [SETQ PQUAD (CADR (LISTGET SPECS 'PARALOOKS] - (SELECTQ PQUAD - (LEFT) - (RIGHT (SETQ PX (IPLUS PX 288))) - (CENTERED (SETQ PX (IPLUS PX 144))) - NIL)) - [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION) - 'HEADING) (* ; "A page-heading region") - (SETQ HEADINGS (NCONC1 HEADINGS (LIST (LISTGET (fetch REGIONLOCALINFO - of REGION) - 'HEADINGTYPE) - (fetch (REGION LEFT) - of (fetch REGIONSPEC - of REGION)) - (fetch (REGION BOTTOM) - of (fetch REGIONSPEC - of REGION] - (T (* ; "A regular-text region.") - (add COLS 1) (* ; "Count columns") - (SETQ COLWIDTH (fetch (REGION WIDTH) of (fetch REGIONSPEC + (COND + ((EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION) + 'FOLIO) (* ; "A page-number (%"Folio%") region") + (SETQ PAGENOS T) + (SETQ PX (fetch (REGION LEFT) of (fetch REGIONSPEC of REGION))) - [SETQ RIGHT (IDIFFERENCE PAPERWIDTH (ADD1 (fetch (REGION RIGHT) + (SETQ PY (fetch (REGION BOTTOM) of (fetch REGIONSPEC + of REGION))) + (SETQ SPECS (fetch REGIONLOCALINFO of REGION)) + (SETQ PFONT (LISTGET SPECS 'CHARLOOKS)) + [SETQ PQUAD (CADR (LISTGET SPECS 'PARALOOKS] + (SELECTQ PQUAD + (LEFT) + (RIGHT (SETQ PX (IPLUS PX 288))) + (CENTERED (SETQ PX (IPLUS PX 144))) + NIL)) + [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION) + 'HEADING) (* ; "A page-heading region") + (SETQ HEADINGS (NCONC1 HEADINGS + (LIST (LISTGET (fetch REGIONLOCALINFO + of REGION) + 'HEADINGTYPE) + (fetch (REGION LEFT) + of (fetch REGIONSPEC + of REGION)) + (fetch (REGION BOTTOM) + of (fetch REGIONSPEC + of REGION] + (T (* ; "A regular-text region.") + (add COLS 1) (* ; "Count columns") + (SETQ COLWIDTH (fetch (REGION WIDTH) + of (fetch REGIONSPEC of REGION))) + [SETQ RIGHT (IDIFFERENCE PAPERWIDTH + (ADD1 (fetch (REGION RIGHT) of (fetch REGIONSPEC - of REGION] - (COND - ((EQ OLDRIGHT T)) - (OLDRIGHT (SETQ INTERCOL (IDIFFERENCE (fetch (REGION LEFT) - of (fetch REGIONSPEC - of REGION)) - OLDRIGHT)) - (SETQ OLDRIGHT T)) - (T (SETQ OLDRIGHT (fetch (REGION RIGHT) of (fetch REGIONSPEC - of REGION))) - (SETQ LEFT (fetch (REGION LEFT) of (fetch REGIONSPEC - of REGION))) - [SETQ TOP (IDIFFERENCE PAPERHEIGHT (fetch (REGION PTOP) - of (fetch REGIONSPEC - of REGION] - (SETQ BOTTOM (fetch (REGION BOTTOM) of (fetch REGIONSPEC - of REGION] + of REGION] + (COND + ((EQ OLDRIGHT T)) + (OLDRIGHT (SETQ INTERCOL + (IDIFFERENCE (fetch (REGION LEFT) + of (fetch REGIONSPEC + of REGION)) + OLDRIGHT)) + (SETQ OLDRIGHT T)) + (T (SETQ OLDRIGHT (fetch (REGION RIGHT) + of (fetch REGIONSPEC of REGION))) + (SETQ LEFT (fetch (REGION LEFT) + of (fetch REGIONSPEC of REGION))) + [SETQ TOP (IDIFFERENCE PAPERHEIGHT + (fetch (REGION PTOP) + of (fetch REGIONSPEC of REGION] + (SETQ BOTTOM (fetch (REGION BOTTOM) + of (fetch REGIONSPEC of REGION] (SELECTQ UNITS - ((POINTS NIL) (* If units are in printers points, - the default, do no scaling) + ((POINTS NIL) (* If units are in printers points, + the default, do no scaling) ) - (PICAS (* The units are in picas--12pts - per. Scale all values.) + (PICAS (* The units are in picas--12pts per. + Scale all values.) (SETQ SCALEFACTOR 0.12)) - (INCHES (* The units are in inches, at - 72.27pts per. Set the scale factor) + (INCHES (* The units are in inches, at + 72.27pts per. Set the scale factor) (SETQ SCALEFACTOR 0.7227)) - (CM (* Units are in CM, at 72.27/2.54pts - per.) + (CM (* Units are in CM, at 72.27/2.54pts + per.) (SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 0.7227 2.54)))) (\ILLEGAL.ARG UNITS)) [COND - (SCALEFACTOR (* We need to do the scaling.) + (SCALEFACTOR (* We need to do the scaling.) (AND PX (SETQ PX (FQUOTIENT (FIXR (FQUOTIENT PX SCALEFACTOR)) 100))) (AND PY (SETQ PY (FQUOTIENT (FIXR (FQUOTIENT PY SCALEFACTOR)) @@ -4010,12 +3874,12 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. 100))) (SETQ HEADINGS (for HDG in HEADINGS collect (LIST (CAR HDG) - (FQUOTIENT (FIXR (FQUOTIENT (CADR HDG) - SCALEFACTOR)) - 100) - (FQUOTIENT (FIXR (FQUOTIENT (CADDR HDG) - SCALEFACTOR)) - 100] + (FQUOTIENT (FIXR (FQUOTIENT (CADR HDG) + SCALEFACTOR)) + 100) + (FQUOTIENT (FIXR (FQUOTIENT (CADDR HDG) + SCALEFACTOR)) + 100] (LIST PAGENOS PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION]) ) @@ -4033,19 +3897,19 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TEDIT.MENU.INIT - [LAMBDA NIL (* ; "Edited 29-Apr-2021 22:44 by rmk:") - (* ; "Edited 30-Mar-94 15:53 by jds") + [LAMBDA NIL (* ; "Edited 29-Apr-2021 22:44 by rmk:") + (* ; "Edited 30-Mar-94 15:53 by jds") -(* ;;; "Initialize the descriptions for all TEdit menus") +(* ;;; "Initialize the descriptions for all TEdit menus") -(* ;;; "Divides between the main page layout menu and page-# font submenu") +(* ;;; "Divides between the main page layout menu and page-# font submenu") (SETQ TEDIT.MENUDIVIDER.SPEC (LIST (create MB.TEXT MBSTRING _ " "))) -(* ;;; "The principal expanded menu") +(* ;;; "The principal expanded menu") (SETQ TEDIT.EXPANDEDMENU.SPEC (LIST (create MB.BUTTON MBLABEL _ "Quit") @@ -4132,7 +3996,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. MBSTRING _ " Message/Phone#:") (create MB.INSERT))) -(* ;;; "The character-looks (font, etc.) menu") +(* ;;; "The character-looks (font, etc.) menu") (SETQ TEDIT.CHARLOOKSMENU.SPEC (LIST (create MB.TEXT MBSTRING _ "Props: " @@ -4182,7 +4046,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation. MBFONT _ (FONTCREATE 'HELVETICA 8)) (create MB.INSERT))) -(* ;;; "The paragraph-formatting menu (margins, etc.)") +(* ;;; "The paragraph-formatting menu (margins, etc.)") (SETQ TEDIT.PARAMENU.SPEC (LIST (create MB.BUTTON MBLABEL _ 'APPLY @@ -4273,7 +4137,7 @@ Tab Type: " MBSTRING _ " "))) -(* ;;; "Page-layout menu for columns, page headings, page numbers, etc.") +(* ;;; "Page-layout menu for columns, page headings, page numbers, etc.") (SETQ TEDIT.PAGEMENU.SPEC (APPEND (LIST (create MB.BUTTON MBLABEL _ 'APPLY @@ -4491,45 +4355,43 @@ Tab Type: " (ADDTOVAR LAMA ) ) -(PUTPROPS TEDITMENU COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 -1991 1992 1993 1994 1995 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6267 33109 (MB.BUTTONEVENTINFN 6277 . 7608) (MB.DISPLAY 7610 . 9978) (MB.SETIMAGE 9980 - . 10938) (MB.SELFN 10940 . 12355) (MB.SIZEFN 12357 . 13374) (MB.WHENOPERATEDFN 13376 . 13708) ( -MB.COPYFN 13710 . 14172) (MB.GETFN 14174 . 14782) (MB.PUTFN 14784 . 15561) (MB.SHOWSELFN 15563 . 16535 -) (MBUTTON.CREATE 16537 . 17821) (MBUTTON.CHANGENAME 17823 . 18218) (MBUTTON.FIND.BUTTON 18220 . 19236 -) (MBUTTON.FIND.NEXT.BUTTON 19238 . 20633) (MBUTTON.FIND.NEXT.FIELD 20635 . 24349) (MBUTTON.INIT 24351 - . 25141) (MBUTTON.NEXT.FIELD.AS.NUMBER 25143 . 25496) (MBUTTON.NEXT.FIELD.AS.PIECES 25498 . 25928) ( -MBUTTON.NEXT.FIELD.AS.TEXT 25930 . 26352) (MBUTTON.NEXT.FIELD.AS.ATOM 26354 . 27227) ( -MBUTTON.SET.FIELD 27229 . 29285) (MBUTTON.SET.NEXT.FIELD 29287 . 30504) (MBUTTON.SET.NEXT.BUTTON.STATE - 30506 . 31002) (TEDITMENU.STREAM 31004 . 31613) (\TEDITMENU.SELSCREENER 31615 . 33107)) (33413 43836 -(MB.CREATE.THREESTATEBUTTON 33423 . 34594) (MB.THREESTATE.DISPLAY 34596 . 37186) ( -MB.THREESTATE.SHOWSELFN 37188 . 40290) (MB.THREESTATE.WHENOPERATEDFN 40292 . 41671) ( -MB.THREESTATEBUTTON.FN 41673 . 42770) (THREESTATE.INIT 42772 . 43834)) (43937 63173 ( -MB.CREATE.NWAYBUTTON 43947 . 47915) (MB.NB.DISPLAYFN 47917 . 50189) (MB.NB.WHENOPERATEDFN 50191 . -51223) (MB.NB.SIZEFN 51225 . 54764) (MB.NWAYBUTTON.SELFN 54766 . 56710) (MB.NWAYMENU.NEWBUTTON 56712 - . 57298) (NWAYBUTTON.INIT 57300 . 58153) (MB.NB.PACKITEMS 58155 . 60152) (MB.NWAYBUTTON.ADDITEM 60154 - . 63171)) (63427 74075 (\TEXTMENU.TOGGLE.CREATE 63437 . 64838) (\TEXTMENU.TOGGLE.DISPLAY 64840 . -67192) (\TEXTMENU.TOGGLE.SHOWSELFN 67194 . 69556) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69558 . 70946) ( -\TEXTMENU.TOGGLEFN 70948 . 72028) (\TEXTMENU.TOGGLE.INIT 72030 . 72865) (\TEXTMENU.SET.TOGGLE 72867 . -74073)) (74327 111699 (DRAWMARGINSCALE 74337 . 77881) (MARGINBAR 77883 . 85253) (MARGINBAR.CREATE -85255 . 88165) (MB.MARGINBAR.SELFN 88167 . 100761) (MB.MARGINBAR.SIZEFN 100763 . 101125) ( -MB.MARGINBAR.DISPLAYFN 101127 . 103812) (MDESCALE 103814 . 104253) (MSCALE 104255 . 104589) ( -MB.MARGINBAR.SHOWTAB 104591 . 106762) (MB.MARGINBAR.TABTRACK 106764 . 108099) (\TEDIT.TABTYPE.SET -108101 . 110808) (MARGINBAR.INIT 110810 . 111697)) (112716 129644 (\TEXTMENU.START 112726 . 116439) ( -\TEXTMENU.DOC.CREATE 116441 . 126770) (TEXTMENU.CLOSEFN 126772 . 129642)) (129954 150018 ( -\TEDITMENU.CREATE 129964 . 130264) (\TEDIT.EXPANDED.MENU 130266 . 130970) (MB.DEFAULTBUTTON.FN 130972 - . 133844) (\TEDITMENU.RECORD.UNFORMATTED 133846 . 134184) (MB.DEFAULTBUTTON.ACTIONFN 134186 . 150016) -) (150019 177402 (\TEDIT.CHARLOOKSMENU.CREATE 150029 . 152169) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152171 - . 152545) (\TEDIT.APPLY.BOLDNESS 152547 . 152832) (\TEDIT.APPLY.CHARLOOKS 152834 . 154765) ( -\TEDIT.APPLY.OLINE 154767 . 155048) (\TEDIT.SHOW.CHARLOOKS 155050 . 156963) ( -\TEDIT.NEUTRALIZE.CHARLOOKS 156965 . 157891) (\TEDIT.FILL.IN.CHARLOOKS.MENU 157893 . 165546) ( -\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 165548 . 168431) (\TEDIT.PARSE.CHARLOOKS.MENU 168433 . 176541) ( -\TEDIT.APPLY.SLOPE 176543 . 176826) (\TEDIT.APPLY.STRIKEOUT 176828 . 177115) (\TEDIT.APPLY.ULINE -177117 . 177400)) (177403 209469 (\TEDITPARAMENU.CREATE 177413 . 177793) (\TEDIT.EXPANDEDPARA.MENU -177795 . 178115) (\TEDIT.APPLY.PARALOOKS 178117 . 190347) (\TEDIT.SHOW.PARALOOKS 190349 . 201876) ( -\TEDIT.NEUTRALIZE.PARALOOKS.MENU 201878 . 207949) (\TEDIT.RECORD.TABLEADERS 207951 . 209467)) (209470 -247472 (\TEDIT.SHOW.PAGEFORMATTING 209480 . 226020) (\TEDITPAGEMENU.CREATE 226022 . 227065) ( -\TEDIT.APPLY.PAGEFORMATTING 227067 . 239438) (TEDIT.UNPARSE.PAGEFORMAT 239440 . 247470)) (247777 -274626 (\TEDIT.MENU.INIT 247787 . 274624))))) + (FILEMAP (NIL (6181 32683 (MB.BUTTONEVENTINFN 6191 . 7480) (MB.DISPLAY 7482 . 9653) (MB.SETIMAGE 9655 + . 10609) (MB.SELFN 10611 . 11984) (MB.SIZEFN 11986 . 12999) (MB.WHENOPERATEDFN 13001 . 13329) ( +MB.COPYFN 13331 . 13789) (MB.GETFN 13791 . 14399) (MB.PUTFN 14401 . 15145) (MB.SHOWSELFN 15147 . 16063 +) (MBUTTON.CREATE 16065 . 17297) (MBUTTON.CHANGENAME 17299 . 17678) (MBUTTON.FIND.BUTTON 17680 . 18681 +) (MBUTTON.FIND.NEXT.BUTTON 18683 . 20340) (MBUTTON.FIND.NEXT.FIELD 20342 . 23882) (MBUTTON.INIT 23884 + . 24670) (MBUTTON.NEXT.FIELD.AS.NUMBER 24672 . 25029) (MBUTTON.NEXT.FIELD.AS.PIECES 25031 . 25467) ( +MBUTTON.NEXT.FIELD.AS.TEXT 25469 . 25895) (MBUTTON.NEXT.FIELD.AS.ATOM 25897 . 26783) ( +MBUTTON.SET.FIELD 26785 . 28700) (MBUTTON.SET.NEXT.FIELD 28702 . 29921) (MBUTTON.SET.NEXT.BUTTON.STATE + 29923 . 30403) (TEDITMENU.STREAM 30405 . 31181) (\TEDITMENU.SELSCREENER 31183 . 32681)) (32987 43530 +(MB.CREATE.THREESTATEBUTTON 32997 . 34164) (MB.THREESTATE.DISPLAY 34166 . 36987) ( +MB.THREESTATE.SHOWSELFN 36989 . 40023) (MB.THREESTATE.WHENOPERATEDFN 40025 . 41358) ( +MB.THREESTATEBUTTON.FN 41360 . 42468) (THREESTATE.INIT 42470 . 43528)) (43631 63113 ( +MB.CREATE.NWAYBUTTON 43641 . 47710) (MB.NB.DISPLAYFN 47712 . 49980) (MB.NB.WHENOPERATEDFN 49982 . +51016) (MB.NB.SIZEFN 51018 . 54646) (MB.NWAYBUTTON.SELFN 54648 . 56570) (MB.NWAYMENU.NEWBUTTON 56572 + . 57159) (NWAYBUTTON.INIT 57161 . 58010) (MB.NB.PACKITEMS 58012 . 59991) (MB.NWAYBUTTON.ADDITEM 59993 + . 63111)) (63367 74033 (\TEXTMENU.TOGGLE.CREATE 63377 . 64867) (\TEXTMENU.TOGGLE.DISPLAY 64869 . +67368) (\TEXTMENU.TOGGLE.SHOWSELFN 67370 . 69711) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69713 . 71055) ( +\TEXTMENU.TOGGLEFN 71057 . 72145) (\TEXTMENU.TOGGLE.INIT 72147 . 72978) (\TEXTMENU.SET.TOGGLE 72980 . +74031)) (74285 111021 (DRAWMARGINSCALE 74295 . 77754) (MARGINBAR 77756 . 84997) (MARGINBAR.CREATE +84999 . 87871) (MB.MARGINBAR.SELFN 87873 . 99910) (MB.MARGINBAR.SIZEFN 99912 . 100270) ( +MB.MARGINBAR.DISPLAYFN 100272 . 102969) (MDESCALE 102971 . 103511) (MSCALE 103513 . 103843) ( +MB.MARGINBAR.SHOWTAB 103845 . 106168) (MB.MARGINBAR.TABTRACK 106170 . 107490) (\TEDIT.TABTYPE.SET +107492 . 110134) (MARGINBAR.INIT 110136 . 111019)) (112038 128824 (\TEXTMENU.START 112048 . 115700) ( +\TEXTMENU.DOC.CREATE 115702 . 126031) (TEXTMENU.CLOSEFN 126033 . 128822)) (129134 148914 ( +\TEDITMENU.CREATE 129144 . 129440) (\TEDIT.EXPANDED.MENU 129442 . 130146) (MB.DEFAULTBUTTON.FN 130148 + . 133032) (\TEDITMENU.RECORD.UNFORMATTED 133034 . 133368) (MB.DEFAULTBUTTON.ACTIONFN 133370 . 148912) +) (148915 175047 (\TEDIT.CHARLOOKSMENU.CREATE 148925 . 151139) (\TEDIT.EXPANDEDCHARLOOKS.MENU 151141 + . 151499) (\TEDIT.APPLY.BOLDNESS 151501 . 151782) (\TEDIT.APPLY.CHARLOOKS 151784 . 153647) ( +\TEDIT.APPLY.OLINE 153649 . 153926) (\TEDIT.SHOW.CHARLOOKS 153928 . 155732) ( +\TEDIT.NEUTRALIZE.CHARLOOKS 155734 . 156672) (\TEDIT.FILL.IN.CHARLOOKS.MENU 156674 . 163698) ( +\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 163700 . 166361) (\TEDIT.PARSE.CHARLOOKS.MENU 166363 . 174198) ( +\TEDIT.APPLY.SLOPE 174200 . 174479) (\TEDIT.APPLY.STRIKEOUT 174481 . 174764) (\TEDIT.APPLY.ULINE +174766 . 175045)) (175048 204283 (\TEDITPARAMENU.CREATE 175058 . 175434) (\TEDIT.EXPANDEDPARA.MENU +175436 . 175755) (\TEDIT.APPLY.PARALOOKS 175757 . 186838) (\TEDIT.SHOW.PARALOOKS 186840 . 197014) ( +\TEDIT.NEUTRALIZE.PARALOOKS.MENU 197016 . 202970) (\TEDIT.RECORD.TABLEADERS 202972 . 204281)) (204284 +242617 (\TEDIT.SHOW.PAGEFORMATTING 204294 . 221103) (\TEDITPAGEMENU.CREATE 221105 . 222144) ( +\TEDIT.APPLY.PAGEFORMATTING 222146 . 234022) (TEDIT.UNPARSE.PAGEFORMAT 234024 . 242615)) (242922 +269775 (\TEDIT.MENU.INIT 242932 . 269773))))) STOP diff --git a/library/TEDITMENU.LCOM b/library/tedit/TEDIT-MENU.LCOM similarity index 99% rename from library/TEDITMENU.LCOM rename to library/tedit/TEDIT-MENU.LCOM index d94614c5cdf40694d174d693ce288c670e08fa1b..bc176b50834f28ad8906cbbd94432405030d4d5c 100644 GIT binary patch delta 563 zcmaF$g!T4g)(PPvh9~ivx z6LaixQ&VzMD~H;yvEJuOxw+w7+a(C!2#~< z?;8vZgrES&z(55=Jb;81G{9jK3>BXKB8JgPic0}1sNv)9=mJz0pb3@V?i|Z_n~za< PyIcl=fV9!S(XtD(n;O@|3Y0M zijG8H=(?U`hfceGAJ9Wy5Pa=K+uuGu>Sy-2A>eV-P)rqwz18k*I*}CnAar{X9LLVV z(sswU<)si2NDw-EuAf9wrxtc6-tSLX#wsW+qU%J#2>5@(nomm_U#zXn*H*aiN9!zl z+uw=mNW!4Ky9<9mgjGSf3o2SxZx+Ygr)MDWH*mteoi|Uo#f$l?ocqz32|*GEp&$I| zWLv@ZgTv6>+=@X!d$jmM;XNGCsyqj~tVU&(PO`EL1!=+HW-==Ee5lOsQ_P7 XWk<}wMoczh8i1AOSQSOS=X(5a)b72U diff --git a/library/TEDITPAGE b/library/tedit/TEDIT-PAGE similarity index 65% rename from library/TEDITPAGE rename to library/tedit/TEDIT-PAGE index 99f885d6..e75136ea 100644 --- a/library/TEDITPAGE +++ b/library/tedit/TEDIT-PAGE @@ -1,24 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Jan-2022 23:33:37" {DSK}kaplan>Local>medley3.5>my-medley>library>TEDITPAGE.;2 124691 +(FILECREATED "14-Jul-2022 16:55:51"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PAGE.;1 119264 - :CHANGES-TO (FNS TEDIT.FORMATHEADING TEDIT.FORMATFOLIO) - - :PREVIOUS-DATE "25-Aug-94 10:55:28" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITPAGE.;1) + :PREVIOUS-DATE "14-Jul-2022 12:45:04" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PAGE.;4) -(* ; " -Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-PAGECOMS) -(PRETTYCOMPRINT TEDITPAGECOMS) - -(RPAQQ TEDITPAGECOMS - ((FILES TEDITDCL) +(RPAQQ TEDIT-PAGECOMS + ((FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (COMS (* ;; "Page-numbering font specification/default") @@ -90,7 +85,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (FNS \TEDIT.FORMAT.FOOTNOTE)))) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -102,7 +97,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) @@ -145,15 +140,15 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (DEFINEQ (TEDIT.GET.PAGEFRAMES - [LAMBDA (FILE) (* jds "18-Jun-84 02:55") + [LAMBDA (FILE) (* jds "18-Jun-84 02:55") (* Read a bunch of page frames from - the file, and return it.) + the file, and return it.) (TEDIT.PARSE.PAGEFRAMES (READ FILE]) (TEDIT.PARSE.PAGEFRAMES - [LAMBDA (PAGELIST PARENT) (* jds "31-Jul-84 15:30") + [LAMBDA (PAGELIST PARENT) (* jds "31-Jul-84 15:30") (* Take an external pageframe and - internalize it.) + internalize it.) (PROG (FRAMETYPE PAGEFRAME) (COND ((type? PAGEREGION PAGELIST) @@ -165,21 +160,17 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. REGIONLOCALINFO _ (pop PAGELIST) REGIONSPEC _ (OR (pop PAGELIST) (LIST 0 0 0 0] - (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST - in (pop PAGELIST) - collect ( - TEDIT.PARSE.PAGEFRAMES - ALIST PAGEFRAME)) - ) + (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) + collect (TEDIT.PARSE.PAGEFRAMES ALIST + PAGEFRAME))) (RETURN PAGEFRAME)) - (T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect ( - TEDIT.PARSE.PAGEFRAMES - FRAMESPEC NIL]) + (T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES FRAMESPEC + NIL]) (TEDIT.PUT.PAGEFRAMES - [LAMBDA (FILE PAGEFRAMES) (* jds "13-Nov-86 20:10") + [LAMBDA (FILE PAGEFRAMES) (* jds "13-Nov-86 20:10") (* Put out a description of a set of - page-layout frames) + page-layout frames) (PROG (STR) (\DWOUT FILE 0) (* The length of this run of looks) (\SMALLPOUT FILE \PieceDescriptorPAGEFRAME) (* Mark this as a set of page frames) @@ -187,9 +178,9 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. FILE *TEDIT-FILE-READTABLE*]) (TEDIT.UNPARSE.PAGEFRAMES - [LAMBDA (PAGEFRAME) (* jds "31-Jul-84 15:00") + [LAMBDA (PAGEFRAME) (* jds "31-Jul-84 15:00") (* Take an internal page frame, and - create an equivalent list structure.) + create an equivalent list structure.) (COND [(LISTP PAGEFRAME) (LIST 'LIST (for FRAME in PAGEFRAME collect (TEDIT.UNPARSE.PAGEFRAMES FRAME] @@ -197,8 +188,9 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (fetch REGIONTYPE of PAGEFRAME) (fetch REGIONLOCALINFO of PAGEFRAME) (fetch REGIONSPEC of PAGEFRAME) - (for SUBREGION in (fetch REGIONSUBBOXES of PAGEFRAME) - collect (TEDIT.UNPARSE.PAGEFRAMES SUBREGION]) + (for SUBREGION in (fetch REGIONSUBBOXES of PAGEFRAME) collect ( + TEDIT.UNPARSE.PAGEFRAMES + SUBREGION]) ) @@ -209,7 +201,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (TEDIT.SINGLE.PAGEFORMAT [LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS - PAGEPROPS PAPERSIZE) (* ; "Edited 17-Dec-87 14:54 by jds") + PAGEPROPS PAPERSIZE) (* ; "Edited 17-Dec-87 14:54 by jds") (* ;; "Given a description in the args, create a pageframe to describe a single kind of page.") @@ -228,19 +220,19 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. PAGEWIDTH SUBREGIONS FOLIO FOLIOLEFT SCALEFACTOR HEADINGREGIONS) (SELECTQ UNITS ((POINTS NIL) (* ; - "If units are in printers points, the default, do no scaling") + "If units are in printers points, the default, do no scaling") (SETQ SCALEFACTOR 1)) (PICAS (* ; - "The units are in picas--12pts per. Scale all values.") + "The units are in picas--12pts per. Scale all values.") (SETQ SCALEFACTOR 12)) (INCHES (* ; - "The units are in inches, at 72.27pts per. Set the scale factor") + "The units are in inches, at 72.27pts per. Set the scale factor") (SETQ SCALEFACTOR 72)) (MICAS (* ; - "The units are MICAS, at 2540 to the inch.") + "The units are MICAS, at 2540 to the inch.") (SETQ SCALEFACTOR 0.02834646)) (CM (* ; - "Units are in CM, at 72.27/2.54pts per.") + "Units are in CM, at 72.27/2.54pts per.") (SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 72 2.54)))) (\ILLEGAL.ARG UNITS)) (* ; "We need to do the scaling.") (SETQ PX (SCALEPAGEXUNITS PX SCALEFACTOR PAPERSIZE LANDSCAPE?)) @@ -252,26 +244,22 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. [AND COLWIDTH (SETQ COLWIDTH (FIXR (FTIMES COLWIDTH SCALEFACTOR] [AND INTERCOL (SETQ INTERCOL (FIXR (FTIMES INTERCOL SCALEFACTOR] [SETQ HEADINGS (for HDG in HEADINGS collect (LIST (CAR HDG) - (SCALEPAGEXUNITS - (CADR HDG) - SCALEFACTOR PAPERSIZE - LANDSCAPE?) - (SCALEPAGEYUNITS - (CADDR HDG) - SCALEFACTOR PAPERSIZE - LANDSCAPE?] + (SCALEPAGEXUNITS (CADR HDG) + SCALEFACTOR PAPERSIZE LANDSCAPE?) + (SCALEPAGEYUNITS (CADDR HDG) + SCALEFACTOR PAPERSIZE LANDSCAPE?] (SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT) LEFT)) (COND [PAGE#S? (SELECTQ PQUAD (LEFT (* ; - "If the page number is flush left, set up the region to start where he specified.") + "If the page number is flush left, set up the region to start where he specified.") (SETQ FOLIOLEFT PX)) (RIGHT (* ; - "If it's flush right, set up the region to END there") + "If it's flush right, set up the region to END there") (SETQ FOLIOLEFT (IDIFFERENCE PX 288))) ((CENTERED NIL) (* ; - "Otherwise, center the page number around the point he specifies") + "Otherwise, center the page number around the point he specifies") (SETQ FOLIOLEFT (IDIFFERENCE PX 144))) (SHOULDNT)) [SETQ SUBREGIONS @@ -284,18 +272,18 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. BOTTOM _ PY WIDTH _ 288 HEIGHT _ 36] - (replace REGIONLOCALINFO of FOLIO - with (LIST 'PARALOOKS (LIST 'QUAD (OR PQUAD 'CENTERED)) - 'CHARLOOKS - (\TEDIT.UNPARSE.CHARLOOKS.LIST (\TEDIT.PARSE.CHARLOOKS.LIST - PFONT - TEDIT.DEFAULT.FOLIO.LOOKS)) - 'FORMATINFO - (LISTGET PAGEPROPS 'FOLIOINFO] + (replace REGIONLOCALINFO of FOLIO with (LIST 'PARALOOKS + (LIST 'QUAD (OR PQUAD 'CENTERED)) + 'CHARLOOKS + (\TEDIT.UNPARSE.CHARLOOKS.LIST + (\TEDIT.PARSE.CHARLOOKS.LIST + PFONT TEDIT.DEFAULT.FOLIO.LOOKS)) + 'FORMATINFO + (LISTGET PAGEPROPS 'FOLIOINFO] (T (SETQ SUBREGIONS NIL))) [COND (HEADINGS (* ; - "There are page headings specified for this page.") + "There are page headings specified for this page.") [SETQ HEADINGREGIONS (for HEADING in HEADINGS collect @@ -318,7 +306,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. [COND [(OR (NULL COLS) (IEQP COLS 1)) (* ; - "There is a single column, so treat it as just one text region bounded by the page margins.") + "There is a single column, so treat it as just one text region bounded by the page margins.") (SETQ SUBREGIONS (NCONC1 SUBREGIONS (create PAGEREGION @@ -331,10 +319,10 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) BOTTOM] (T (* ; - "There are several columns. We need to create a text box for each col.") + "There are several columns. We need to create a text box for each col.") [COND [(NULL COLWIDTH) (* ; - "He wants us to fill in the column width, given margins and intercolumn spacing.") + "He wants us to fill in the column width, given margins and intercolumn spacing.") (COND [INTERCOL (SETQ COLWIDTH (FIXR (FQUOTIENT (IDIFFERENCE PAGEWIDTH (ITIMES INTERCOL @@ -343,27 +331,26 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (T (* ; "Can't default both of them.") (SHOULDNT "Can't default both Col width and spacing"] ((NULL INTERCOL) (* ; - "Or else he wants to give us just the col width and have us calc the spacing.") + "Or else he wants to give us just the col width and have us calc the spacing.") (SETQ INTERCOL (FIXR (FQUOTIENT (IDIFFERENCE PAGEWIDTH (ITIMES COLWIDTH COLS)) (SUB1 COLS] - (for COL from 1 to COLS as CLEFT from LEFT - by (IPLUS COLWIDTH INTERCOL) + (for COL from 1 to COLS as CLEFT from LEFT by (IPLUS COLWIDTH INTERCOL) do (SETQ SUBREGIONS - (NCONC1 SUBREGIONS - (create PAGEREGION - REGIONFILLMETHOD _ 'TEXT - REGIONSPEC _ - (create REGION - LEFT _ CLEFT - BOTTOM _ BOTTOM - WIDTH _ COLWIDTH - HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) - BOTTOM] + (NCONC1 SUBREGIONS + (create PAGEREGION + REGIONFILLMETHOD _ 'TEXT + REGIONSPEC _ + (create REGION + LEFT _ CLEFT + BOTTOM _ BOTTOM + WIDTH _ COLWIDTH + HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) + BOTTOM] (replace REGIONSUBBOXES of PAGEREGION with SUBREGIONS) (RETURN PAGEREGION]) (TEDIT.COMPOUND.PAGEFORMAT - [LAMBDA (FIRST VERSO RECTO) (* jds "27-Jul-84 10:15") + [LAMBDA (FIRST VERSO RECTO) (* jds "27-Jul-84 10:15") (create PAGEREGION REGIONFILLMETHOD _ 'SEQUENCE REGIONSUBBOXES _ (LIST FIRST (create PAGEREGION @@ -374,7 +361,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. REGIONSPEC _ (LIST 0 0 0 0]) (TEDIT.PAGEFORMAT - [LAMBDA (STREAM FORMAT) (* ; "Edited 12-Jun-90 19:13 by mitani") + [LAMBDA (STREAM FORMAT) (* ; "Edited 12-Jun-90 19:13 by mitani") (* ;;; "Programmatic interface for page formatting") @@ -383,9 +370,8 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. ((AND (type? PAGEREGION FORMAT) (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of FORMAT))) (* ; - "This is a single page format. Make it a compound for ALL the pages.") - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (LIST FORMAT FORMAT FORMAT - )) + "This is a single page format. Make it a compound for ALL the pages.") + (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (LIST FORMAT FORMAT FORMAT)) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) ([OR (type? PAGEREGION FORMAT) (AND (LISTP FORMAT) @@ -396,7 +382,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with FORMAT) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) ((LISTP FORMAT) (* ; - "It's likely to be a list acceptable to the parser. Try it that way.") + "It's likely to be a list acceptable to the parser. Try it that way.") (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with FORMAT) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) (T (\ILLEGAL.ARG FORMAT]) @@ -409,9 +395,9 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (DEFINEQ (TEDIT.FORMAT.HARDCOPY - [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG ENDPG) - (* ; - "Edited 25-May-93 13:06 by sybalsky:mv:envos") + [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG ENDPG) + (* ; + "Edited 25-May-93 13:06 by sybalsky:mv:envos") (* ;;; "Format a document for hardcopy") @@ -443,58 +429,54 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. TEDIT.PAGE.FRAMES)) [COND ((LISTP PAGEFRAMES) (* ; - "If it's a list, pack it into a real set of specs.") + "If it's a list, pack it into a real set of specs.") (SETQ PAGEFRAMES (TEDIT.COMPOUND.PAGEFORMAT (CAR PAGEFRAMES) (CADR PAGEFRAMES) (CADDR PAGEFRAMES] (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) (replace PRESSREGION of FORMATTINGSTATE with TEDIT.DEFAULTPAGEREGION) (* ; - "Print in the usual region on the page") + "Print in the usual region on the page") [SETQ BREAKPAGETITLE (COND (BREAKPAGETITLE) ((LISTGET PRINTOPTIONS 'DOCUMENT.NAME)) ([OR (NOT (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (type? STRINGP (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ)) + (type? STRINGP (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (type? STREAM (fetch (STREAM FULLNAME) - of (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ))) + of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ))) (type? STRINGP (fetch (STREAM FULLNAME) - of (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ] + of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ] (* ; - "This isn't a real file, so print a generic name on the document break page.") + "This isn't a real file, so print a generic name on the document break page.") "TEdit Hardcopy Output") (T (* ; - "It's a real file, so use the file name on the break page.") - (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ - TXTFILE) - of TEXTOBJ] + "It's a real file, so use the file name on the break page.") + (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) + of TEXTOBJ] (SETQ BEFOREFN (TEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)) [COND (BEFOREFN (* ; - "Let the guy do any pre-hardcopy processing he wants to do") + "Let the guy do any pre-hardcopy processing he wants to do") (COND ((EQ 'DON'T (APPLY* BEFOREFN TEXTSTREAM TEXTOBJ)) (* ; - "If it says not to do the hardcopy, then don't.") + "If it says not to do the hardcopy, then don't.") (RETURN] [SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM STREAM] (RESETLST (SETQ AFTERFN (TEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)) (AND AFTERFN (RESETSAVE NIL (LIST AFTERFN TEXTSTREAM TEXTOBJ))) (* ; - "Set up to do the user's cleanup on the way out, as well.") + "Set up to do the user's cleanup on the way out, as well.") (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T) [COND ((AND FILE (OPENP FILE) (IMAGESTREAMTYPE FILE)) (* ; - "The file he handed us is already an image-type file. Just append the new stuff to it.") + "The file he handed us is already an image-type file. Just append the new stuff to it.") (SETQ WASOPEN T) (SETQ PRSTREAM FILE)) (T (* ; - "T'wasn't an image stream, so let's open us one.") + "T'wasn't an image stream, so let's open us one.") (RESETSAVE (SETQ PRSTREAM (OPENIMAGESTREAM SCRATCHFILE [OR IMAGETYPE (SETQ IMAGETYPE @@ -505,54 +487,52 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. 'BREAKPAGEFILENAME BREAKPAGETITLE))) '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] (* ; - "So we close and delete the file in case of trouble.") + "So we close and delete the file in case of trouble.") (STREAMPROP PRSTREAM 'FORMATTINGSTATE FORMATTINGSTATE) (* ; - "So that subsidiary people can find out the state of the formatting.") + "So that subsidiary people can find out the state of the formatting.") (* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). Thiss will cause a performance hit. Sigh. JDS 9/5/89") (DSPRIGHTMARGIN 131072 PRSTREAM) [while (ILEQ (fetch CHNO of FORMATTINGSTATE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) do + (* ;; "Must use (fetch TEXTLEN...) so that NS characters in an unformatted doc don't cause infinite loops.") - (* ;; "Must use (fetch TEXTLEN...) so that NS characters in an unformatted doc don't cause infinite loops.") + (* ;; "Format pages according to the existing layout:") - (* ;; "Format pages according to the existing layout:") + (for REGION inside PAGEFRAMES do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM + (fetch CHNO of FORMATTINGSTATE) + REGION FORMATTINGSTATE IMAGETYPE)) + (COND + ((EQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) + :NEW-PAGE-LAYOUT) - (for REGION inside PAGEFRAMES - do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch CHNO - of FORMATTINGSTATE) - REGION FORMATTINGSTATE IMAGETYPE)) - (COND - ((EQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) - :NEW-PAGE-LAYOUT) + (* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.") - (* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.") - - (SETQ PAGEFRAMES (fetch (PAGEFORMATTINGSTATE NEWPAGELAYOUT) - of FORMATTINGSTATE)) - - (* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)") - - (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of + (SETQ PAGEFRAMES (fetch (PAGEFORMATTINGSTATE NEWPAGELAYOUT) of FORMATTINGSTATE - with (SUB1 (fetch (PAGEFORMATTINGSTATE PAGECOUNT) - of FORMATTINGSTATE))) - (replace (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE - with 0) - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE - with :SEARCHING-FOR-EQUIVALENT-PAGE) - (COND - ((LISTP PAGEFRAMES) (* ; - "If it's a list, pack it into a real set of specs.") - (SETQ PAGEFRAMES (TEDIT.COMPOUND.PAGEFORMAT (CAR PAGEFRAMES) - (CADR PAGEFRAMES) - (CADDR PAGEFRAMES] + )) + + (* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)") + + (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE + with (SUB1 (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE)) + ) + (replace (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE with 0) + (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with + :SEARCHING-FOR-EQUIVALENT-PAGE + ) + (COND + ((LISTP PAGEFRAMES) (* ; + "If it's a list, pack it into a real set of specs.") + (SETQ PAGEFRAMES (TEDIT.COMPOUND.PAGEFORMAT (CAR PAGEFRAMES) + (CADR PAGEFRAMES) + (CADDR PAGEFRAMES] [COND ((NOT WASOPEN) (* ; - "Only if we created the image stream should we close it.") + "Only if we created the image stream should we close it.") (SETQ PRSTREAM (CLOSEF PRSTREAM)) (OR DONTSEND (SEND.FILE.TO.PRINTER PRSTREAM SERVER (APPEND PRINTOPTIONS (LIST 'DOCUMENT.NAME @@ -574,184 +554,171 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (SETQ LINES NIL) (SELECTQ (fetch REGIONFILLMETHOD of REGION) (TEXT (* ; - "A normal text region. Fill it with text formatted the usual way.") + "A normal text region. Fill it with text formatted the usual way.") [COND ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ; - "Only format if we're not looking for something else.") + "Only format if we're not looking for something else.") (CL:MULTIPLE-VALUE-SETQ (LINES NIL LAST-CHNO) (TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE]) (FOLIO (* ; - "A Page Number. Fill it in according to the instructions") + "A Page Number. Fill it in according to the instructions") [COND ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ; - "Only format if we're not looking for something else.") + "Only format if we're not looking for something else.") (SETQ LINES (TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE REGION]) (HEADING (* ; - "A Page heading. Fill it in from a text source we saved for the occasion.") + "A Page heading. Fill it in from a text source we saved for the occasion.") [COND ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ; - "Only format if we're not looking for something else.") - (SETQ LINES (TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE - REGION]) + "Only format if we're not looking for something else.") + (SETQ LINES (TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE REGION]) (PAGE (* ;; "This box is really a PAGE FRAME. Fill it in and do whatever other processing is needful for end of page.") (SETQ LINES NIL) (* ; - "This will send along its own lines to the printer.") + "This will send along its own lines to the printer.") (\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ; - "So that if this is the box he's looking for, we'll spot it and stop searching") + "So that if this is the box he's looking for, we'll spot it and stop searching") (TEDIT.FORMATPAGE TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE)) ((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT) (* ; - "This box is really a list of boxes. Fill them.") + "This box is really a list of boxes. Fill them.") (\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) (* ; - "So that if this is the box he's looking for, we'll spot it and stop searching") + "So that if this is the box he's looking for, we'll spot it and stop searching") (SELECTQ (fetch REGIONFILLMETHOD of REGION) ((SEQUENCE RECURSIVE) (* ; - "Just run thru filling in the sub-boxes in order.") - (bind SUBREGIONSPEC for SUBREGION - in (fetch (PAGEREGION REGIONSUBBOXES) of REGION) - while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) - of FORMATTINGSTATE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (OR (NOT (fetch (PAGEFORMATTINGSTATE PAGE#) - of FORMATTINGSTATE)) - (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) - of FORMATTINGSTATE)) - (ILEQ (fetch (PAGEFORMATTINGSTATE PAGE#) - of FORMATTINGSTATE) - (fetch (PAGEFORMATTINGSTATE MAXPAGE#) - of FORMATTINGSTATE))) - (NEQ (fetch (PAGEFORMATTINGSTATE STATE) - of FORMATTINGSTATE) - :NEW-PAGE-LAYOUT)) + "Just run thru filling in the sub-boxes in order.") + (bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) + of REGION) + while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (OR (NOT (fetch (PAGEFORMATTINGSTATE PAGE#) of + FORMATTINGSTATE + )) + (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of + FORMATTINGSTATE + )) + (ILEQ (fetch (PAGEFORMATTINGSTATE PAGE#) of + FORMATTINGSTATE + ) + (fetch (PAGEFORMATTINGSTATE MAXPAGE#) + of FORMATTINGSTATE))) + (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) + :NEW-PAGE-LAYOUT)) do [SETQ SUBREGIONSPEC (create REGION - using (fetch REGIONSPEC - of SUBREGION) - LEFT _ - (IPLUS (fetch (REGION LEFT) - of (fetch - REGIONSPEC - of - SUBREGION - )) - (fetch (REGION LEFT) - of REGIONSPEC)) - BOTTOM _ - (IPLUS (fetch (REGION BOTTOM) - of (fetch - REGIONSPEC - of - SUBREGION - )) - (fetch (REGION BOTTOM) - of REGIONSPEC] - (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch ( - PAGEFORMATTINGSTATE - CHNO) - of FORMATTINGSTATE) - (create PAGEREGION using SUBREGION REGIONSPEC _ - SUBREGIONSPEC) - FORMATTINGSTATE))) + using (fetch REGIONSPEC of SUBREGION) + LEFT _ + (IPLUS (fetch (REGION LEFT) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION LEFT) + of REGIONSPEC)) + BOTTOM _ + (IPLUS (fetch (REGION BOTTOM) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION BOTTOM) + of REGIONSPEC] + (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch (PAGEFORMATTINGSTATE + CHNO) of FORMATTINGSTATE) + (create PAGEREGION using SUBREGION REGIONSPEC _ + SUBREGIONSPEC) + FORMATTINGSTATE))) (ALTERNATE (* ; - "Run through the sub-boxes repeatedly in sequence.") - (while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) - of FORMATTINGSTATE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NEQ (fetch (PAGEFORMATTINGSTATE STATE) - of FORMATTINGSTATE) - :NEW-PAGE-LAYOUT)) + "Run through the sub-boxes repeatedly in sequence.") + (while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of + FORMATTINGSTATE + ) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of + FORMATTINGSTATE + ) + :NEW-PAGE-LAYOUT)) do (bind SUBREGIONSPEC for SUBREGION - in (fetch (PAGEREGION REGIONSUBBOXES) - of REGION) - while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE - CHNO) of - FORMATTINGSTATE - ) - (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ)) - (NEQ (fetch (PAGEFORMATTINGSTATE - STATE) of - FORMATTINGSTATE - ) - :NEW-PAGE-LAYOUT)) - do [SETQ SUBREGIONSPEC - (create REGION - using (fetch REGIONSPEC - of SUBREGION) - LEFT _ - (IPLUS (fetch (REGION LEFT) - of (fetch - REGIONSPEC - of SUBREGION) - ) - (fetch (REGION LEFT) - of REGIONSPEC)) - BOTTOM _ - (IPLUS (fetch (REGION BOTTOM) - of (fetch - REGIONSPEC - of SUBREGION) - ) - (fetch (REGION BOTTOM) - of REGIONSPEC] - (TEDIT.FORMATBOX TEXTOBJ PRSTREAM - (fetch (PAGEFORMATTINGSTATE CHNO) + in (fetch (PAGEREGION REGIONSUBBOXES) of REGION) + while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) - (create PAGEREGION - using SUBREGION REGIONSPEC _ - SUBREGIONSPEC) - FORMATTINGSTATE)))) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (NEQ (fetch (PAGEFORMATTINGSTATE STATE) + of FORMATTINGSTATE) + :NEW-PAGE-LAYOUT)) + do [SETQ SUBREGIONSPEC + (create REGION + using (fetch REGIONSPEC of SUBREGION) + LEFT _ (IPLUS (fetch (REGION LEFT) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION LEFT) + of REGIONSPEC)) + BOTTOM _ (IPLUS (fetch (REGION BOTTOM) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION BOTTOM) + of REGIONSPEC] + (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch ( + PAGEFORMATTINGSTATE + CHNO) + of FORMATTINGSTATE + ) + (create PAGEREGION using SUBREGION REGIONSPEC _ + SUBREGIONSPEC) + FORMATTINGSTATE)))) (SELECTION (* ; - "Do one or another box, depending on some criterion.")) + "Do one or another box, depending on some criterion.")) (SHOULDNT)) (* ; - "For now, draw a box around it, too.") + "For now, draw a box around it, too.") ) NIL) - (for LINE in LINES when LINE - do (* ; - "Run thru the lines displaying them all.") - (BLOCK) - (COND - ((OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE)) - (IGEQ (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE) - (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE))) + (for LINE in LINES when LINE do (* ; + "Run thru the lines displaying them all.") + (BLOCK) + (COND + ((OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) + of FORMATTINGSTATE)) + (IGEQ (fetch (PAGEFORMATTINGSTATE PAGE#) + of FORMATTINGSTATE) + (fetch (PAGEFORMATTINGSTATE MINPAGE#) + of FORMATTINGSTATE))) (* ; - "We're beyond the min page number -- go ahead and print the line") - (\TEDIT.HARDCOPY.DISPLAYLINE (fetch (TEXTSTREAM TEXTOBJ) - of (fetch (LINEDESCRIPTOR LTEXTOBJ) - of LINE)) - LINE - (fetch (LINEDESCRIPTOR CACHE) of LINE) - REGION PRSTREAM))) - [COND - ((EQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (LINEDESCRIPTOR - LTEXTOBJ) - of LINE))) + "We're beyond the min page number -- go ahead and print the line") + (\TEDIT.HARDCOPY.DISPLAYLINE (fetch (TEXTSTREAM TEXTOBJ + ) + of (fetch ( + LINEDESCRIPTOR + LTEXTOBJ) + of LINE)) + LINE + (fetch (LINEDESCRIPTOR CACHE) of LINE) + REGION PRSTREAM))) + [COND + ((EQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) + of (fetch (LINEDESCRIPTOR LTEXTOBJ) + of LINE))) - (* ;; - "This line refers back to the main text, so update the current-char pointer.") + (* ;; + "This line refers back to the main text, so update the current-char pointer.") - (* ;; - "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]") + (* ;; + "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]") - (SETQ CHNO (IMAX (OR CHNO 0) - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] - (push (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) of FORMATTINGSTATE) - LINE) - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with NIL)) + (SETQ CHNO (IMAX (OR CHNO 0) + (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) + of LINE] + (push (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) + of FORMATTINGSTATE) + LINE) + (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with NIL)) (COND (LAST-CHNO (* ; - "We got a definite last chno from FORMATTEXTBOX, so use it.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with LAST-CHNO - )) + "We got a definite last chno from FORMATTEXTBOX, so use it.") + (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with LAST-CHNO)) (CHNO (* ; - "Otherwise, use the new char no if we computed one.") + "Otherwise, use the new char no if we computed one.") (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO]) (TEDIT.FORMATHEADING @@ -834,9 +801,8 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (RETURN LINES]) (TEDIT.FORMATPAGE - [LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE) - (* ; - "Edited 4-Jul-93 00:29 by sybalskY:MV:ENVOS") + [LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE) (* ; + "Edited 4-Jul-93 00:29 by sybalskY:MV:ENVOS") (* ;; "Format a whole page -- run thru the page's sub-boxes filling them in by type:") @@ -868,38 +834,35 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) (* ; - "Print in the usual region on the page") + "Print in the usual region on the page") (COND ([AND (ILEQ CHNO TEXTLEN) (EQ 'NEWPAGELAYOUT (fetch FMTPARATYPE of (SETQ NEWPARALOOKS - (\TEDIT.APPLY.PARASTYLES - [fetch (PIECE PPARALOOKS) - of (SETQ PC (\CHTOPC CHNO - (fetch - (TEXTOBJ PCTB) - of TEXTOBJ] - PC TEXTOBJ] + (\TEDIT.APPLY.PARASTYLES + [fetch (PIECE PPARALOOKS) + of (SETQ PC (\CHTOPC CHNO (fetch (TEXTOBJ PCTB) + of TEXTOBJ] + PC TEXTOBJ] (* ;; "The first paragraph on this page starts a new page layout.") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with - :NEW-PAGE-LAYOUT - ) + (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with :NEW-PAGE-LAYOUT) [replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 (CDR (\TEDIT.PARABOUNDS TEXTOBJ CHNO] [replace (PAGEFORMATTINGSTATE NEWPAGELAYOUT) of FORMATTINGSTATE - with (TEDIT.PARSE.PAGEFRAMES (LISTGET (fetch (FMTSPEC FMTUSERINFO) - of NEWPARALOOKS) - 'NEWPAGELAYOUT] + with (TEDIT.PARSE.PAGEFRAMES (LISTGET (fetch (FMTSPEC FMTUSERINFO) of + NEWPARALOOKS + ) + 'NEWPAGELAYOUT] (RETURN))) (COND (PAGE# (* ; - "If we've already got a starting page number, don't set another one") + "If we've already got a starting page number, don't set another one") ) ((SETQ TPAGE (LISTGET PAGEPROPS 'STARTINGPAGE#)) (* ; - "If this page template specifies a starting page number, use it.") + "If this page template specifies a starting page number, use it.") (SETQ PAGE# TPAGE) (replace (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE with TPAGE)) (T (SETQ PAGE# 1) @@ -913,7 +876,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. 'LANDSCAPE)) (T (NCONC (fetch (STREAM OTHERPROPS) of PRSTREAM) (LIST 'PRINTERMODE 'LANDSCAPE](* ; - "Puts the info. into stream , IP creater may use") + "Puts the info. into stream , IP creater may use") (DSPPUSHSTATE PRSTREAM) (DSPROTATE 90 PRSTREAM) (DSPTRANSLATE 0 (- (ffetch (REGION HEIGHT) of PAGEREGION)) @@ -925,31 +888,32 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (SETQ STARTING-FILEPTR (GETFILEPTR PRSTREAM] (DSPCLIPPINGREGION PAGEREGION PRSTREAM) (* ; - "Set the clipping region to the whole sheet of paper.") + "Set the clipping region to the whole sheet of paper.") (DSPRIGHTMARGIN (fetch (REGION WIDTH) of PAGEREGION) PRSTREAM) [while [AND (ILEQ CHNO TEXTLEN) - (EQ 'PAGEHEADING (fetch FMTPARATYPE - of (fetch (PIECE PPARALOOKS) - of (\CHTOPC CHNO (fetch - (TEXTOBJ PCTB) - of TEXTOBJ] - do (* ; - "Go thru any leading page heading paras on the page.") - (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ 1 CHNO THISLINE (SETQ LINE (create + (EQ 'PAGEHEADING (fetch FMTPARATYPE + of (fetch (PIECE PPARALOOKS) + of (\CHTOPC CHNO (fetch (TEXTOBJ PCTB) + of TEXTOBJ] + do (* ; + "Go thru any leading page heading paras on the page.") + (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ 1 CHNO THISLINE (SETQ LINE (create LINEDESCRIPTOR - )) - PRSTREAM) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] + )) + PRSTREAM) + (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO) (for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of REGION) while (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) - TEXTLEN) do (* ; - "Now format the subregions of the page.") - (TEDIT.FORMATBOX TEXTOBJ PRSTREAM - (fetch (PAGEFORMATTINGSTATE CHNO) - of FORMATTINGSTATE) - SUBREGION FORMATTINGSTATE)) + TEXTLEN) do (* ; + "Now format the subregions of the page.") + (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch ( + PAGEFORMATTINGSTATE + CHNO) of + FORMATTINGSTATE + ) + SUBREGION FORMATTINGSTATE)) (DSPFONT PRE-EXISTING-FONT PRSTREAM) [COND (*TEDIT-PAGE-BREAKS* (SHOW.IP PRSTREAM) @@ -973,42 +937,34 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. FORMATTINGSTATE)) 'DON'T)) (OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE)) - (IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MINPAGE#) of - FORMATTINGSTATE - ))) + (IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE))) (OR (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)) - (ILESSP PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of - FORMATTINGSTATE - ] (* ; "There is more to print....") + (ILESSP PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE] + (* ; "There is more to print....") (DSPNEWPAGE PRSTREAM) (* ; "Force the new page") ) ((AND (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE) - (IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)) - ) (* ; - "We've run past the last page it wants formatted. Stop the world.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with - (ADD1 TEXTLEN))) + (IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE))) + (* ; + "We've run past the last page it wants formatted. Stop the world.") + (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 TEXTLEN))) ((EQ END-OF-PAGE-MARKER 'DON'T) (* ; - "The guy's e-o-page fn said stop. So stop.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with - (ADD1 TEXTLEN] + "The guy's e-o-page fn said stop. So stop.") + (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 TEXTLEN] (add (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE) - 1) + 1) (replace (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE with NIL) (replace (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE - with (pop (fetch (PAGEFORMATTINGSTATE PAGE#GENERATOR) of - FORMATTINGSTATE - ] + with (pop (fetch (PAGEFORMATTINGSTATE PAGE#GENERATOR) of FORMATTINGSTATE] (* ;; "Some things happen regardless of whether we're searching or not: Need to count pages we pass over to find an equivalent page in the new layout:") (add (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE) - 1]) + 1]) (TEDIT.FORMATTEXTBOX - [LAMBDA (TEXTOBJ PRSTREAM CH# PAGEREGION FORMATTINGSTATE) - (* ; - "Edited 3-Jul-93 22:14 by sybalskY:MV:ENVOS") + [LAMBDA (TEXTOBJ PRSTREAM CH# PAGEREGION FORMATTINGSTATE) (* ; + "Edited 3-Jul-93 22:14 by sybalskY:MV:ENVOS") (* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") @@ -1022,7 +978,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. ((CHNO CH#) [REGION (for VALUE in (ffetch (PAGEREGION REGIONSPEC) of PAGEREGION) collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM) - VALUE] + VALUE] (COLUMNBOTTOM (fetch (REGION BOTTOM) of REGION)) (FIRSTLINE T) (BREAKAFTERLASTPARA NIL) @@ -1036,58 +992,52 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (* ;; "Account for lines carried over from prior columns:") [while (AND (ILEQ COLUMNBOTTOM (fetch (REGION TOP) of REGION)) - (SETQ LINE (pop FOOTNOTELINES))) + (SETQ LINE (pop FOOTNOTELINES))) do - - (* ;; "Move as many potential footnote lines into this column as will fit.") + (* ;; "Move as many potential footnote lines into this column as will fit.") (* ; - "And move the bottom of the column up to account for them") - (COND - ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) of LINE)) - (fetch (REGION TOP) of REGION)) - (* ; - "If we ran out of room for footnotes, put this line back on the queue") - (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS IGNORE KEPT-ONE-LINE) - (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION - TEXTOBJ FORMATTINGSTATE)) - [COND - (KEPT-ONE-LINE (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - (SETQ FOOTNOTELINES (APPEND FOOTNOTE-REMNANTS FOOTNOTELINES)) - (RETURN)) - (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) - (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (freplace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE with - FOOTNOTELINES - ) (* ; - "Remember any remaining footnotes") + "And move the bottom of the column up to account for them") + (COND + ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) of LINE)) + (fetch (REGION TOP) of REGION)) (* ; + "If we ran out of room for footnotes, put this line back on the queue") + (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS IGNORE KEPT-ONE-LINE) + (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION TEXTOBJ + FORMATTINGSTATE)) + [COND + (KEPT-ONE-LINE (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (SETQ FOOTNOTELINES (APPEND FOOTNOTE-REMNANTS FOOTNOTELINES)) + (RETURN)) + (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) + (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (freplace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE with FOOTNOTELINES) + (* ; "Remember any remaining footnotes") [SETQ LINES (while (AND (ILEQ CHNO (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NOT FORCENEXTPAGE)) - collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) - of FORMATTINGSTATE)) - (create LINEDESCRIPTOR))) + (NOT FORCENEXTPAGE)) + collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) of + FORMATTINGSTATE + )) + (create LINEDESCRIPTOR))) (* ; - "Grab a line descriptor from the recycling list, or create a new one.") + "Grab a line descriptor from the recycling list, or create a new one.") (SETQ THISLINE (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - (create THISLINE))) - (* ; - "And a recycled or new THISLINE cache for char widths &c") + (create THISLINE))) (* ; + "And a recycled or new THISLINE cache for char widths &c") (BLOCK) (* ; - "Allow other things to happen while we format....") + "Allow other things to happen while we format....") (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) CHNO THISLINE LINE PRSTREAM)) (* ; - "Format the line, noting any form-feeds") + "Format the line, noting any form-feeds") (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) (* ; - "Mark this line as having cached print info.") - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch - (TEXTOBJ STREAMHINT) - of TEXTOBJ)) + "Mark this line as having cached print info.") + (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch (TEXTOBJ STREAMHINT) + of TEXTOBJ)) (* ; - "And remember the document it came from.") + "And remember the document it came from.") (COND ((fetch (LINEDESCRIPTOR LMARK) of LINE) @@ -1095,9 +1045,8 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) LINE) - ((LISTGET (fetch (FMTSPEC FMTUSERINFO) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) + ((LISTGET (fetch (FMTSPEC FMTUSERINFO) of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LINE)) 'FOOTNOTE) (* ;; "This paragraph is a footnote para.") @@ -1106,68 +1055,62 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (FORCENEXTPAGE (HELP))) (SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ PRSTREAM LINE REGION PAGEREGION FORMATTINGSTATE)) - [SETQ CHNO (PLUS 1 (fetch (LINEDESCRIPTOR CHARLIM) - of (CAR (FLAST FOOTNOTELINES] + [SETQ CHNO (PLUS 1 (fetch (LINEDESCRIPTOR CHARLIM) of (CAR (FLAST + FOOTNOTELINES + ] (* ; "Grab the lines of this footnote") [COND [(fetch (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE) (* ;; - "There are overflow footnote lines from this page already. Add to them.") + "There are overflow footnote lines from this page already. Add to them.") - (replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of - FORMATTINGSTATE - with (COPY (APPEND (fetch (PAGEFORMATTINGSTATE - PAGEFOOTNOTELINES) - of FORMATTINGSTATE) - FOOTNOTELINES] + (replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE + with (COPY (APPEND (fetch (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) + of FORMATTINGSTATE) + FOOTNOTELINES] (T (* ;; - "No overflow footnote lines yet. Try adding more footnotes to this page/column.") + "No overflow footnote lines yet. Try adding more footnotes to this page/column.") (for LINE in FOOTNOTELINES as REST on FOOTNOTELINES do (COND - ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE)) - (OR YBOT (fetch (REGION TOP) of REGION))) - (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS - IGNORE) - (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE - NIL 1 NIL REGION TEXTOBJ FORMATTINGSTATE 3 - (NOT FIRSTLINE))) - [replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) - of FORMATTINGSTATE - with (COPY (APPEND FOOTNOTE-REMNANTS (CDR REST] - [SETQ FINAL-CHNO (IMAX CHNO - (ADD1 (fetch (LINEDESCRIPTOR - CHARLIM) - of (CAR (FLAST REST] - [COND - (FIRSTLINE (* ; "If this overflowing footnote line happens before any real text line, go ahead and update the colbottom, because we want to stop here anyhow.") - (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE] - (RETURN)) - (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) - (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT - ) of LINE] + ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE)) + (OR YBOT (fetch (REGION TOP) of REGION))) + (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS + IGNORE) + (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL + REGION TEXTOBJ FORMATTINGSTATE 3 (NOT FIRSTLINE) + )) + [replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of + FORMATTINGSTATE + with (COPY (APPEND FOOTNOTE-REMNANTS (CDR REST] + [SETQ FINAL-CHNO (IMAX CHNO (ADD1 (fetch (LINEDESCRIPTOR + CHARLIM) + of (CAR (FLAST REST] + [COND + (FIRSTLINE (* ; "If this overflowing footnote line happens before any real text line, go ahead and update the colbottom, because we want to stop here anyhow.") + (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE] + (RETURN)) + (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) + (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE] NIL) (T (* ; - "This line must not represent a special item, e.g. a page heading. If it does, ignore it.") + "This line must not represent a special item, e.g. a page heading. If it does, ignore it.") (SETQ FMTSPEC (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - )) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) - (fetch (REGION LEFT) of REGION))) + (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) + (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC))) + (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) + (fetch (REGION LEFT) of REGION))) (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - )) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) - (fetch (REGION LEFT) of REGION))) + (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) + (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC))) + (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) + (fetch (REGION LEFT) of REGION))) (* ; "Format the next possible line") (SETQ SPECIALYPOS NIL) @@ -1178,18 +1121,16 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) (fetch (LINEDESCRIPTOR 1STLN) of LINE)) (* ; - "There is a special Y location for this paragraph. Move there") - (SETQ SPECIALYPOS (SETQ YBOT (fetch (FMTSPEC FMTSPECIALY) - of FMTSPEC] + "There is a special Y location for this paragraph. Move there") + (SETQ SPECIALYPOS (SETQ YBOT (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC] [(AND COLUMN-YBASE (\NEW-COLUMN-START LINE FMTSPEC)) (* ;; - "This is the first line of a new column; back YBOT back down to match the prior column.") + "This is the first line of a new column; back YBOT back down to match the prior column.") - (SETQ YBOT (- COLUMN-YBASE (fetch (LINEDESCRIPTOR DESCENT) - of LINE] + (SETQ YBOT (- COLUMN-YBASE (fetch (LINEDESCRIPTOR DESCENT) of LINE] [YBOT (* ; - "We're into it; take account of this line's height") + "We're into it; take account of this line's height") (COND [(fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) (SETQ LHEIGHT @@ -1197,13 +1138,11 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) (COND ((fetch (LINEDESCRIPTOR 1STLN) of LINE) - (IPLUS (OR (fetch (FMTSPEC LEADBEFORE) - of FMTSPEC) + (IPLUS (OR (fetch (FMTSPEC LEADBEFORE) of FMTSPEC) 0) (OR (fetch (FMTSPEC LEADAFTER) - of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of PREVLINE)) + of (fetch (LINEDESCRIPTOR LFMTSPEC) + of PREVLINE)) 0))) (T 0] (T (COND @@ -1212,15 +1151,14 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR - LHEIGHT) + LHEIGHT) of LINE] (T (* ; - "Just starting out; find the line's position with respect to the top of the region to be filled.") + "Just starting out; find the line's position with respect to the top of the region to be filled.") (SETQ YBOT (IDIFFERENCE (fetch (REGION TOP) of REGION) (IPLUS (fetch (LINEDESCRIPTOR LTRUEASCENT) of LINE) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE] + (fetch (LINEDESCRIPTOR DESCENT) of LINE] (COND ((AND (ILESSP YBOT COLUMNBOTTOM) (NOT SPECIALYPOS)) @@ -1234,31 +1172,31 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. ((AND (NOT FIRSTLINE) (fetch (LINEDESCRIPTOR 1STLN) of LINE) (SETQ NEWPAGETYPE (OR (fetch (FMTSPEC FMTNEWPAGEBEFORE) - of (fetch (LINEDESCRIPTOR LFMTSPEC - ) of LINE)) + of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LINE)) BREAKAFTERLASTPARA))) (* ;; - "We're supposed to put this line at the start of a new page/column (any box, later)") + "We're supposed to put this line at the start of a new page/column (any box, later)") (SETQ FORCENEXTPAGE 'USERBREAK) (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LINE)) (SETQ ORPHAN NIL) (COND ((NEQ NEWPAGETYPE T) (* ; - "This isn't simply go to a new box; we need to set up the search for it.") + "This isn't simply go to a new box; we need to set up the search for it.") (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'SEARCHING) - (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of - FORMATTINGSTATE + (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE with NEWPAGETYPE))) NIL) (T (* ; "This line is good; use it.") (COND - ((AND (fetch (FMTSPEC FMTNEWPAGEAFTER) - of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE))) + ((AND (fetch (FMTSPEC FMTNEWPAGEAFTER) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE))) (* ; - "We're supposed to put the line after this one at the start of a new page/column (any box, later)") + "We're supposed to put the line after this one at the start of a new page/column (any box, later)") (SETQ BREAKAFTERLASTPARA T))) (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) (COND @@ -1266,8 +1204,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. YBOT))) (T (SETQ PRIOR-COLUMN-YBOT YBOT))) (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) - of LINE))) + with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) [COND ((\FIRST-COLUMN-START LINE FMTSPEC) @@ -1275,15 +1212,15 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (SETQ COLUMN-YBASE (fetch (LINEDESCRIPTOR YBASE) of LINE] (SETQ FIRSTLINE NIL) (* ; - "Note that we have put text out on this page/column/box, for first line checking.") + "Note that we have put text out on this page/column/box, for first line checking.") (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) (* ; - "Keep track of the next character...") + "Keep track of the next character...") (SETQ PREVLINE LINE) LINE] (SETQ LINES (DREMOVE NIL LINES)) (* ; - "Remove any NILs from the line list; they're artifacts of running across page headings in-stream") - (TEDIT.HARDCOPY-COLUMN-END LINES ORPHAN FORCENEXTPAGE CHNO PAGEFOOTNOTES REGION TEXTOBJ + "Remove any NILs from the line list; they're artifacts of running across page headings in-stream") + (TEDIT.HARDCOPY-COLUMN-END LINES ORPHAN FORCENEXTPAGE CHNO PAGEFOOTNOTES REGION TEXTOBJ FORMATTINGSTATE FINAL-CHNO]) (TEDIT.FORMATFOLIO @@ -1373,7 +1310,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. LINE]) (\TEDIT.FORMAT.FOUNDBOX? - [LAMBDA (PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Apr-88 17:35 by jds") + [LAMBDA (PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Apr-88 17:35 by jds") (* ;;; "Return T if we're either not looking to begin in a new box, or we are and we've found it.") @@ -1381,18 +1318,16 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (SELECTQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) (FORMATTING (* ; - "we're just munching along formatting. Keep going.") + "we're just munching along formatting. Keep going.") T) (SEARCHING (* ; - "We're searching for a page box of the right type. Decide if this is it or not.") + "We're searching for a page box of the right type. Decide if this is it or not.") (COND - ((EQ (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE - ) + ((EQ (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE) (fetch (PAGEREGION REGIONTYPE) of PAGEREGION)) (* ; - "What we're looking for matches what we've got. Turn off the search and return T") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE - with 'FORMATTING) + "What we're looking for matches what we've got. Turn off the search and return T") + (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'FORMATTING) T))) (:SEARCHING-FOR-EQUIVALENT-PAGE (* ;; "We've switched document formats in mid-document, and need to find the corresponding page frame to continue properly.") @@ -1401,15 +1336,14 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. ((IEQP (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE) (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE)) (* ; - "We've formatted enough pages up to now.") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with - 'FORMATTING]) + "We've formatted enough pages up to now.") + (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'FORMATTING]) T]) (TEDIT.SKIP.SPECIALCOND - [LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM) - (* ; - "Edited 25-May-93 13:44 by sybalsky:mv:envos") + [LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM) + (* ; + "Edited 25-May-93 13:44 by sybalsky:mv:envos") (* ;; "This is a special-paragraph that should be skipped in this context (e.g. an EVEN para on an odd page). Then set LINE:CHARLIM so it will move the document ahead to the next real text.") @@ -1420,25 +1354,22 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. NPC PIECES) (SETQ NPC PC) (SETQ PIECES (repeatuntil [OR (NOT PC) - (AND (fetch (PIECE PPARALAST) of PC) - (OR (NOT NPC) - (NEQ (fetch FMTPARATYPE - of (fetch (PIECE PPARALOOKS) - of NPC)) - 'PAGEHEADING) - (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE - of (fetch - (PIECE PPARALOOKS) - of NPC] - collect (* ; - "GRAB THE PIECES FOR THIS HEADING.") + (AND (fetch (PIECE PPARALAST) of PC) + (OR (NOT NPC) + (NEQ (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) + of NPC)) + 'PAGEHEADING) + (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE + of (fetch (PIECE PPARALOOKS) + of NPC] + collect (* ; "GRAB THE PIECES FOR THIS HEADING.") (SETQ PC NPC) (AND PC (add LEN (fetch (PIECE PLEN) of PC)) (SETQ NPC (fetch (PIECE NEXTPIECE) of PC))) NIL)) (replace (LINEDESCRIPTOR LMARK) of LINE with 'SPECIAL) (* ; - "Mark this as text to skip, as far as the main formatter's concerned.") + "Mark this as text to skip, as far as the main formatter's concerned.") (replace (LINEDESCRIPTOR 1STLN) of LINE with T) (replace (LINEDESCRIPTOR LSTLN) of LINE with T) (replace (LINEDESCRIPTOR LHEIGHT) of LINE with 0) @@ -1448,7 +1379,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with 0) (replace (LINEDESCRIPTOR CHARLIM) of LINE with (SUB1 (IPLUS CHNO LEN))) (* ; - "Set the line's CHARLIM to be the last character in the page heading.") + "Set the line's CHARLIM to be the last character in the page heading.") ]) ) @@ -1471,19 +1402,16 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. NPC PIECES) (SETQ NPC PC) [SETQ PIECES (repeatuntil [OR (NOT PC) - (NOT (type? PIECE PC)) - (AND (fetch (PIECE PPARALAST) of PC) - (OR (NOT NPC) - (NEQ (fetch FMTPARATYPE - of (fetch (PIECE PPARALOOKS) - of NPC)) - 'PAGEHEADING) - (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE - of (fetch - (PIECE PPARALOOKS) - of NPC] - collect (* ; - "GRAB THE PIECES FOR THIS HEADING.") + (NOT (type? PIECE PC)) + (AND (fetch (PIECE PPARALAST) of PC) + (OR (NOT NPC) + (NEQ (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) + of NPC)) + 'PAGEHEADING) + (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE + of (fetch (PIECE PPARALOOKS) + of NPC] + collect (* ; "GRAB THE PIECES FOR THIS HEADING.") (SETQ PC NPC) (COND ((type? PIECE PC) @@ -1493,7 +1421,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (replace (LINEDESCRIPTOR LMARK) of LINE with T) (replace (LINEDESCRIPTOR CHARLIM) of LINE with (SUB1 (IPLUS CHNO LEN))) (* ; - "Set the line's CHARLIM to be the last character in the page heading.") + "Set the line's CHARLIM to be the last character in the page heading.") (replace (LINEDESCRIPTOR 1STLN) of LINE with T) (replace (LINEDESCRIPTOR LSTLN) of LINE with T) (replace (LINEDESCRIPTOR LHEIGHT) of LINE with 0) @@ -1514,7 +1442,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (TEDIT.HARDCOPY-COLUMN-END [LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE - FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 11-May-93 01:21 by jds") + FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 11-May-93 01:21 by jds") (* ;; "Do column-end processing for TEdit hardcopy -- widow elimination, respect keep-together specifications, etc.") @@ -1532,16 +1460,15 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (REMOVED-LINES (LIST ORPHAN))) [COND (LINES (* ; - "Only worry about widows and orphans if there are really lines to worry about") - [for LINE in LINES when (fetch (LINEDESCRIPTOR LMARK) of - LINE) + "Only worry about widows and orphans if there are really lines to worry about") + [for LINE in LINES when (fetch (LINEDESCRIPTOR LMARK) of LINE) do (DREMOVE LINE LINES) - (SETQ FINAL-CHNO (AND FINAL-CHNO (IMAX FINAL-CHNO - (ADD1 (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE] + (SETQ FINAL-CHNO (AND FINAL-CHNO (IMAX FINAL-CHNO (ADD1 (fetch ( + LINEDESCRIPTOR + CHARLIM) + of LINE] (SETQ LASTLINE (CAR (FLAST LINES))) (* ; - "Find the last line in this box (column or page)") + "Find the last line in this box (column or page)") [COND ((AND ORPHAN (fetch (LINEDESCRIPTOR LSTLN) of ORPHAN) (NOT (fetch (LINEDESCRIPTOR 1STLN) of ORPHAN))) @@ -1558,7 +1485,7 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LASTLINE) (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) (* ; - "The last line on the page is a widow. Remove it, too.") + "The last line on the page is a widow. Remove it, too.") (SETQ LINES (DREMOVE LASTLINE LINES)) (CL:PUSH LASTLINE REMOVED-LINES) (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LASTLINE)) @@ -1576,68 +1503,57 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. ([AND (NEQ FORCENEXTPAGE 'USERBREAK) (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (OR (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LASTLINE)) + (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LASTLINE)) - (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LASTLINE)) (NOT (FETCH (LINEDESCRIPTOR LSTLN) OF LASTLINE] (* ;; "Only do widow/orphan detection if this is NOT a page break the user asked for. And this isn't the end of the document.") (for LASTLINE in (REVERSE LINES) - while [OR (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LASTLINE)) - (AND (fetch (FMTSPEC FMTKEEP) of (fetch - (LINEDESCRIPTOR - LFMTSPEC) - of LASTLINE)) - (NOT (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE] - do + while [OR (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LASTLINE)) + (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LASTLINE)) + (NOT (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE] do - (* ;; "Run thru, removing any trailing headings. However, assure that there's at least one line on a page.") + (* ;; "Run thru, removing any trailing headings. However, assure that there's at least one line on a page.") finally (COND - [(AND LASTLINE (AND (NOT (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LASTLINE))) - (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE))) + [(AND LASTLINE (AND (NOT (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LASTLINE))) + (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE))) - (* ;; "OK we found a line that DOESN'T need to be kept with the other paragraphs. Chop off the list starting AFTER it.") + (* ;; "OK we found a line that DOESN'T need to be kept with the other paragraphs. Chop off the list starting AFTER it.") - [SETQ LINES (LDIFF LINES (SETQ LASTLINE (CDR (MEMB LASTLINE LINES] - (SETQ REMOVED-LINES (APPEND LASTLINE REMOVED-LINES)) - (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of (CAR LASTLINE] - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "WARNING: Page full of headings on page " - (fetch (PAGEFORMATTINGSTATE PAGE#) - of FORMATTINGSTATE] + [SETQ LINES (LDIFF LINES (SETQ LASTLINE (CDR (MEMB LASTLINE LINES] + (SETQ REMOVED-LINES (APPEND LASTLINE REMOVED-LINES)) + (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of (CAR LASTLINE] + (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "WARNING: Page full of headings on page " + (fetch (PAGEFORMATTINGSTATE PAGE#) of + FORMATTINGSTATE + ] [COND (FOOTNOTELINES (* ;; "There are footnotes--fix up their vertical locations, so they're aligned on the botton of the column.") (bind [YBOT _ (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) - (fetch (LINEDESCRIPTOR DESCENT) - of (CAR (FLAST FOOTNOTELINES] for LINE - in (REVERSE FOOTNOTELINES) do (replace (LINEDESCRIPTOR YBOT) - of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) - of LINE - with (IPLUS YBOT - (fetch ( + (fetch (LINEDESCRIPTOR DESCENT) of (CAR (FLAST FOOTNOTELINES] + for LINE in (REVERSE FOOTNOTELINES) + do (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( LINEDESCRIPTOR DESCENT) - of LINE))) - (add YBOT (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE] + of LINE))) + (add YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] (COND ((OR LINES FOOTNOTELINES) (* ; - "There really ARE lines in this column; take care of them.") + "There really ARE lines in this column; take care of them.") (CL:VALUES (APPEND LINES FOOTNOTELINES) REMOVED-LINES FINAL-CHNO NIL)) ((AND ORPHAN (NOT ORIGINAL-LINES) (NOT DONT-KEEP-SINGLE-LINE)) (* ; - "If there's only one line left for this box, return it anyhow.") + "If there's only one line left for this box, return it anyhow.") (CL:VALUES (CONS ORPHAN FOOTNOTELINES) NIL (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of ORPHAN)) @@ -1663,10 +1579,10 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (DEFINEQ (SCALEPAGEUNITS - [LAMBDA (VALUE FACTOR PAPERSIZE) (* jds "14-Jun-85 15:34") + [LAMBDA (VALUE FACTOR PAPERSIZE) (* jds "14-Jun-85 15:34") (* Scale a page-relative value into points%: Scale VALUE by FACTOR, then allow - for negative values to mean "come in from the other side by that much") + for negative values to mean "come in from the other side by that much") (AND VALUE (PROG [(TVAL (FIXR (FTIMES VALUE FACTOR))) (OTHEREDGE (SELECTQ PAPERSIZE @@ -1674,17 +1590,16 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. 612) (LEGAL 612) (fetch (TEDITPAPERSIZE TPSWIDTH) of (ASSOC PAPERSIZE - TEDIT.PAPER.SIZES - ] + TEDIT.PAPER.SIZES] [COND ((ILESSP TVAL 0) (* He specified this value as an - offset from the opposite edge. - Convert it.) + offset from the opposite edge. + Convert it.) (SETQ TVAL (IPLUS OTHEREDGE TVAL] (RETURN TVAL]) (SCALEPAGEXUNITS - [LAMBDA (VALUE FACTOR PAPERSIZE LANDSCAPE?) (* ; "Edited 21-Apr-88 10:46 by jds") + [LAMBDA (VALUE FACTOR PAPERSIZE LANDSCAPE?) (* ; "Edited 21-Apr-88 10:46 by jds") (* ;; "Scale a page-relative value into points: Scale VALUE by FACTOR, then allow for negative values to mean 'come in from the other side by that much'") @@ -1692,13 +1607,13 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. OTHEREDGE) [COND ((ILESSP TVAL 0) (* ; - "He specified this value as an offset from the opposite edge. Convert it.") + "He specified this value as an offset from the opposite edge. Convert it.") (SETQ OTHEREDGE (\TEDIT.PAPERWIDTH PAPERSIZE LANDSCAPE?)) (SETQ TVAL (IPLUS OTHEREDGE TVAL] (RETURN TVAL]) (SCALEPAGEYUNITS - [LAMBDA (VALUE FACTOR PAPERSIZE LANDSCAPE?) (* ; "Edited 17-Dec-87 14:52 by jds") + [LAMBDA (VALUE FACTOR PAPERSIZE LANDSCAPE?) (* ; "Edited 17-Dec-87 14:52 by jds") (* ;; "Scale a page-relative value into points: Scale VALUE by FACTOR, then allow for negative values to mean 'come in from the other side by that much'") @@ -1706,47 +1621,47 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. OTHEREDGE) [COND ((ILESSP TVAL 0) (* ; - "He specified this value as an offset from the opposite edge. Convert it.") + "He specified this value as an offset from the opposite edge. Convert it.") (SETQ OTHEREDGE (\TEDIT.PAPERHEIGHT PAPERSIZE LANDSCAPE?)) (SETQ TVAL (IPLUS OTHEREDGE TVAL] (RETURN TVAL]) (\TEDIT.PAPERHEIGHT - [LAMBDA (PAPERSIZE LANDSCAPE?) (* ; "Edited 29-Dec-86 15:06 by jds") + [LAMBDA (PAPERSIZE LANDSCAPE?) (* ; "Edited 29-Dec-86 15:06 by jds") (* ;;; "Compute the HEIGHT of a sheet of paper, according to PAPERSIZE, in points.") (COND (LANDSCAPE? (* ; - "The paper is landscape, so its height is the WIDTH of the same paper size, normal.") + "The paper is landscape, so its height is the WIDTH of the same paper size, normal.") (\TEDIT.PAPERWIDTH PAPERSIZE NIL)) (T (* ; - "Not landscape, so look up the size spec:") + "Not landscape, so look up the size spec:") (SELECTQ PAPERSIZE ((NIL LETTER Letter) 792) - ((Legal |8.5x14| LEGAL) + ((Legal 8.5x14 LEGAL) 1008) ((A4 a4) 842) (fetch (TEDITPAPERSIZE TPSHEIGHT) of (ASSOC PAPERSIZE TEDIT.PAPER.SIZES]) (\TEDIT.PAPERWIDTH - [LAMBDA (PAPERSIZE LANDSCAPE?) (* ; "Edited 9-Dec-87 20:10 by jds") + [LAMBDA (PAPERSIZE LANDSCAPE?) (* ; "Edited 9-Dec-87 20:10 by jds") (* ;;; "Compute the WIDTH of a sheet of paper, according to PAPERSIZE and LANDSCAPE?") (LET (CANONICAL-PAPERSIZE) (COND (LANDSCAPE? (* ; - "It's landscape paper, so look at the HEIGHT of the corresponding normal paper.") + "It's landscape paper, so look at the HEIGHT of the corresponding normal paper.") (\TEDIT.PAPERHEIGHT PAPERSIZE NIL)) (T (* ; - "Not landscape, so look up the size spec:") + "Not landscape, so look up the size spec:") (SELECTQ PAPERSIZE - ((NIL Letter LETTER |8.5x11|) (* ; "letter size paper, 8.5inx11in") + ((NIL Letter LETTER 8.5x11) (* ; "letter size paper, 8.5inx11in") 612) - ((Legal LEGAL |8.5x14|) + ((Legal LEGAL 8.5x14) 612) ((A4 a4) (* ; "A4 ISO-size paper, 210mmx297mm") 595) @@ -1781,61 +1696,61 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (DEFINEQ (ROMANNUMERALS - [LAMBDA (NUMBER UCFLG) (* jds "12-Jul-85 13:19") + [LAMBDA (NUMBER UCFLG) (* jds "12-Jul-85 13:19") (* * Take a NUMBER, and render it as a string of roman numerals. - If UCFLG, then the numerals will be upper-case; - otherwise, they are lower-case.) + If UCFLG, then the numerals will be upper-case; + otherwise, they are lower-case.) (PROG ((CHARS NIL)) [while (NOT (ZEROP NUMBER)) do (COND - ((IGEQ NUMBER 1000) - (push CHARS 'm) - (add NUMBER -1000)) - ((IGEQ NUMBER 900) - (push CHARS 'c) - (push CHARS 'm) - (add NUMBER -900)) - ((IGEQ NUMBER 500) - (push CHARS 'd) - (add NUMBER -500)) - ((IGEQ NUMBER 400) - (push CHARS 'c) - (push CHARS 'd) - (add NUMBER -400)) - ((IGEQ NUMBER 100) - (push CHARS 'c) - (add NUMBER -100)) - ((IGEQ NUMBER 90) - (push CHARS 'x) - (push CHARS 'c) - (add NUMBER -90)) - ((IGEQ NUMBER 50) - (push CHARS 'l) - (add NUMBER -50)) - ((IGEQ NUMBER 40) - (push CHARS 'x) - (push CHARS 'l) - (add NUMBER -40)) - ((IGEQ NUMBER 10) - (push CHARS 'x) - (add NUMBER -10)) - ((IGEQ NUMBER 9) - (push CHARS 'i) - (push CHARS 'x) - (add NUMBER -9)) - ((IGEQ NUMBER 5) - (push CHARS 'v) - (add NUMBER -5)) - ((IGEQ NUMBER 4) - (push CHARS 'i) - (push CHARS 'v) - (add NUMBER -4)) - (T (push CHARS 'i) - (add NUMBER -1] + ((IGEQ NUMBER 1000) + (push CHARS 'm) + (add NUMBER -1000)) + ((IGEQ NUMBER 900) + (push CHARS 'c) + (push CHARS 'm) + (add NUMBER -900)) + ((IGEQ NUMBER 500) + (push CHARS 'd) + (add NUMBER -500)) + ((IGEQ NUMBER 400) + (push CHARS 'c) + (push CHARS 'd) + (add NUMBER -400)) + ((IGEQ NUMBER 100) + (push CHARS 'c) + (add NUMBER -100)) + ((IGEQ NUMBER 90) + (push CHARS 'x) + (push CHARS 'c) + (add NUMBER -90)) + ((IGEQ NUMBER 50) + (push CHARS 'l) + (add NUMBER -50)) + ((IGEQ NUMBER 40) + (push CHARS 'x) + (push CHARS 'l) + (add NUMBER -40)) + ((IGEQ NUMBER 10) + (push CHARS 'x) + (add NUMBER -10)) + ((IGEQ NUMBER 9) + (push CHARS 'i) + (push CHARS 'x) + (add NUMBER -9)) + ((IGEQ NUMBER 5) + (push CHARS 'v) + (add NUMBER -5)) + ((IGEQ NUMBER 4) + (push CHARS 'i) + (push CHARS 'v) + (add NUMBER -4)) + (T (push CHARS 'i) + (add NUMBER -1] (RETURN (COND - [UCFLG (* The caller wants his roman - numerals upper case) + [UCFLG (* The caller wants his roman numerals + upper case) (U-CASE (CONCATLIST (REVERSE CHARS] (T (CONCATLIST (REVERSE CHARS]) ) @@ -1856,59 +1771,57 @@ Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation. (STREAMSCALE (DSPSCALE NIL PRSTREAM)) THISLINE LINE YBOT LINES ORPHAN LASTLINE PREVLINE LHEIGHT FMTSPEC SPECIALYPOS NEWPAGETYPE) (SETQ LINES (while [AND (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (OR (NOT PREVLINE) - (NOT (fetch (LINEDESCRIPTOR LSTLN) of PREVLINE] - collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE - PAGELINECACHE) - of FORMATTINGSTATE)) - (create LINEDESCRIPTOR))) + (OR (NOT PREVLINE) + (NOT (fetch (LINEDESCRIPTOR LSTLN) of PREVLINE] + collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) + of FORMATTINGSTATE)) + (create LINEDESCRIPTOR))) (* ; - "Grab a line descriptor from the recycling list, or create a new one.") + "Grab a line descriptor from the recycling list, or create a new one.") (SETQ THISLINE (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) (create THISLINE))) (* ; - "And a recycled or new THISLINE cache for char widths &c") + "And a recycled or new THISLINE cache for char widths &c") (BLOCK) (* ; - "Allow other things to happen while we format....") - (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) - of REGION) + "Allow other things to happen while we format....") + (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) CHNO THISLINE LINE PRSTREAM) (* ; - "Format the line, noting any form-feeds") + "Format the line, noting any form-feeds") (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) (* ; - "Mark this line as having cached print info.") - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE - with (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) + "Mark this line as having cached print info.") + (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch (TEXTOBJ + STREAMHINT + ) + of TEXTOBJ)) (* ; - "And remember the document it came from.") + "And remember the document it came from.") (SETQ FMTSPEC (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) + (fetch (REGION LEFT) of REGION)) (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) + (fetch (REGION LEFT) of REGION)) (* ; "Format the next possible line") (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) (* ; - "Keep track of the next character...") + "Keep track of the next character...") (SETQ PREVLINE LINE) LINE)) (SETQ LINES (DREMOVE NIL LINES)) (* ; - "Remove any NILs from the line list; they're artifacts of running across page headings in-stream") + "Remove any NILs from the line list; they're artifacts of running across page headings in-stream") LINES]) ) -(PUTPROPS TEDITPAGE COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 -1993 1994)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5196 8751 (TEDIT.GET.PAGEFRAMES 5206 . 5558) (TEDIT.PARSE.PAGEFRAMES 5560 . 7263) ( -TEDIT.PUT.PAGEFRAMES 7265 . 7893) (TEDIT.UNPARSE.PAGEFRAMES 7895 . 8749)) (8797 21640 ( -TEDIT.SINGLE.PAGEFORMAT 8807 . 19366) (TEDIT.COMPOUND.PAGEFORMAT 19368 . 19994) (TEDIT.PAGEFORMAT -19996 . 21638)) (21727 98018 (TEDIT.FORMAT.HARDCOPY 21737 . 32809) (TEDIT.FORMATBOX 32811 . 48118) ( -TEDIT.FORMATHEADING 48120 . 54287) (TEDIT.FORMATPAGE 54289 . 65860) (TEDIT.FORMATTEXTBOX 65862 . 86180 -) (TEDIT.FORMATFOLIO 86182 . 92701) (\TEDIT.FORMAT.FOUNDBOX? 92703 . 94892) (TEDIT.SKIP.SPECIALCOND -94894 . 98016)) (98098 101299 (TEDIT.HARDCOPY.PAGEHEADING 98108 . 101297)) (101408 111075 ( -TEDIT.HARDCOPY-COLUMN-END 101418 . 111073)) (111120 116124 (SCALEPAGEUNITS 111130 . 112358) ( -SCALEPAGEXUNITS 112360 . 113124) (SCALEPAGEYUNITS 113126 . 113891) (\TEDIT.PAPERHEIGHT 113893 . 114822 -) (\TEDIT.PAPERWIDTH 114824 . 116122)) (116540 120454 (ROMANNUMERALS 116550 . 120452)) (120490 124556 -(\TEDIT.FORMAT.FOOTNOTE 120500 . 124554))))) + (FILEMAP (NIL (5090 8513 (TEDIT.GET.PAGEFRAMES 5100 . 5454) (TEDIT.PARSE.PAGEFRAMES 5456 . 6879) ( +TEDIT.PUT.PAGEFRAMES 6881 . 7511) (TEDIT.UNPARSE.PAGEFRAMES 7513 . 8511)) (8559 21110 ( +TEDIT.SINGLE.PAGEFORMAT 8569 . 18906) (TEDIT.COMPOUND.PAGEFORMAT 18908 . 19538) (TEDIT.PAGEFORMAT +19540 . 21108)) (21197 94262 (TEDIT.FORMAT.HARDCOPY 21207 . 31947) (TEDIT.FORMATBOX 31949 . 46666) ( +TEDIT.FORMATHEADING 46668 . 52835) (TEDIT.FORMATPAGE 52837 . 63761) (TEDIT.FORMATTEXTBOX 63763 . 82761 +) (TEDIT.FORMATFOLIO 82763 . 89282) (\TEDIT.FORMAT.FOUNDBOX? 89284 . 91343) (TEDIT.SKIP.SPECIALCOND +91345 . 94260)) (94342 97315 (TEDIT.HARDCOPY.PAGEHEADING 94352 . 97313)) (97424 106093 ( +TEDIT.HARDCOPY-COLUMN-END 97434 . 106091)) (106138 111079 (SCALEPAGEUNITS 106148 . 107289) ( +SCALEPAGEXUNITS 107291 . 108061) (SCALEPAGEYUNITS 108063 . 108834) (\TEDIT.PAPERHEIGHT 108836 . 109771 +) (\TEDIT.PAPERWIDTH 109773 . 111077)) (111495 115063 (ROMANNUMERALS 111505 . 115061)) (115099 119241 +(\TEDIT.FORMAT.FOOTNOTE 115109 . 119239))))) STOP diff --git a/library/TEDITPAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM similarity index 96% rename from library/TEDITPAGE.LCOM rename to library/tedit/TEDIT-PAGE.LCOM index 8e578c39bcb2b39c1c37734f61913149976489ec..f16811514ecca730efb5e03ade13b02fe8ea27e0 100644 GIT binary patch delta 556 zcmeBu$oT0#OlGK#U61xyr7tavg07rLMJ!?Zv z1tk<4jI9hUtqjbS6u6R#Qj_y@3o>(3QxsAw3W|zVtrYU|OEQ4wDrDx>D=4{z`uHdy zYu3}#Q&LDt1loelP(vdnO)d>LPajw3AXi7ABhVB9{bp)qY6!Hs+9lY#)&{=^>xuTE zf}x?Mk(r5tRX~tyn5Tbeu&xWxb_Fg}e;Zkum|7W_C@BzQInZu3qJr0Cb2!uABzGJU1Xh!Rqd6`c0v^4$dBF)W$PI9`?6x}Qq^5$aZ*|<*Yg_$^AFA1%lqrAWppue_a zL)Q(xgJ4|Ki>jDrIh}w&uc!6wsj>Qz9j(4Rd9=(*K<>!*;m=t`Q4mbhIUD$IXUk}4 zND@TX^Bp^KEJopYqI}+{G7*j z@Fr%KM4>et!tX!fSrG4yiZ|I+OkW*>C~)ss$q%e9YYL@Jb$v%aAFQ+Dc7HC0qa=)i za68A}06PfJBd^y_Ktw0ByrS?7&S+g-gI(3rs!r!wRU%MHhY2SgokNR5n?r{KVL%!j RROT!p8V{S2Bn&)X_ythk!7Km( diff --git a/library/PCTREE b/library/tedit/TEDIT-PCTREE similarity index 66% rename from library/PCTREE rename to library/tedit/TEDIT-PCTREE index 60399803..dc8e3739 100644 --- a/library/PCTREE +++ b/library/tedit/TEDIT-PCTREE @@ -1,23 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Jun-2022 10:29:01" {DSK}larry>medley>library>PCTREE.;2 28282 +(FILECREATED "14-Jul-2022 17:00:01"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;1 27141 - :CHANGES-TO (FNS \INSERTTREE) - - :PREVIOUS-DATE "19-Apr-2018 12:19:49" {DSK}larry>medley>library>PCTREE.;1) + :PREVIOUS-DATE "14-Jul-2022 11:08:10" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-PCTREE.;2) -(* ; " -Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-PCTREECOMS) -(PRETTYCOMPRINT PCTREECOMS) - -(RPAQQ PCTREECOMS +(RPAQQ TEDIT-PCTREECOMS [ (* ;; "Balanced tree PIECE TABLE supporting functions") - (FILES TEDITDCL) + (FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).") @@ -38,7 +34,7 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1) 4))) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (FNS UPDATEPCNODES FINDPCNODE \FIRSTNODE \DELETETREE \INSERTTREE \LASTNODE \MATCHPCS \SPLITTREE \TEDIT.UPDATETREE \TEDIT.PIECE-CHNO \TEDIT.SET-TOTLEN) (FNS DISPTREE TREEGRAPHNODE) @@ -52,7 +48,7 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (* ;; "Balanced tree PIECE TABLE supporting functions") -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -83,36 +79,35 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DEFINEQ (UPDATEPCNODES - [LAMBDA (PC DELTA) (* ; "Edited 21-Apr-93 16:09 by jds") + [LAMBDA (PC DELTA) (* ; "Edited 21-Apr-93 16:09 by jds") (* ;; "ADD DELTA TO CHNUM IN NEXTALL NODES OF TOPNODE.") (LET ((UPWARD (fetch (PIECE PTREENODE) of PC))) - (while UPWARD do (for I from 0 by 4 as ITEM from 1 - to (fetch (BTREENODE COUNT) of UPWARD) - when (EQ PC (\GETBASEPTR UPWARD I)) - do [\PUTBASEFIXP UPWARD (IPLUS I 2) - (IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2] - (add (fetch (BTREENODE TOTLEN) of UPWARD) - DELTA) - (SETQ PC UPWARD) - (SETQ UPWARD (fetch (BTREENODE UPWARD) of PC)) - (RETURN) finally (HELP "Piece not in its TREENODE"]) + (while UPWARD do (for I from 0 by 4 as ITEM from 1 to (fetch (BTREENODE COUNT) of UPWARD) + when (EQ PC (\GETBASEPTR UPWARD I)) + do [\PUTBASEFIXP UPWARD (IPLUS I 2) + (IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2] + (add (fetch (BTREENODE TOTLEN) of UPWARD) + DELTA) + (SETQ PC UPWARD) + (SETQ UPWARD (fetch (BTREENODE UPWARD) of PC)) + (RETURN) finally (HELP "Piece not in its TREENODE"]) (FINDPCNODE - [LAMBDA (PC PCTB) (* ; "Edited 13-Apr-93 15:00 by jds") + [LAMBDA (PC PCTB) (* ; "Edited 13-Apr-93 15:00 by jds") (* ;; "Given a piece and the pctb it's in, return pcnode") (fetch (PIECE PTREENODE) of PC]) (\FIRSTNODE - [LAMBDA (TREE) (* ; "Edited 14-Apr-93 02:06 by jds") + [LAMBDA (TREE) (* ; "Edited 14-Apr-93 02:06 by jds") (LET ((COUNT (fetch (BTREENODE COUNT) of TREE)) CHILD) (SETQ CHILD (\GETBASEPTR TREE 0)) @@ -122,8 +117,8 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (T TREE]) (\DELETETREE - [LAMBDA (OLD PCNODE) (* ; - "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") + [LAMBDA (OLD PCNODE) (* ; + "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") (* ;; "Removes OLD from PCNODE. OLD is either a piece or tree node.") @@ -138,9 +133,8 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (* ;; "Find OLD, .") (for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT) - 2) by 4 - when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) do (RETURN) - finally (HELP "Piece/node not in PCNODE")) + 2) by 4 when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) + do (RETURN) finally (HELP "Piece/node not in PCNODE")) (* ;; "Update the previous piece's length, if appropriate:") @@ -148,10 +142,10 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (\RPLPTR BB 0 NIL) [for I from 0 to (IDIFFERENCE \BTREELASTREALOFFSET ITEM#) by 4 do (\PUTBASEPTR BB I (\GETBASEPTR BB (IPLUS I 4))) - (\PUTBASEFIXP BB (IPLUS I 2) - (\GETBASEFIXP BB (IPLUS I 6] + (\PUTBASEFIXP BB (IPLUS I 2) + (\GETBASEFIXP BB (IPLUS I 6] (\PUTBASEPTR PCNODE \BTREELASTREALOFFSET NIL) (* ; - "Because it's been copied, clear the old value before the refcnt-er gets to it.") + "Because it's been copied, clear the old value before the refcnt-er gets to it.") (* ;; " If adding this piece EMPTIES the tree node, DELETE it.") @@ -161,11 +155,11 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. ((IEQP NODE-COUNT 1) (\DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE))) (T (* ; - "No split, so update upper nodes with delta-length.") + "No split, so update upper nodes with delta-length.") [SETQ NEWLEN (replace (BTREENODE TOTLEN) of PCNODE - with (for I from 2 to NODE-COUNT as ITEM# from 2 - by 4 sum (\GETBASEFIXP PCNODE ITEM#] + with (for I from 2 to NODE-COUNT as ITEM# from 2 by 4 + sum (\GETBASEFIXP PCNODE ITEM#] (replace (BTREENODE COUNT) of PCNODE with (SUB1 NODE-COUNT)) (\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN] @@ -257,36 +251,33 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. 1))]) (\LASTNODE - [LAMBDA (TREE) (* ; "Edited 14-Apr-93 16:29 by jds") + [LAMBDA (TREE) (* ; "Edited 14-Apr-93 16:29 by jds") (LET ((COUNT (fetch (BTREENODE COUNT) of TREE)) CHILD) (for ITEM# from (LLSH (IDIFFERENCE COUNT 1) - 2) to 0 by -4 when (SETQ CHILD (\GETBASEPTR TREE - ITEM#)) + 2) to 0 by -4 when (SETQ CHILD (\GETBASEPTR TREE ITEM#)) do (RETURN (COND - ((type? BTREENODE CHILD) - (\LASTNODE CHILD)) - (T TREE]) + ((type? BTREENODE CHILD) + (\LASTNODE CHILD)) + (T TREE]) (\MATCHPCS - [LAMBDA (PCNODE) (* ; "Edited 5-May-93 17:57 by jds") + [LAMBDA (PCNODE) (* ; "Edited 5-May-93 17:57 by jds") (* ;; "Make sure that any pieces pointed to this node point back to this node.") - (bind PC for OFFSET from 0 to \WORDSINBTREEMAIN by 4 as I from 1 - to (fetch (BTREENODE COUNT) of PCNODE) do (SETQ PC (\GETBASEPTR PCNODE OFFSET) - ) - (COND - ((type? PIECE PC) - (replace (PIECE PTREENODE) - of PC with PCNODE)) - ((type? BTREENODE PC) - (replace (BTREENODE UPWARD) - of PC with PCNODE]) + (bind PC for OFFSET from 0 to \WORDSINBTREEMAIN by 4 as I from 1 to (fetch (BTREENODE COUNT) + of PCNODE) + do (SETQ PC (\GETBASEPTR PCNODE OFFSET)) + (COND + ((type? PIECE PC) + (replace (PIECE PTREENODE) of PC with PCNODE)) + ((type? BTREENODE PC) + (replace (BTREENODE UPWARD) of PC with PCNODE]) (\SPLITTREE - [LAMBDA (PCNODE) (* ; - "Edited 21-Mar-95 15:26 by sybalsky:mv:envos") + [LAMBDA (PCNODE) (* ; + "Edited 21-Mar-95 15:26 by sybalsky:mv:envos") (* ;; "We're adding piece NEW in front of OLD. OLD is represented in the B-tree node PCNODE, which is full.") @@ -299,58 +290,55 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (UPWARD (* ;; - "Easy case: This is not the root node, so split the node and propogate up.") + "Easy case: This is not the root node, so split the node and propogate up.") (SETQ NEW1 (create BTREENODE using PCNODE)) (* ;; "Clean out upper 3 child entries, leaving only the lower 2. Have to tell GC about actual child slots being set to NIL (hence \RPLPTRs):") - (for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN - by 4 do (\RPLPTR NEW1 OFST NIL) - (\PUTBASEFIXP NEW1 (IPLUS OFST 2) - 0)) + (for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4 + do (\RPLPTR NEW1 OFST NIL) + (\PUTBASEFIXP NEW1 (IPLUS OFST 2) + 0)) (replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1)) (\TEDIT.SET-TOTLEN NEW1) (\MATCHPCS NEW1) (* ;; - "Now clean up the old piece, to contain only the upper 3 original children:") + "Now clean up the old piece, to contain only the upper 3 original children:") (for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4 - do (* ; - "For GC, have to tell it we've dropped pointers to first N/2 pieces") - (\RPLPTR PCNODE OFST NIL)) + do (* ; + "For GC, have to tell it we've dropped pointers to first N/2 pieces") + (\RPLPTR PCNODE OFST NIL)) (* ;; "Move upper N/2+1 down") - [for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST - from \BTREETOPHALFOFFSET by 4 - do (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST)) - (\PUTBASEFIXP PCNODE (IPLUS 2 OFST) - (\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST] + [for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST from + \BTREETOPHALFOFFSET + by 4 do (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST)) + (\PUTBASEFIXP PCNODE (IPLUS 2 OFST) + (\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST] (* ;; "And clean out upper 2 slots, without the GC seeing it:") - (for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) - to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY - do (\PUTBASEPTR PCNODE OFST NIL) - (\PUTBASEFIXP PCNODE (IPLUS OFST 2) - 0)) - (replace (BTREENODE COUNT) of PCNODE with (ADD1 (LRSH - \BTREEMAXENTRIES - 1))) + (for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) to + \WORDSINBTREEMAIN + by \BTREEWORDSPERENTRY do (\PUTBASEPTR PCNODE OFST NIL) + (\PUTBASEFIXP PCNODE (IPLUS OFST 2) + 0)) + (replace (BTREENODE COUNT) of PCNODE with (ADD1 (LRSH \BTREEMAXENTRIES 1))) (\TEDIT.SET-TOTLEN PCNODE) (SETQ COUNT (fetch (BTREENODE COUNT) of UPWARD)) - (\INSERTTREE NEW1 PCNODE UPWARD NIL (fetch (BTREENODE TOTLEN) - of PCNODE))) + (\INSERTTREE NEW1 PCNODE UPWARD NIL (fetch (BTREENODE TOTLEN) of PCNODE))) (T (* ;; "Hard case: This is the root node. We need to create 2 new nodes, put the split parts there, and re-use this node as the root.") (SETQ NEW1 (create BTREENODE using PCNODE)) (for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4 do (\RPLPTR NEW1 OFST NIL) - (\PUTBASEFIXP NEW1 (IPLUS OFST 2) - 0)) + (\PUTBASEFIXP NEW1 (IPLUS OFST 2) + 0)) (replace (BTREENODE UPWARD) of NEW1 with PCNODE) (replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1)) (\TEDIT.SET-TOTLEN NEW1) @@ -360,22 +348,20 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (SETQ NEW2 (create BTREENODE using PCNODE)) (for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4 - do (* ; - "For GC, have to tell it we've dropped pointers to first N/2 pieces") - (\RPLPTR NEW2 OFST NIL)) - [for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST - from \BTREETOPHALFOFFSET by 4 - do (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST)) - (\PUTBASEFIXP NEW2 (IPLUS 2 OFST) - (\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST] - (for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) - to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY - do (\PUTBASEPTR NEW2 OFST NIL) - (\PUTBASEFIXP NEW2 (IPLUS OFST 2) - 0)) + do (* ; + "For GC, have to tell it we've dropped pointers to first N/2 pieces") + (\RPLPTR NEW2 OFST NIL)) + [for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST from \BTREETOPHALFOFFSET + by 4 do (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST)) + (\PUTBASEFIXP NEW2 (IPLUS 2 OFST) + (\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST] + (for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) to + \WORDSINBTREEMAIN + by \BTREEWORDSPERENTRY do (\PUTBASEPTR NEW2 OFST NIL) + (\PUTBASEFIXP NEW2 (IPLUS OFST 2) + 0)) (replace (BTREENODE UPWARD) of NEW2 with PCNODE) - (replace (BTREENODE COUNT) of NEW2 with (ADD1 (LRSH \BTREEMAXENTRIES 1 - ))) + (replace (BTREENODE COUNT) of NEW2 with (ADD1 (LRSH \BTREEMAXENTRIES 1))) (\TEDIT.SET-TOTLEN NEW2) (\MATCHPCS NEW2) @@ -383,76 +369,70 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (for OFST from 0 to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY do + (* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.") - (* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.") - - (\RPLPTR PCNODE OFST NIL) - (\PUTBASEFIXP PCNODE (IPLUS 2 OFST) - 0)) + (\RPLPTR PCNODE OFST NIL) + (\PUTBASEFIXP PCNODE (IPLUS 2 OFST) + 0)) (\RPLPTR PCNODE 0 NEW1) (* ; "Add first new node") (\PUTBASEFIXP PCNODE 2 (ffetch (BTREENODE TOTLEN) of NEW1)) (\RPLPTR PCNODE 4 NEW2) (* ; "And the second....") (\PUTBASEFIXP PCNODE 6 (ffetch (BTREENODE TOTLEN) of NEW2)) (freplace (BTREENODE COUNT) of PCNODE with 2) - (freplace (BTREENODE TOTLEN) of PCNODE with (IPLUS (ffetch - (BTREENODE TOTLEN) - of NEW1) - (ffetch - (BTREENODE TOTLEN) - of NEW2])]) + (freplace (BTREENODE TOTLEN) of PCNODE with (IPLUS (ffetch (BTREENODE TOTLEN) + of NEW1) + (ffetch (BTREENODE TOTLEN) + of NEW2])]) (\TEDIT.UPDATETREE - [LAMBDA (PCNODE DELTA) (* ; - "Edited 21-Mar-95 14:40 by sybalsky:mv:envos") + [LAMBDA (PCNODE DELTA) (* ; + "Edited 21-Mar-95 14:40 by sybalsky:mv:envos") (* ;; "The size of the text represented by PCNODE has grown by DELTA. Update all of PCNODE's parents to reflect the change in length.") (LET ((UPWARD (fetch (BTREENODE UPWARD) of PCNODE))) (while UPWARD do + (* ;; "Keep going up in the tree til we hit the top.") - (* ;; "Keep going up in the tree til we hit the top.") - - (for old ITEM# from 0 by 4 as I from 1 - to (ffetch (BTREENODE COUNT) of UPWARD) - when (EQ (\GETBASEPTR UPWARD ITEM#) - PCNODE) - do (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2) - (IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2)) - DELTA)) - (add (fetch (BTREENODE TOTLEN) of UPWARD) - DELTA) - (RETURN) FINALLY (HELP "PCNODE not in upward node.")) - (SETQ PCNODE UPWARD) - (SETQ UPWARD (fetch (BTREENODE UPWARD) of PCNODE]) + (for old ITEM# from 0 by 4 as I from 1 to (ffetch (BTREENODE COUNT) + of UPWARD) + when (EQ (\GETBASEPTR UPWARD ITEM#) + PCNODE) do (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2) + (IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2)) + DELTA)) + (add (fetch (BTREENODE TOTLEN) of UPWARD) + DELTA) + (RETURN) FINALLY (HELP "PCNODE not in upward node.") + ) + (SETQ PCNODE UPWARD) + (SETQ UPWARD (fetch (BTREENODE UPWARD) of PCNODE]) (\TEDIT.PIECE-CHNO [LAMBDA (PC) (LET ((PCNODE (fetch (PIECE PTREENODE) of PC)) (CHARCOUNT 0)) - (while PCNODE do [add CHARCOUNT (for OFST from 0 by 4 - while (NEQ PC (\GETBASEPTR PCNODE OFST)) - sum (\GETBASEFIXP PCNODE (IPLUS OFST 2] - (SETQ PC PCNODE) - (SETQ PCNODE (fetch (BTREENODE UPWARD) of PCNODE))) + (while PCNODE do [add CHARCOUNT (for OFST from 0 by 4 while (NEQ PC (\GETBASEPTR PCNODE OFST + )) + sum (\GETBASEFIXP PCNODE (IPLUS OFST 2] + (SETQ PC PCNODE) + (SETQ PCNODE (fetch (BTREENODE UPWARD) of PCNODE))) (ADD1 CHARCOUNT]) (\TEDIT.SET-TOTLEN - [LAMBDA (PCNODE) (* ; "Edited 9-May-93 15:40 by jds") + [LAMBDA (PCNODE) (* ; "Edited 9-May-93 15:40 by jds") (* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths") - (replace (BTREENODE TOTLEN) of PCNODE with (for I from 1 - to (fetch (BTREENODE COUNT) - of PCNODE) as ITEM# - from 2 by 4 - sum (\GETBASEFIXP PCNODE ITEM#]) + (replace (BTREENODE TOTLEN) of PCNODE with (for I from 1 to (fetch (BTREENODE COUNT) of PCNODE) + as ITEM# from 2 by 4 sum (\GETBASEFIXP PCNODE ITEM# + ]) ) (DEFINEQ (DISPTREE - [LAMBDA (TREE DEPTH) (* ; "Edited 13-Apr-90 15:00 by ON") + [LAMBDA (TREE DEPTH) (* ; "Edited 13-Apr-90 15:00 by ON") (LET [(G (TREEGRAPHNODE TREE NIL (OR (NUMBERP DEPTH) - T] + T] (SHOWGRAPH (LAYOUTGRAPH (CADR G) (LIST (CAR G)) '(VERTICAL)) @@ -461,12 +441,12 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (INSPECT (fetch NODEID of X]) (TREEGRAPHNODE - [LAMBDA (TREE PARENT DEPTH) (* ; "Edited 12-Jun-90 10:33 by mitani") + [LAMBDA (TREE PARENT DEPTH) (* ; "Edited 12-Jun-90 10:33 by mitani") (LET (THISNODE NEWDEPTH NODEID LONODES HINODES BFNODE BFNODEID RANKNODE RANKNODEID) (COND ((ATOM TREE) (LIST [fetch NODEID of (SETQ THISNODE (NODECREATE (CONS) - TREE NIL NIL (LIST PARENT] + TREE NIL NIL (LIST PARENT] (LIST THISNODE))) ((OR (EQ DEPTH T) (AND (NUMBERP DEPTH) @@ -561,11 +541,10 @@ Copyright (c) 1990-1991, 1993-1995, 1999, 2018 by Venue & Xerox Corporation. (ADDTOVAR LAMA ) ) -(PUTPROPS PCTREE COPYRIGHT ("Venue & Xerox Corporation" 1990 1991 1993 1994 1995 1999 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2966 23396 (UPDATEPCNODES 2976 . 4063) (FINDPCNODE 4065 . 4297) (\FIRSTNODE 4299 . 4656 -) (\DELETETREE 4658 . 7139) (\INSERTTREE 7141 . 11705) (\LASTNODE 11707 . 12350) (\MATCHPCS 12352 . -13476) (\SPLITTREE 13478 . 20654) (\TEDIT.UPDATETREE 20656 . 22133) (\TEDIT.PIECE-CHNO 22135 . 22714) -(\TEDIT.SET-TOTLEN 22716 . 23394)) (23397 25837 (DISPTREE 23407 . 23863) (TREEGRAPHNODE 23865 . 25835) + (FILEMAP (NIL (2938 22352 (UPDATEPCNODES 2948 . 3917) (FINDPCNODE 3919 . 4155) (\FIRSTNODE 4157 . 4518 +) (\DELETETREE 4520 . 6985) (\INSERTTREE 6987 . 11551) (\LASTNODE 11553 . 12090) (\MATCHPCS 12092 . +12816) (\SPLITTREE 12818 . 19698) (\TEDIT.UPDATETREE 19700 . 21207) (\TEDIT.PIECE-CHNO 21209 . 21791) +(\TEDIT.SET-TOTLEN 21793 . 22350)) (22353 24789 (DISPTREE 22363 . 22819) (TREEGRAPHNODE 22821 . 24787) )))) STOP diff --git a/library/PCTREE.LCOM b/library/tedit/TEDIT-PCTREE.LCOM similarity index 64% rename from library/PCTREE.LCOM rename to library/tedit/TEDIT-PCTREE.LCOM index 1d41014a3cf7d85a66e96fd8a8a5c3242bb2efc6..23d93c5cc731b8c0cc151101403e82c3fd625753 100644 GIT binary patch delta 1850 zcmb_d&2Jl35MRe`N;V<29lLEp6NYV4*?`S{_#-jMiq~GJ8#dmpKMIW;tR!|D#~V91 zi9&^tC4@K>DxoeC2arHTZ~zHmA`ViofjHRz&E+3`dFG}feA-wI>N9Nc&Pc>(sEfX6`@uI3dmOznde`7 zZf&JhUx`*`m(|&7RISa=s?nuVQ7v8N{K4pYtzIctulNj2R4vcdXX{s^tEFOjHJTL? zV%Dd`vuQ!_Kg)Q5q;$`X1J_)H8H>x(fOoSedF!XNq5=p{WtP(&dv zpbU9Q?Q?4p9oTIHHY{%VZBKO|dAc*)AUzNW0;QBo^QC91wPFcB34RVGo{|#+%5Yvx zWrTDVzb`}*qohXxCIn(um^uq+8w3$A9H4tyA)U@C*%&VgSjPf}z&qw4r!>aU3bwqq zcsx$;ISHcE@lhAAo+AnL`^I4>`A)q139K{4%I@8}h2GX;!6oRl!QN;&?A@}xxaq9!5%>6Ct0&s`{=DsM$#&IQ z+1cXn+$Q>(#I-JrbhFvMEEp(Ghowh|>+JfP?Q#rzyhWf$+7zO1+itcy_q|V;z3(T+ zM4>?xoQT4sva`53Y^E^WlAY@C0fjfmbq1}eMYUtmVROhs@|pV^PskK6gU({RK(*wd z%64I>B?BT*fYz74%an7vs3+n5$r_G8zuGe1L_If&cxcHk=g?_GGgaC71*|Q8Qry)q zR_uf)Fve;xcexs&QOIW$Ni=FG5Ja`2bJM z1|>xAV#J#{*oDITJC?>qgN9?&=O~dJn&{;fm@8kYt}RgzqO~u`eoI)}BtJ#{Uh6jc zU%TG@8xj|K#*A_BNzWUdNPe>KJ461fZ_t9|9(NFZdG}fLz3l$*G13zXm}njvFmUqS z$I&$64xK;9gE55eoD4idrbJ1fNGDER8zDXDm3%~M*m>kf|mTy_cj|Q_79e{_qYH6 delta 1740 zcma)7O>7%g5O!iWO`UGy{M4<|G#R!@S*uFeUH`;3DDv)l?QH9Kw`(W;ArLwBDsi$| zM~)+iDrAIE4j=@=JrI6`6eJ`LNDUDO#K8zSG)P4Sa!3$|9_RsaiPRgHFuR+kE=34i zn)l|-oB3wu&CI?zx}SLGa)o6FFDx5_EX}gO&`~xLr5O?^@_KP$v7l>tC>lV*jddq7qk&QS1PTHENFRMTN%*{)1@4;ijY-Bap+mr2X2z3ADLwRQJRhVLnKU>v_qTM zXLH7kwlolh%A}Oeh-%hUhXO)f)^xn4LAeNtWnI@wu(YyNTrNYs)uEvw(hd1s8U1?# zZWs|spPNcZDN#^GE-S|I(!YjzBVPHRaRD2~KSYI5E}axJgIO7MNu-}S1FZxV z1Vs`B(MM1|qWY&Zj{?Qj?K0U-!*#w9`S+WKD+C3BAdpHyyRJQB6!RJw#j=@aMM%qW zk@OLD{zEh#c2f#40g$rd*jd1>A0%^O0Pkf*RUKEd9G?=+Ga5`2xQjd~4BHl}>d}wR zf9-KNn%ZAI%IoLc4*Y%9?rG+K0Ot$&`Q3Z>rdn%rQy#hX!TN^dPPMPOr{bC0dw0XJ zCVP%JzjVH~;aKHmkKVW|*o$Rir^Pf>i+^aH?Zj;snY%CYvt5wZU3b$u$e!Kr&9m7b z9p)12a>Twf^}fj2YO$>*Te019ESA6BVeC2X^FLRNw*C9R-|48u^p5$RyZkSA9G$ny z$4tfbjs2Izt&a8vwoZH5Dp7}*blsvOplKN8wvt%=D{j&Cd3}Jnw!GFX&i=yC73SE7|RPJ1hKg! zV@WHO3&sp+3yb9yD3mpn1la0&%cp$=h5h%)THW4m-I?RRVyp5*#BSXR@p=>TuC8xv z{&v@yh9d;Uu%YTj=Rmd1dmN=b-m^$!-j9*q^LnkD)xW$qk$wB5Jp-zrpA0k;X(?sR zhd)lfF+gC55SKEF85u{@G=mNRI}FqWj$cXOQa&H?$$O{F$+6a*c-mB?aGYhcR|R=Y zQL+7TXqd{#W-w!_!dkaplan>local>medley3.5>working-medley>library>tedit>TEDIT-SCREEN.;1 198321 + + :PREVIOUS-DATE "14-Jul-2022 12:44:58" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-SCREEN.;3) + + +(PRETTYCOMPRINT TEDIT-SCREENCOMS) + +(RPAQQ TEDIT-SCREENCOMS + [(FILES TEDIT-DCL) + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) + (FILES (LOADCOMP) + TEDIT-DCL)) + (FNS \FORMATLINE \TEDIT.NSCHAR.RUN \TEDIT.PURGE.SPACES \DOFORMATTING) + (FNS \DISPLAYLINE \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE \TEDIT.BLTCHAR) + (DECLARE%: EVAL@COMPILE DONTCOPY + + (* ;; "Machine independent version of \TEDIT.BLTCHAR") + + (MACROS MI-TEDIT.BLTCHAR)) + (FNS TEDIT.CR.UPDATESCREEN TEDIT.DELETELINE TEDIT.INSERT.DISPLAYTEXT + TEDIT.INSERT.UPDATESCREEN TEDIT.UPDATE.SCREEN \BACKFORMAT \FILLWINDOW \FIXDLINES + \FIXILINES \SHOWTEXT \TEDIT.ADJUST.LINES \TEDIT.CLEAR.SCREEN.BELOW.LINE + \TEDIT.CLOSEUPLINES \TEDIT.COPY.LINEDESCRIPTOR \TEDIT.FIXCHANGEDLINE + \TEDIT.FIXCHANGEDPART \TEDIT.INSERTLINE \TEDIT.LINE.LIST \TEDIT.MARK.LINES.DIRTY + \TEDIT.NEXT.LINE.BOTTOM) + (COMS (* RMK%: These duplicate what appears on TEDITHCPY, GLOBALVARS moved to TEDIT-DCL) + (* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" + "41,115" "41,133" "41,131" "41,127" + "Hira,41" "Hira,43" "Hira,45" + "Hira,47" "Hira,51" "Hira,103" + "Hira,143" "Hira,145" "Hira,147" + "Hira,156" "Kata,41" "Kata,43" + "Kata,45" "Kata,47" "Kata,51" + "Kata,103" "Kata,143" "Kata,145" + "Kata,147" "Kata,156"))) + (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126"))) + (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS]) + +(FILESLOAD TEDIT-DCL) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ \SCRATCHLEN 64) + + +(CONSTANTS (\SCRATCHLEN 64)) +) + + +(FILESLOAD (LOADCOMP) + TEDIT-DCL) +) +(DEFINEQ + +(\FORMATLINE + [LAMBDA (TEXTOBJ FMTSPEC CH#1 OLINE 1STLN) (* ; "Edited 30-Apr-2021 14:38 by rmk:") + + (* ;; "Given a starting place, format the next line of text. Return the LINEDESCRIPTOR; reusing OLINE if it's given.") + + (* ;; "If CH#1 is past end of document, \FORMATLINE returns an empty line descriptor that is set up right wrt leading and font. This is used by \FILLWINDOW to create the dummy line at end of document when you hit a CR there.") + + (DECLARE (SPECVARS LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT + INVISIBLERUNS DEVICE SCALE NEWASCENT NEWDESCENT TLEN)) + (PROG ([LINE (OR OLINE (create LINEDESCRIPTOR + RIGHTMARGIN _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + YBOT _ (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] + (CH#B (IMAX CH#1 1)) + (GATHERBLANK T) + (TLEN 0) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (THISLINE (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)) + (CHNO (IMAX CH#1 1)) + (LOOKNO 0) + (INVISIBLERUNS 0) + (ASCENT 0) + (DESCENT 0) + (PREVSP 0) + (%#BLANKS 0) + (DEFAULTTAB 36) + (DS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) + 'DSP)) + LEFTEDGE TX DX TXB CH FORCEEND T1SPACE TXB1 DXB WIDTH LOOK#B FONT FONTWIDTHS TERMSA CLOOKS + TEXTSTREAM CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO + DEVICE SCALE NEWASCENT NEWDESCENT TABSPEC HARDCOPYMODE ORIGFMTSPEC PREVHYPH PREVDHYPH + ORIGCHLIST ORIGWLIST) + + (* ;; "Variables (TLEN = Current character count on the line)") + + (* ;; "(CHNO = Current character # in the text)") + + (* ;; "(DX = width of current char/object)") + + (* ;; "(TX = current right margin) ") + + (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ") + + (* ;; "(CH#B = The CHNO of most recent space/tab)") + + (* ;; "(TXB = right margin of most recent space/tab)") + + (* ;; "(DXB = width of most recent space/tab)") + + (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)") + + (* ;; "(T1SPACE = a space/CR/TAB has been seen)") + + (* ;; "(#BLANKS = # of spaces/tabs seen) ") + + (* ;; " (LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)") + + (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)") + + (* ;; "(ASCENTB = Ascent at most recent potential line break point)") + + (* ;; "(DESCENTB = Descent at most recent potential line break point)") + + (SETQ CH#1 (IMAX CH#1 1)) + [SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch (THISLINE CHARS) of THISLINE] + [SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS) of THISLINE] + (SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE)) + (SETQ TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) + (SETQ TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) + (replace (TEXTSTREAM LOOKSUPDATEFN) of TEXTSTREAM with (FUNCTION \TEDIT.LOOKS.UPDATE)) + (freplace (LINEDESCRIPTOR CHARLIM) of LINE with TEXTLEN) + (* ; + "Force each new line to find its true CHARLIM.") + (freplace (LINEDESCRIPTOR DIRTY) of LINE with NIL) (* ; + "And as unchanged since the last formatting.") + (freplace (LINEDESCRIPTOR CHAR1) of LINE with CH#1) + (freplace (LINEDESCRIPTOR CR\END) of LINE with NIL)(* ; "Assume we won't see a CR.") + (freplace (LINEDESCRIPTOR LHASTABS) of LINE with NIL) + (* ; "And has no TABs.") + (COND + [(COND + ((AND (ILEQ CH#1 TEXTLEN) + (NOT (ZEROP TEXTLEN))) (* ; + "Only continue if there's really text we can format.") + (\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place") + (* ; "And starting character looks") + (SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM)) + (COND + ((fetch CLINVISIBLE of CLOOKS) (* ; + "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") + (SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) + (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN) of PC))) + (\RPLPTR CHLIST 0 LMInvisibleRun) + (\RPLPTR WLIST 0 0) + (add TLEN 1) + (SETQ CHLIST (\ADDBASE CHLIST 2)) + (SETQ WLIST (\ADDBASE WLIST 2)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) + PC TEXTOBJ))) + [while (AND PC (fetch CLINVISIBLE of CLOOKS)) + do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch (PIECE PLEN) + of PC))) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) + (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) + of PC) + PC TEXTOBJ] + (add CHNO (\EDITELT LOOKS LOOKNO)) + (\SETUPGETCH (create EDITMARK + PC _ (OR PC 'LASTPIECE) + PCOFF _ 0 + PCNO _ NIL) + TEXTOBJ))) + (ILEQ CHNO TEXTLEN))) + (replace (LINEDESCRIPTOR LHASPROT) of LINE with (fetch CLPROTECTED of CLOOKS)) + (* ; + "Remember if the first character on the line is protected.") + (SETQ ORIGFMTSPEC (SETQ FMTSPEC + (\TEDIT.APPLY.PARASTYLES + [OR FMTSPEC (SETQ FMTSPEC (OR (AND (fetch (TEXTSTREAM PIECE) + of TEXTSTREAM) + (fetch (PIECE PPARALOOKS) + of (fetch (TEXTSTREAM PIECE) + of TEXTSTREAM))) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + PC TEXTOBJ))) (* ; "Get the paragraph looks") + (COND + ((NEQ ORIGFMTSPEC *TEDIT-CACHED-FMTSPEC*) + + (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.") + + (SETQ *TEDIT-CURRENTPARA-CACHE* NIL) + (SETQ *TEDIT-CACHED-FMTSPEC* ORIGFMTSPEC))) + (COND + [(SETQ HARDCOPYMODE (fetch FMTHARDCOPY of FMTSPEC)) + (* ; + "This line is a hardcopy line. Scale things for it.") + [SETQ DEVICE (OR (fetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ) + (replace (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ + with (OPENIMAGESTREAM '{NODIRCORE} 'INTERPRESS] + (SETQ SCALE (DSPSCALE NIL DEVICE)) + (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC FMTSPEC DEVICE)) + (SETQ DEFAULTTAB (FIXR (FTIMES 36 SCALE))) + (SETQ LEFTEDGE (FIXR (FTIMES 8 SCALE] + (T (* ; + "Regular line. Format at display resolutions") + (SETQ DEVICE (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) + (SETQ SCALE 1) + (SETQ LEFTEDGE 8))) + (SETQ TABSPEC (fetch TABSPEC of FMTSPEC)) + [COND + ((type? FONTCLASS (SETQ FONT (fetch CLFONT of CLOOKS))) + (SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS) + 'DEVICE + 'DISPLAY] (* ; + "Grab the initial font for this line") + [SETQ ASCENTB (SETQ NEWASCENT (IPLUS (fetch \SFAscent of FONT) + (OR (fetch CLOFFSET of CLOOKS) + 0] (* ; + "The initial ascent, per the initial font") + [SETQ DESCENTB (SETQ NEWDESCENT (IDIFFERENCE (fetch \SFDescent of FONT) + (OR (fetch CLOFFSET of CLOOKS) + 0] (* ; + "Initial descent, per the initial font.") + [COND + (HARDCOPYMODE (* ; + "If this is a hardcopy line, fetch the hardcopy version of the font") + (SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS) + 'DEVICE DEVICE] + (\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache") + [SETQ 1STLN (OR (IEQP CH#1 1) + (AND (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) + (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) of + TEXTSTREAM + )) + (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) + of (fetch (TEXTSTREAM PIECE) + of TEXTSTREAM))) + (IEQP (fetch (TEXTSTREAM PCSTARTCH) of TEXTSTREAM) + (fetch (STREAM COFFSET) of TEXTSTREAM)) + (IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM) + (fetch (STREAM CPAGE) of TEXTSTREAM] + (* ; + "If this is the start of a paragraph, mark it so.") + (replace (LINEDESCRIPTOR LMARK) of LINE with NIL) + (* ; + "Start by assuming that we don't want a margin marker for this line.") + (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) + (* ; + "Are we on the first line of a paragraph?") + [COND + (1STLN + (* ;; "This is the first line of a paragraph. Check for special paragraph types, like headings, that get marked in the margin.") + + (COND + ((EQ (fetch FMTPARATYPE of FMTSPEC) + 'PAGEHEADING) + (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) + ((OR (fetch FMTNEWPAGEBEFORE of FMTSPEC) + (fetch FMTNEWPAGEAFTER of FMTSPEC)) + (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) + ([AND (fetch FMTSPECIALX of FMTSPEC) + (NOT (ZEROP (fetch FMTSPECIALX of FMTSPEC] + (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) + ([AND (fetch FMTSPECIALY of FMTSPEC) + (NOT (ZEROP (fetch FMTSPECIALY of FMTSPEC] + (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY] + [SETQ TX (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE + with (IPLUS [FIXR (FTIMES SCALE (IPLUS 8 (fetch (TEXTOBJ WLEFT) + of TEXTOBJ] + (COND + (1STLN (fetch 1STLEFTMAR of FMTSPEC)) + (T (fetch LEFTMAR of FMTSPEC] + (* ; "Set the left margin accordingly") + [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE + with (SETQ WIDTH (COND + ((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC))) + (IPLUS LEFTEDGE (fetch RIGHTMAR of FMTSPEC))) + (T (FIXR (FTIMES SCALE (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) + of TEXTOBJ) + 8] + (* ; + "RIGHTMAR = 0 => follow the window's width.") + (SETQ TXB1 WIDTH) + (for old TLEN from TLEN to 254 as old CHNO from CHNO while (ILEQ CHNO TEXTLEN) + when (SETQ CH (\BIN TEXTSTREAM)) + do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)") + + (* ;; "The character loop") + + (* ;; "Get the next character for the line.") + + [SETQ DX (COND + [(SMALLP CH) (* ; "CH is really a character") + (COND + ((AND (IGEQ CH 192) + (ILEQ CH 207)) (* ; + "This is an NS accent character. Space it 0.") + (SETQ DX 0)) + (T (* ; + "Regular character. Get it's width.") + (\FGETCHARWIDTH FONT CH] + (T (* ; "CH is an object") + (SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN) + CH DS TX WIDTH)) + (* ; "Get its size") + (SETQ NEWASCENT (IDIFFERENCE (fetch YSIZE of BOX) + (fetch YDESC of BOX))) + (SETQ NEWDESCENT (fetch YDESC of BOX)) + (IMAGEOBJPROP CH 'BOUNDBOX BOX) + (COND + ([NEQ 1 (fetch (PIECE PLEN) of (SETQ PC (fetch (TEXTSTREAM + PIECE) + of TEXTSTREAM] + + (* ;; "The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from. Build an invisible run to fill the space.") + + (add LOOKNO 1) (* ; + "Fix the counter of charlooks changes") + (\EDITSETA LOOKS LOOKNO (SUB1 (fetch (PIECE PLEN) of PC))) + (\RPLPTR CHLIST 0 LMInvisibleRun) + (* ; + "Note the existence of an invisible run of characters here.") + (\RPLPTR WLIST 0 0) + (add TLEN 1) + (SETQ CHLIST (\ADDBASE CHLIST 2)) + (SETQ WLIST (\ADDBASE WLIST 2)) + (add CHNO (SUB1 (fetch (PIECE PLEN) of PC))) + (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) + (* ; + "Keep track of how much invisible text we cross over") + )) + (COND + [HARDCOPYMODE (FIXR (FTIMES SCALE (fetch XSIZE of BOX] + (T (fetch XSIZE of BOX] + (* ; "Get CH's X width.") + [SELCHARQ CH + (SPACE (* ; + "CH is a . Remember it, in case we need to break the line.") + (COND + (GATHERBLANK (SETQ TXB1 TX) + (SETQ GATHERBLANK NIL))) + (SETQ CH#B CHNO) (* ; + "put the location # of the previous space/tab in the character array instead of the space itself") + (\RPLPTR CHLIST 0 PREVSP) + (\RPLPTR WLIST 0 DX) + (SETQ PREVSP (ADD1 TLEN)) + (SETQ T1SPACE T) + (SETQ PREVDHYPH NIL) + (SETQ PREVHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (add TX DX) + (SETQ TXB TX) + (SETQ DXB DX) + (SETQ LOOK#B LOOKNO) + (COND + (NEWASCENT (* ; "The ascent has changed; catch it") + (SETQ ASCENT (IMAX ASCENT NEWASCENT)) + (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) + (SETQ NEWASCENT NIL))) + (SETQ ASCENTB ASCENT) + (SETQ DESCENTB DESCENT) + (SETQ INVISIBLERUNSB INVISIBLERUNS) + (add %#BLANKS 1)) + ((CR LF) (* ; + "Ch is a . Force an end to the line.") + (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) + (COND + ((AND NEWASCENT (ZEROP ASCENT) + (ZEROP DESCENT)) (* ; "The ascent has changed; catch it") + (SETQ ASCENT NEWASCENT) + (SETQ DESCENT NEWDESCENT))) + (SETQ FORCEEND T) + (SETQ PREVDHYPH NIL) + (SETQ PREVHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (\RPLPTR CHLIST 0 (CHARCODE EOL)) + (\RPLPTR WLIST 0 (SETQ DX (IMAX DX 6))) + (COND + (GATHERBLANK (SETQ TXB1 TX) + (SETQ GATHERBLANK NIL))) + (SETQ T1SPACE T) + (freplace (LINEDESCRIPTOR CR\END) of LINE with T) + (SETQ TX (IPLUS TX DX)) + (replace (LINEDESCRIPTOR LSTLN) of LINE with T) + (* ; + "This has to be done better when we get non-para breaking CRs.") + (RETURN)) + (TAB + (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") + + (replace (LINEDESCRIPTOR LHASTABS) of LINE with T) + (* ; "To disable smart screen update") + (COND + (NEWASCENT (* ; "The ascent has changed; catch it") + (SETQ ASCENT (IMAX ASCENT NEWASCENT)) + (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) + (SETQ NEWASCENT NIL))) + (\RPLPTR CHLIST 0 CH) + (SETQ TABPENDING + (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE CHLIST WLIST TX DEFAULTTAB + LEFTEDGE TABPENDING 0 NIL)) + (* ; + "Figure out which tab stop to use, and what we need to do to get there.") + [COND + ((FIXP TABPENDING) (* ; + "If it returns a number, that is the new TX, adjusted for any prior tabs") + (SETQ TX TABPENDING) + (SETQ TABPENDING NIL)) + (TABPENDING (* ; + "Otherwise, look in the PENDINGTAB for the new TX") + (SETQ TX (fetch PTNEWTX of TABPENDING] + (COND + (GATHERBLANK (SETQ TXB1 TX) + (SETQ GATHERBLANK NIL))) + (SETQ CH#B CHNO) + (SETQ DX (\GETBASEPTR WLIST 0)) + (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) of THISLINE) + PREVSP) (* ; + "All the spaces before a tab don't take part in justification from here on.") + (SETQ %#BLANKS 0) (* ; + "Also reset the count of spaces on this line, so we widen later spaces enough.") + (SETQ PREVSP 0) + (SETQ T1SPACE T) + (SETQ TX (IPLUS TX DX)) + (SETQ TXB TX) (* ; + "Remember the world in case this is the 'space' before the line breaks") + (SETQ DXB DX) + (SETQ LOOK#B LOOKNO) + (SETQ ASCENTB ASCENT) + (SETQ DESCENTB DESCENT) + (SETQ PREVDHYPH NIL) + (SETQ PREVHYPH NIL) (* ; + "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") + (SETQ INVISIBLERUNSB INVISIBLERUNS)) + (PROGN (COND + ((AND (EQ CH (CHARCODE "0,377")) + (NOT (ffetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ))) + + (* ;; + "Character-set change character. This suggests undetected NS characters.") + + (\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM) + (* ; + "Leaves us ready to BIN again at the same place.") + + (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.") + + (SETQ CHLIST (\ADDBASE CHLIST -2)) + (SETQ WLIST (\ADDBASE WLIST -2)) + (add CHNO -1) + (add TLEN -1) + (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (* ; + "Because moving to NS characters changes the TEXTLEN for the shorter.") + ) + (T + (* ;; "Not a formatting character, so gather") + + (SETQ GATHERBLANK T) (* ; "Blanks are interesting again.") + (COND + ((IGREATERP (SETQ TX (IPLUS TX DX)) + WIDTH) (* ; + "We're past the right margin; stop formatting at the last blank.") + (SETQ FORCEEND T) + [COND + (PREVDHYPH (* ; + "There's a hyphen we can break at. Go back there and break the line.") + (freplace (LINEDESCRIPTOR CHARLIM) of LINE + with CH#B) + (\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH) + 1) + (CHARCODE "-")) + (\RPLPTR ORIGWLIST (LLSH (SUB1 PREVDHYPH) + 1) + (\FGETCHARWIDTH FONT (CHARCODE "-"))) + (SETQ TX TXB) + (SETQ DX DXB) + (SETQ ASCENT ASCENTB) + (SETQ DESCENT DESCENTB) + (SETQ LOOKNO LOOK#B) + (SETQ INVISIBLERUNS INVISIBLERUNSB)) + (PREVHYPH (* ; + "There's a hyphen we can break at. Go back there and break the line.") + (freplace (LINEDESCRIPTOR CHARLIM) of LINE + with CH#B) + (SETQ TX TXB) + (SETQ DX DXB) + (SETQ ASCENT ASCENTB) + (SETQ DESCENT DESCENTB) + (SETQ LOOKNO LOOK#B) + (SETQ INVISIBLERUNS INVISIBLERUNSB)) + (T1SPACE (* ; + "There's a breaking point on this line. Go back there and break the line.") + (freplace (LINEDESCRIPTOR CHARLIM) of LINE + with CH#B) + (SETQ TX TXB) + (SETQ DX DXB) + (SETQ ASCENT ASCENTB) + (SETQ DESCENT DESCENTB) + (SETQ LOOKNO LOOK#B) + (SETQ INVISIBLERUNS INVISIBLERUNSB)) + ((IGREATERP TLEN 0) + (freplace (LINEDESCRIPTOR CHARLIM) of LINE + with (IMAX (SUB1 CHNO) + CH#1)) + (SETQ TX (IDIFFERENCE TX DX)) + (* ; + "No spaces on this line; break it before this character.") + + (* ;; "Check line break character.") + + (while (OR (MEMBER (\GETBASEPTR CHLIST -2) + TEDIT.DONT.LAST.CHARS) + (MEMBER CH TEDIT.DONT.BREAK.CHARS)) + do + (* ;; + "This character ch doesn't appear at first of lines. or") + + (* ;; + "Previous character doesn't appear at the end of lines.") + + (* ;; "So,move previous character to next line.") + + (SETQ CHLIST (\ADDBASE CHLIST -2)) + (SETQ WLIST (\ADDBASE WLIST -2)) + (add TLEN -1) + (add CHNO -1) + (SETQ CH (\GETBASEPTR CHLIST 0))) + (freplace (LINEDESCRIPTOR CHARLIM) of LINE + with (IMAX (SUB1 CHNO) + CH#1))) + (T (* ; + "Can't split BEFORE the first thing on the line!") + (freplace (LINEDESCRIPTOR CHARLIM) of LINE + with CHNO) + (\RPLPTR CHLIST 0 CH) + (\RPLPTR WLIST 0 DX) + (COND + (NEWASCENT + (* ; "The ascent has changed; catch it") + (SETQ ASCENT (IMAX ASCENT NEWASCENT)) + (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) + (SETQ NEWASCENT NIL] + (RETURN)) + (T (* ; "Not past the rightmargin yet...") + (COND + (NEWASCENT (* ; "The ascent has changed; catch it") + (SETQ ASCENT (IMAX ASCENT NEWASCENT)) + (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) + (SETQ NEWASCENT NIL))) + (\RPLPTR CHLIST 0 CH) + (\RPLPTR WLIST 0 DX) + (SELCHARQ CH + (%. (* ; "Check for decimal tabs") + (COND + ((AND TABPENDING (NOT (FIXP TABPENDING)) + (EQ (fetch PTTYPE of TABPENDING) + 'DECIMAL)) + (* ; + "Figure out which tab stop to use, and what we need to do to get there.") + (add (fetch (PENDINGTAB PTTABX) of + TABPENDING + ) + DX) + (* ; + "Adjust the tab stop's X value so that the LEFT edge of the decimal point goes there.") + (SETQ TABPENDING + (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE + CHLIST WLIST TX DEFAULTTAB LEFTEDGE + TABPENDING 0 T)) + (* ; + "Tab over to the LEFT side of the decimal point.") + [COND + ((FIXP TABPENDING) + (* ; + "If it returns a number, that is the new TX, adjusted for any prior tabs") + (SETQ TX TABPENDING) + (SETQ TABPENDING NIL)) + (TABPENDING + (* ; + "Otherwise, look in the PENDINGTAB for the new TX") + (SETQ TX (fetch PTNEWTX + of TABPENDING] + (COND + (GATHERBLANK (SETQ TXB1 TX) + (SETQ GATHERBLANK NIL))) + (SETQ CH#B CHNO) + (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) + of THISLINE) + PREVSP) + (* ; + "All the spaces before a tab don't take part in justification from here on.") + (SETQ %#BLANKS 0) + (* ; + "Also reset the count of spaces on this line, so we widen later spaces enough.") + (SETQ PREVSP 0) + (SETQ T1SPACE T) + (SETQ TXB TX) + (* ; + "Remember the world in case this is the 'space' before the line breaks") + (SETQ DXB DX) + (SETQ LOOK#B LOOKNO) + (SETQ ASCENTB ASCENT) + (SETQ DESCENTB DESCENT) + (SETQ INVISIBLERUNSB INVISIBLERUNS)))) + ((- "357,045") + (* ; "Hyphen, M-dash") + (SETQ PREVHYPH (ADD1 TLEN)) + (SETQ PREVDHYPH NIL) + (SETQ TXB1 (SETQ TXB TX)) + (SETQ DXB DX) + (SETQ LOOK#B LOOKNO) + (SETQ CH#B CHNO) + (SETQ ASCENTB ASCENT) + (SETQ DESCENTB DESCENT) + (SETQ INVISIBLERUNSB INVISIBLERUNS)) + ("357,042" (* ; "non-breaking hyphen") + (\RPLPTR CHLIST 0 (CHARCODE "-"))) + ("357,043" (* ; "Discretionary hyphen") + (* ; "And isn't actually displayed.") + (SETQ PREVDHYPH (ADD1 TLEN)) + (SETQ PREVHYPH NIL) + (SETQ TXB1 (SETQ TXB TX)) + (SETQ DXB DX) + (SETQ LOOK#B LOOKNO) + (SETQ CH#B CHNO) + (SETQ ASCENTB ASCENT) + (SETQ DESCENTB DESCENT) + (\RPLPTR WLIST 0 0) + (* ; + "Unless we use it, the prevhyph is 0 wide.") + (\RPLPTR CHLIST 0 NIL) + (add TX (IMINUS DX)) + (SETQ INVISIBLERUNSB INVISIBLERUNS)) + ("357,041" (* ; "non-breaking space.")) + NIL] + (SETQ CHLIST (\ADDBASE CHLIST 2)) (* ; + "Move the pointers forward for the next character.") + (SETQ WLIST (\ADDBASE WLIST 2))) (* ; "End of char loop") + (COND + ((AND (IEQP TLEN 255) + (ILESSP CHNO TEXTLEN)) (* ; + "This line is too long for us to format??") + (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T))) + (COND + (TABPENDING (* ; + "There is a TAB outstanding. Go handle it.") + (add (fetch (PENDINGTAB PTTABX) of TABPENDING) + DX) (* ; + "Adjust the tab stop's X value so that the LEFT edge of the CR goes there.") + (SETQ TABPENDING + (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE CHLIST WLIST TX DEFAULTTAB + LEFTEDGE TABPENDING 0 T)) + + (* ;; "Finish up processing the outstanding TAB. We get back the new X position, with that taken into account.") + + (SETQ TX TABPENDING) + (SETQ TABPENDING NIL) + (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) of THISLINE) + PREVSP) (* ; + "Don't use the spaces before the TAB in justification.") + (SETQ PREVSP 0] + (T (* ; + "No text to go in this line; set Ascent/Descent to the default font from the window.") + [SETQ PC (AND (IGREATERP TEXTLEN 0) + (\CHTOPC TEXTLEN (fetch (TEXTOBJ PCTB) of TEXTOBJ] + (* ; + "Grab the last real part of the document, to get paragraph looks") + (\EDITSETA LOOKS 0 CLOOKS) (* ; + "Set up the initial looks so that \DISPLAYLINE doesn't complain") + (SETQ FONT (OR (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + (fetch CLFONT of (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ))) + (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + (fetch CLFONT of (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ))) + DEFAULTFONT)) + + (* ;; "The font we use is preferably the caret looks, else the default for this edit, else the system default") + + (SETQ ASCENT (FONTPROP FONT 'ASCENT)) + (SETQ DESCENT (FONTPROP FONT 'DESCENT)) + (SETQ FMTSPEC (OR FMTSPEC (AND PC (fetch (PIECE PPARALOOKS) of PC)) + (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) + (* ; + "Use the preceding paragraph's looks") + (SETQ 1STLN (OR (NOT PC) + (fetch (PIECE PPARALAST) of PC))) + (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) + [SETQ TX (COND + [1STLN (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE + with (IPLUS 8 (fetch (TEXTOBJ WLEFT) of TEXTOBJ) + (fetch 1STLEFTMAR of FMTSPEC] + (T (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE + with (IPLUS 8 (fetch (TEXTOBJ WLEFT) of TEXTOBJ) + (fetch LEFTMAR of FMTSPEC] + [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE + with (SETQ WIDTH (COND + ((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC))) + (fetch RIGHTMAR of FMTSPEC)) + (T (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + 8] + (SETQ TXB1 WIDTH))) + [COND + ((ZEROP (freplace (LINEDESCRIPTOR LHEIGHT) of LINE with (IPLUS ASCENT DESCENT))) + (replace (LINEDESCRIPTOR LHEIGHT) of LINE + with (FONTPROP (OR (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + (fetch CLFONT of (fetch (TEXTOBJ DEFAULTCHARLOOKS) + of TEXTOBJ))) + DEFAULTFONT) + 'HEIGHT] (* ; + "Line's height (or 12 for an empty line)") + (replace (LINEDESCRIPTOR ASCENT) of LINE with ASCENT) + (replace (LINEDESCRIPTOR DESCENT) of LINE with DESCENT) + (freplace (LINEDESCRIPTOR CHARTOP) of LINE with CHNO) + [COND + (FORCEEND NIL) + (T (SETQ CHNO (SUB1 CHNO)) + (SETQ TLEN (SUB1 TLEN] (* ; + "If we ran off the end of the text, then keep true space left on the line.") + (freplace (LINEDESCRIPTOR LXLIM) of LINE with TX) + [freplace (LINEDESCRIPTOR SPACELEFT) of LINE with (COND + (FORCEEND + (* ; + "The line was forced to end. Back up to start of last blank section") + (IDIFFERENCE WIDTH TXB1)) + (GATHERBLANK + (* ; + "Otherwise, use the rightmost character on the line.") + (IDIFFERENCE WIDTH TX)) + (T + + (* ;; "The line ended with a run of white space. Ignore it for purposes of deciding how much more we can fit on the line.") + + (IDIFFERENCE WIDTH TXB1] + (freplace (THISLINE DESC) of THISLINE with LINE) + [freplace (THISLINE LEN) of THISLINE + with (IMIN 254 (COND + ((ILESSP TEXTLEN CH#1) + -1) + (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR CHARLIM) + of LINE) + TEXTLEN) + (IPLUS INVISIBLERUNS (fetch (LINEDESCRIPTOR + CHAR1) + of LINE] + (\DOFORMATTING TEXTOBJ LINE (OR ORIGFMTSPEC FMTSPEC) + THISLINE %#BLANKS PREVSP 1STLN) + (replace (LINEDESCRIPTOR LFMTSPEC) of LINE with FMTSPEC) + (replace (TEXTSTREAM LOOKSUPDATEFN) of TEXTSTREAM with NIL) + (RETURN LINE]) + +(\TEDIT.NSCHAR.RUN + [LAMBDA (CHNO TEXTOBJ STREAM) (* ; "Edited 29-Apr-93 16:42 by jds") + + (* ;; "Given that we've just BIN'd from TEXTOBJ at character # CHNO and it was a 255, rearrange the piece table so that NS characters are available transparently %"as far ahead as makes sense%".") + + (* ;; "Leave TEXTOBJ ready to BIN at CHNO again, so the line formatter can carry on.") + + (LET* [(PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + PC START-OF-PIECE OFFSET PLEN CH NEXTCH PFPOS NEWPC NEWPLEN PF PS CHARSET TFILE + (OLDFILEPTR (SUB1 (GETFILEPTR STREAM] + (SETQ PC (\CHTOPC CHNO PCTB T)) + (SETQ OFFSET (- CHNO START-OF-PIECE)) + (SETQ PLEN (fetch (PIECE PLEN) of PC)) + (COND + ((fetch (PIECE PFATP) of PC) + (HELP "Hit charset change in a FAT piece"))) + (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) + (* ; + "This rearranges the piece table, so later insertions better use a fresh piece.") + (* ; "Back up over the 255") + (SETQ CH (BIN STREAM)) + [COND + [(IEQP CH 255) (* ; "A steady run of fat characters.") + (COND + ((SETQ PS (fetch (PIECE PSTR) of PC)) (* ; "This piece is in a string.") + (HELP "NS characters in a STRING??")) + ((SETQ PF (fetch (PIECE PFILE) of PC)) (* ; "This piece is in a file.") + (SETQ PFPOS (fetch (PIECE PFPOS) of PC)) + (SETQ NEXTCH (FFILEPOS (MKSTRING (CHARACTER 255)) + PF + (IPLUS OFFSET PFPOS 3) + (IPLUS PFPOS PLEN))) (* ; + "Find the succeeding 255, or end of piece.") + [SETQ NEWPLEN (COND + (NEXTCH (IQUOTIENT (IDIFFERENCE NEXTCH (IPLUS PFPOS OFFSET 3)) + 2)) + (T (IQUOTIENT (IDIFFERENCE (IDIFFERENCE PLEN OFFSET) + 3) + 2] + (\DELETECH (IPLUS START-OF-PIECE OFFSET) + (IPLUS START-OF-PIECE OFFSET 5 (ITIMES NEWPLEN 2)) + (IPLUS 5 (ITIMES NEWPLEN 2)) + TEXTOBJ T) + (\TEDIT.INSERT.PIECES TEXTOBJ (IPLUS START-OF-PIECE OFFSET) + (create PIECE using PC PFILE _ PF PFPOS _ (IPLUS PFPOS OFFSET 3) + PFATP _ T PSTR _ NIL PLEN _ NEWPLEN) + NEWPLEN NIL NIL NIL T) + (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + NEWPLEN] + (T (* ; + "Changing to a new character set for succeeding characters.") + (COND + ((SETQ PS (fetch (PIECE PSTR) of PC)) (* ; "This piece is in a string.") + (HELP "NS characters in a STRING??")) + ((SETQ PF (fetch (PIECE PFILE) of PC)) (* ; "This piece is in a file.") + (SETQ CHARSET CH) + (SETQ PFPOS (fetch (PIECE PFPOS) of PC)) + (SETQ NEXTCH (FFILEPOS (MKSTRING (CHARACTER 255)) + PF + (IPLUS OFFSET PFPOS 2) + (IPLUS PFPOS PLEN))) (* ; + "Find the succeeding 255, or end of piece.") + [SETQ NEWPLEN (COND + ((ZEROP CHARSET) (* ; "If we're moving back to charset 0, we just want to delete the charset change marker, so the newPlen is 0.") + 0) + (NEXTCH (IDIFFERENCE NEXTCH (IPLUS OFFSET PFPOS 2))) + (T (IDIFFERENCE (IDIFFERENCE PLEN OFFSET) + 2] + (\DELETECH (IPLUS START-OF-PIECE OFFSET) + (IPLUS START-OF-PIECE OFFSET 2 NEWPLEN) + (IPLUS NEWPLEN 2) + TEXTOBJ T) + (COND + ((ZEROP NEWPLEN) (* ; + "Do nothing if there weren't really any characters to be put in the new character set.") + ) + ((ZEROP CHARSET) (* ; + "Do nothing if we're switching back to normal character.") + ) + (T (* ; "There really are characters to be moved to the new character set. Create the temporary file for them.") + + (* ;; "Create the file") + + (SETQ TFILE (OPENSTREAM '{NODIRCORE} 'BOTH)) + (SETFILEPTR PF (IPLUS OFFSET PFPOS 2)) + (for I from 1 to NEWPLEN do + (* ;; + "Copy the newly fattened characters into the temp file.") + + (BOUT TFILE CHARSET) + (BOUT TFILE (BIN PF))) + + (* ;; "Insert a new piece in the document holding the fat characters.") + + (\TEDIT.INSERT.PIECES TEXTOBJ (IPLUS START-OF-PIECE OFFSET) + (create PIECE + using PC PFILE _ TFILE PFPOS _ 0 PFATP _ T PSTR _ NIL PLEN _ + NEWPLEN) + 1 NIL NIL NIL T) + (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + NEWPLEN] + (\SETUPGETCH CHNO TEXTOBJ]) + +(\TEDIT.PURGE.SPACES + [LAMBDA (CHLIST PREVSP) (* jds " 9-NOV-83 17:12") + (bind OPREVSP while (IGREATERP PREVSP 0) do (SETQ OPREVSP (SUB1 PREVSP)) + (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) + (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE]) + +(\DOFORMATTING + [LAMBDA (TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) + (* ; "Edited 29-Mar-94 12:36 by jds") + (* ; + "Do the formatting work for justified, centered, etc. lines") + (PROG ((QUAD (fetch QUAD of FMTSPEC)) + (SPACELEFT (LLSH (fetch (LINEDESCRIPTOR SPACELEFT) of LINE) + 5)) + (EXISTINGSPACE 0) + (CHLIST (fetch (THISLINE CHARS) of THISLINE)) + (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) + (SPACEOFLOW 0) + EXTRASP OPREVSP LINELEAD) (* ; + "NB that SPACELEFT, OFLOW, etc. are kept in 32 x value form, for rounding ease.") + (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with (fetch (LINEDESCRIPTOR DESCENT) + of LINE)) + (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with (fetch (LINEDESCRIPTOR ASCENT) + of LINE)) + (* ; + "Save the true ascent value for display purposes") + (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1) + (* ; + "Start by assuming that we want a space factor of 1.0") + [COND + ((SETQ LINELEAD (fetch LINELEAD of FMTSPEC)) (* ; + "If line leading was specified, set it") + (COND + (T (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) + (fetch LINELEAD of FMTSPEC)) (* ; + "And adjust the line's descent accordingly") + (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) + (fetch LINELEAD of FMTSPEC] + [COND + ((AND 1STLN (fetch LEADBEFORE of FMTSPEC)) (* ; + "If paragraph pre-leading was specified, set it") + (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) + (fetch LEADBEFORE of FMTSPEC)) (* ; + "And adjust the line's ascent accordingly.") + (add (fetch (LINEDESCRIPTOR ASCENT) of LINE) + (fetch LEADBEFORE of FMTSPEC] + [COND + ((AND (fetch (LINEDESCRIPTOR LSTLN) of LINE) + (fetch LEADAFTER of FMTSPEC)) (* ; + "If paragraph pre-leading was specified, set it") + (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) + (fetch LEADAFTER of FMTSPEC)) (* ; + "And adjust the line's ascent accordingly.") + (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) + (fetch LEADAFTER of FMTSPEC] + (SELECTQ QUAD + (LEFT (* ; + "Do nothing for left-justified lines except replace the character codes")) + (RIGHT (* ; "Just move the right margin over") + (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE with (IPLUS (fetch (LINEDESCRIPTOR + LEFTMARGIN) + of LINE) + (fetch (LINEDESCRIPTOR + SPACELEFT) + of LINE))) + (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR RIGHTMARGIN) + of LINE)) + (COND + ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) + 0) + (ZEROP %#BLANKS) + (ZEROP PREVSP)) (* ; + "For empty lines, and lines with no spaces, don't bother fixing blank widths.") + (RETURN)))) + (CENTERED (* ; + "Split the difference for centering") + (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) + (LRSH SPACELEFT 6)) + (add (fetch (LINEDESCRIPTOR LXLIM) of LINE) + (LRSH SPACELEFT 6)) + (COND + ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) + 0) + (ZEROP %#BLANKS) + (ZEROP PREVSP)) (* ; + "For empty lines, and lines with no spaces, don't bother fixing blank widths.") + (RETURN)))) + (JUSTIFIED (* ; + "For justified lines, stretch each space so line reaches the right margin") + (COND + ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) + 0) + (ZEROP %#BLANKS) + (ZEROP PREVSP)) (* ; + "For empty lines, and lines with no spaces, don't bother fixing blank widths.") + (RETURN))) + (COND + ((OR (fetch (LINEDESCRIPTOR CR\END) of LINE) + (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (* ; + "This is the last line in the paragraph; don't stretch it out.") + (SETQ EXTRASP 0)) + ((IEQP PREVSP (ADD1 (fetch (THISLINE LEN) of THISLINE))) + (* ; + "Only if the last character on the line is a space should we remove trailing spaces from the list") + (bind (OPREVSP _ (SUB1 PREVSP)) while (AND (IGREATERP PREVSP 0) + (ILEQ OPREVSP PREVSP)) + do + + (* ;; "Back up over all trailing white space on the line. So that those blanks don't get counted when computing the space to be added to each REAL space on the line, when it is justified.") + + (SETQ OPREVSP (SUB1 PREVSP)) + (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) + (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) + (add %#BLANKS -1)) + (COND + ((ZEROP %#BLANKS) (* ; + "If there aren't any blanks except at end-of-line, don't bother going further.") + (RETURN))) + (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR + RIGHTMARGIN) + of LINE)) + (* ; + "Fix the right margin for showing selections &c") + (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) + (* ; + "Now apportion the extra space evenly among blanks.") + ) + (T + (* ;; + "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.") + + (COND + ((ZEROP %#BLANKS) (* ; + "If there aren't any blanks, don't bother going further.") + (RETURN))) + (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR + RIGHTMARGIN) + of LINE)) + (* ; + "Fix the right margin for showing selections &c") + (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) + (* ; + "Now apportion the extra space evenly among blanks.") + )) + [while (IGREATERP PREVSP 0) + do (* ; + "Fix up the widths of spaces in the line") + (SETQ OPREVSP (SUB1 PREVSP)) + (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) + (add EXISTINGSPACE (\EDITELT WLIST OPREVSP)) + (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) + [OR (fetch (LINEDESCRIPTOR CR\END) of LINE) + (\EDITSETA WLIST OPREVSP (IPLUS (LRSH (IPLUS EXTRASP SPACEOFLOW) + 5) + (\EDITELT WLIST OPREVSP] + (SETQ SPACEOFLOW (LOGAND 31 (IPLUS EXTRASP SPACEOFLOW] + (COND + ([AND (NOT (ZEROP EXISTINGSPACE)) + (OR (NOT (ZEROP EXTRASP)) + (NOT (ZEROP (fetch (LINEDESCRIPTOR SPACELEFT) of LINE] + (* ; "Only if we really expanded the line -- and there are spaces to expand (or else EXISTINGSPACE is 0).") + (replace (THISLINE TLSPACEFACTOR) of THISLINE + with (FQUOTIENT (IPLUS EXISTINGSPACE (fetch (LINEDESCRIPTOR SPACELEFT + ) of LINE)) + EXISTINGSPACE)) (* ; + "And set the space factor for display") + ) + (T (* ; "Pathological cases ") + (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1))) + (RETURN)) + NIL) + (\TEDIT.PURGE.SPACES CHLIST PREVSP) (* ; + "Change all the spaces--chained for justification--back into regular spaces, for the display code.") + ]) +) +(DEFINEQ + +(\DISPLAYLINE + [LAMBDA (TEXTOBJ LINE WINDOW) (* ; "Edited 28-Sep-2021 15:00 by rmk:") + + (* ;; "Display the line of text LINE in the edit window where it belongs.") + + (* ;; "Validate the incoming arguments so ffetch can be used consistently for all their field extractions.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (\DTEST LINE 'LINEDESCRIPTOR) + (LET ((LOOKS (ffetch (THISLINE LOOKS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ))) + (WINDOWDS (WINDOWPROP (OR WINDOW (CAR (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ))) + 'DSP)) + (THISLINE (\DTEST (ffetch (TEXTOBJ THISLINE) of TEXTOBJ) + 'THISLINE)) + (OLDCACHE (fetch (LINECACHE LCBITMAP) of (ffetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ))) + (DS (ffetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) + (HCPYDS (ffetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ)) + (HARDCOPYMODE (fetch (FMTSPEC FMTHARDCOPY) of (ffetch (LINEDESCRIPTOR LFMTSPEC) + of LINE))) + CACHE OFONT OLOOKS XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT DDWIDTHCACHE + DDOFFSETCACHE CURY LHEIGHT SCALE) + [SETQ LHEIGHT (COND + ((ffetch (LINEDESCRIPTOR PREVLINE) of LINE) + (* ; + "So if theres a base-to-base measure, we clear everything right.") + (IMAX (IDIFFERENCE (ffetch (LINEDESCRIPTOR YBOT) + of (ffetch (LINEDESCRIPTOR PREVLINE) of LINE)) + (ffetch (LINEDESCRIPTOR YBOT) of LINE)) + (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE))) + (T (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (SETQ SCALE (COND + (HARDCOPYMODE (* ; + "This is a hardcopy-mode line. Scale things.") + (DSPSCALE NIL HCPYDS)) + (T 1))) + (SETQ CACHE (\TEDIT.LINECACHE (ffetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ) + (COND + (HARDCOPYMODE (FIXR (FQUOTIENT (ffetch (LINEDESCRIPTOR RIGHTMARGIN) + of LINE) + SCALE))) + (T (ffetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE))) + LHEIGHT)) + (COND + ((NEQ CACHE OLDCACHE) (* ; + "We changed the bitmaps because this line was bigger--update the displaystream, too") + (DSPDESTINATION CACHE DS) + (DSPCLIPPINGREGION (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch BITMAPWIDTH of CACHE) + HEIGHT _ (fetch BITMAPHEIGHT of CACHE)) + DS))) + (BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE) + (* ; "Clear the line cache") + [COND + ((AND (NOT (ZEROP (fetch (LINEDESCRIPTOR CHAR1) of LINE))) + (ILEQ (ffetch (LINEDESCRIPTOR CHAR1) of LINE) + (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (IGEQ (ffetch (LINEDESCRIPTOR YBOT) of LINE) + (ffetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + + (* ;; "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.") + + (COND + ((NEQ (fetch (THISLINE DESC) of THISLINE) + LINE) (* ; + "No image cache -- re-format and display") + (\FORMATLINE TEXTOBJ NIL (ffetch (LINEDESCRIPTOR CHAR1) of LINE) + LINE))) + (MOVETO (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) + (ffetch (LINEDESCRIPTOR DESCENT) of LINE) + DS) + (SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DS)) + (SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA)) + (SETQ XOFFSET (fetch DDXOFFSET of DISPLAYDATA)) + + (* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.") + + (SETQ CLIPLEFT (fetch DDClippingLeft of DISPLAYDATA)) + (* ; + "The left and right edges of the clipping region for the text display window.") + (SETQ CLIPRIGHT (fetch DDClippingRight of DISPLAYDATA)) + (SETQ OFONT (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS 0))) + DS)) (* ; "The starting font") + (SETQ DDWIDTHCACHE (ffetch DDWIDTHSCACHE of DISPLAYDATA)) + (* ; "Cache the character-image widths") + (SETQ DDOFFSETCACHE (ffetch DDOFFSETSCACHE of DISPLAYDATA)) + (* ; + "And the offset-into-strike-bitmap array") + (* ; + "LOOKSTARTX: Starting X position for the current-looks text.") + (AND (fetch CLOFFSET of OLOOKS) + (RELMOVETO 0 (FIXR (FTIMES SCALE (fetch CLOFFSET of OLOOKS))) + DS)) (* ; + "Any sub- or superscripting at start of line") + (bind (LOOKNO _ 1) + DX CH (CHLIST _ (fetch (THISLINE CHARS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)) + ) + (WLIST _ (fetch (THISLINE WIDTHS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ))) + (TX _ (IPLUS XOFFSET (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))) + (TERMSA _ (ffetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) + (LOOKSTARTX _ (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) for I from 0 + to (ffetch (THISLINE LEN) of THISLINE) + do + (* ;; "Display the line character by character") + + (SETQ CH (\EDITELT CHLIST I)) (* ; + "Grab the character (or IMAGEOBJ) to display") + (SETQ DX (\EDITELT WLIST I)) (* ; "And its width") + [SELECTC CH + (LMInvisibleRun (* ; + "An INVISIBLE run -- skip it, and skip over the char count") + (add LOOKNO 1)) + (LMLooksChange (* ; "A LOOKS change") + (replace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE TX + XOFFSET)) + (* ; + "Make the displaystream reflect our current X position") + (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS + (ffetch (LINEDESCRIPTOR DESCENT) of LINE)) + (* ; + "Make any necessary changes to the preceding characters (underline, strike-out &c)") + (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS LOOKNO)) + ) + DS) (* ; "Set the new font") + (add LOOKNO 1) (* ; "Grab the next set of char looks") + (AND (fetch CLOFFSET of OLOOKS) + (RELMOVETO 0 (fetch CLOFFSET of OLOOKS) + DS)) (* ; "Account for super/subscripting") + (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)) + (* ; + "Remember the starting Xpos for possible later underlining &c") + ) + ((CHARCODE (TAB %#^I)) (* ; + "TAB: use the width from the cache to decide the right formatting.") + [COND + ((OR (IEQP CH (CHARCODE %#^I)) + (fetch CLLEADER of OLOOKS) + (EQ (fetch CLUSERINFO of OLOOKS) + 'DOTTEDLEADER)) + (LET* [[LEADERFONT (COND + (HARDCOPYMODE (FONTCOPY (fetch CLFONT + of OLOOKS) + 'DEVICE HCPYDS)) + (T (fetch CLFONT of OLOOKS] + (DOTWIDTH (CHARWIDTH (CHARCODE %.) + LEADERFONT)) + (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER + TX DOTWIDTH] + (while (ILEQ TTX (IPLUS TX DX)) + do (COND + (HARDCOPYMODE (MI-TEDIT.BLTCHAR + (CHARCODE %.) + DS + (FIXR (FQUOTIENT (IDIFFERENCE TTX + DOTWIDTH) + SCALE)) + DISPLAYDATA DDPILOTBBT CLIPRIGHT)) + ((OR TERMSA HARDCOPYMODE) + (* ; "Using special instrns from TERMSA") + (\DSPPRINTCHAR DS (CHARCODE %.))) + (T (* ; "Native charcodes") + (MI-TEDIT.BLTCHAR (CHARCODE %.) + DS + (IDIFFERENCE TTX DOTWIDTH) + DISPLAYDATA DDPILOTBBT CLIPRIGHT))) + (add TTX DOTWIDTH]) + ((CHARCODE (EOL LF CR)) (* ; "It's a CR") + NIL) + (NIL (* ; "NIL signifies a character we've suppressed as part of line formatting (e.g., a discretionary hyphen we didn't use to break the line). Show it as a thin black line.") + (BLTSHADE BLACKSHADE DS TX 0 1 100 'PAINT)) + (COND + [(SMALLP CH) (* ; + "Normal character -- just display it.") + (COND + (HARDCOPYMODE (MI-TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX SCALE)) + DISPLAYDATA DDPILOTBBT CLIPRIGHT)) + ((OR TERMSA HARDCOPYMODE) (* ; "Using special instrns from TERMSA") + (\DSPPRINTCHAR DS CH)) + (T (* ; "Native charcodes") + (MI-TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT] + (T (* ; "CH is an object.") + (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) + XOFFSET) + (SETQ CURY (DSPYPOSITION NIL DS)) + DS) (* ; + "Go to the base line, left edge of the image region.") + (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN) + CH DS 'DISPLAY (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) + (* ; "Tell him to display himself here.") + (DSPFONT (fetch CLFONT of OLOOKS) + DS) + (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) + XOFFSET) + CURY DS) (* ; "Move to after the object's image") + ] + (add TX DX) (* ; "Update our X position") + finally (replace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE (FIXR (FQUOTIENT TX + SCALE)) + XOFFSET)) + (* ; + "Make any necessary looks mods to the last run of characters") + (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (ffetch (LINEDESCRIPTOR DESCENT) + of LINE] + (BITBLT CACHE 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBOT) of LINE) + (ffetch (TEXTOBJ WRIGHT) of TEXTOBJ) + LHEIGHT + 'INPUT + 'REPLACE) (* ; + "Paint the cached image on the screen (this lessens flicker during update)") + (COND + ((fetch (FMTSPEC FMTREVISED) of (ffetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) + (* ; + "This paragraph has been revised, so mark it.") + (\TEDIT.MARK.REVISION TEXTOBJ (ffetch (LINEDESCRIPTOR LFMTSPEC) of LINE) + WINDOWDS LINE))) + (SELECTQ (ffetch (LINEDESCRIPTOR LMARK) of LINE) + (GREY (* ; + "This line has some property that isn't visible to the user. Tell him to be careful") + (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) + 6 6 'TEXTURE 'PAINT 42405)) + (SOLID (* ; + "This line has some property that isn't visible to the user. Tell him to be careful") + (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) + 6 6 'TEXTURE 'PAINT BLACKSHADE)) + (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) + 6 6 'TEXTURE 'REPLACE WHITESHADE]) + +(\TEDIT.LINECACHE + [LAMBDA (CACHE WIDTH HEIGHT) (* jds "21-Apr-84 00:52") + + (* Given a candidate line cache, return the bitmap, making sure it's at least + WIDTH by HEIGHT big.) + + (PROG ((BITMAP (fetch LCBITMAP of CACHE)) + CW CH) + (SETQ CW (fetch BITMAPWIDTH of BITMAP)) + (SETQ CH (fetch BITMAPHEIGHT of BITMAP)) + (COND + ((AND (IGEQ CW WIDTH) + (IGEQ CH HEIGHT)) + (RETURN BITMAP)) + (T (RETURN (replace LCBITMAP of CACHE with (BITMAPCREATE (IMAX CW WIDTH) + (IMAX CH HEIGHT]) + +(\TEDIT.CREATE.LINECACHE + [LAMBDA (%#CACHES) (* jds "21-Apr-84 00:58") + (* Create a linked-together set of + LINECACHEs, for saving line images.) + (PROG [(CACHES (for I from 1 to %#CACHES collect (create LINECACHE + LCBITMAP _ (BITMAPCREATE 100 15] + [for CACHE on CACHES do (* Link the caches together.) + (replace LCNEXTCACHE of (CAR CACHE) with (OR (CADR CACHE) + (CAR CACHES] + (RETURN CACHES]) + +(\TEDIT.BLTCHAR + [LAMBDA (CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT) + (* jds " 9-Jan-86 17:14") + + (* Version of BLTCHAR peculiar to TEdit -- + relies on \DISPLAYLINE to make sure things keep working right.) + + (* puts a character on a guaranteed display stream. + Much of the information needed by the BitBlt microcode is prestored by the + routines that change it. This is kept in the BitBltTable.) + (* knows about the representation of + display stream image data) + (* MUST NOT POINT AT A WINDOW'S + DISPLAYSTREAM!!!) + + (* ASSUMES THAT WE NEVER WANT TO PRINT TO THE LEFT OF ORIGIN 0 ON THE LINE CACHE + BITMAP, OR THAT IF WE DO, ALL BETS ARE OFF) + + (DECLARE (LOCALVARS . T)) + (PROG (NEWX LEFT RIGHT IMAGEWIDTH (CHAR8CODE (\CHAR8CODE CHARCODE))) + [COND + ((NEQ (ffetch DDCHARSET of DISPLAYDATA) + (\CHARSET CHARCODE)) + (\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHARCODE] + (SETQ IMAGEWIDTH (\GETBASE (fetch DDCHARIMAGEWIDTHS of DISPLAYDATA) + (\CHAR8CODE CHARCODE))) + (SETQ NEWX (IPLUS CURX IMAGEWIDTH)) + (SETQ LEFT (IMAX 0 CURX)) + (SETQ RIGHT (IMIN CLIPRIGHT NEWX)) + (COND + ((ILESSP LEFT RIGHT) (* Only print anything if there is a + place to put it) + (UNINTERRUPTABLY + (freplace PBTDESTBIT of DDPILOTBBT with LEFT) + (* Set up the bitblt-table source left) + (freplace PBTWIDTH of DDPILOTBBT with (IMIN IMAGEWIDTH (IDIFFERENCE RIGHT LEFT))) + (freplace PBTSOURCEBIT of DDPILOTBBT with (\GETBASE (fetch DDOFFSETSCACHE + of DISPLAYDATA) + (\CHAR8CODE CHARCODE))) + (\PILOTBITBLT DDPILOTBBT 0)) + T]) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS MI-TEDIT.BLTCHAR MACRO [(CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT) + (COND + ((EQ 'MAIKO (MACHINETYPE)) + (SUBRCALL TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX DISPLAYDATA + DDPILOTBBT CLIPRIGHT)) + (T (\TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX DISPLAYDATA + DDPILOTBBT CLIPRIGHT]) +) +) +(DEFINEQ + +(TEDIT.CR.UPDATESCREEN + [LAMBDA (CH# XPOINT TEXTOBJ SEL LINE BLANKSEEN CRSEEN DS CHWIDTH DONTSCROLL) + (* ; "Edited 23-Feb-88 11:12 by jds") + + (* ;; "Update the edit window image after a CR is typed. Move any text after the CR to a new line, and push or pull text as needed.") + + (* ;; "(PROG ((WINDOW (fetch \WINDOW of TEXTOBJ)) (PREVLINE (fetch PREVLINE of LINE))) (COND ((AND (NOT (fetch CR\END of PREVLINE)) (ILEQ (IDIFFERENCE XPOINT (fetch LEFTMARGIN of LINE)) (IDIFFERENCE (fetch RIGHTMARGIN of PREVLINE) (fetch LXLIM of PREVLINE)))) (* This CR should push the start of the line back upward.) (replace DIRTY of PREVLINE with T) (replace TXTNEEDSUPDATE of TEXTOBJ with T))) (TEDIT.UPDATE.SCREEN TEXTOBJ PREVLINE T) (\FIXSEL SEL TEXTOBJ) (\SHOWSEL SEL NIL T) (COND (DONTSCROLL (* SO DO NOTHING)) ((OR (NOT (fetch NEXTLINE of LINE)) (ILEQ (fetch YBOT of (fetch NEXTLINE of LINE)) (fetch BOTTOM of (DSPCLIPPINGREGION NIL WINDOW)))) (* This pushed the caret off-screen. Move it up.) (replace EDITOPACTIVE of TEXTOBJ with NIL) (SCROLLW WINDOW 0 (LLSH (fetch LHEIGHT of (COND ((fetch NEXTLINE of LINE)) (LINE))) 1)))))") + + (HELP]) + +(TEDIT.DELETELINE + [LAMBDA (LINE TEXTOBJ WINDOW) (* ; "Edited 30-May-91 15:58 by jds") + + (* Remove a complete text line descriptor from the edit window, then move lower + lines up over it.) + + (PROG ((PREV (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) + (NEXT (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) (* Fix up the line-descriptor chain to + dis-include line) + (COND + (PREV (replace (LINEDESCRIPTOR NEXTLINE) of PREV with NEXT))) + (COND + (NEXT (replace (LINEDESCRIPTOR PREVLINE) of NEXT with PREV))) + (\TEDIT.CLOSEUPLINES TEXTOBJ PREV NEXT NIL WINDOW) (* And fix up the screen to cover the + blank space.) + ]) + +(TEDIT.INSERT.DISPLAYTEXT + [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 30-May-91 16:56 by jds") + (* This function does the actual + displaying of typed-in text on the + edit window.) + (* (PROG ((LOOKS (\TEDIT.APPLY.STYLES + (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) + TEXTOBJ)) (TERMSA (fetch + (TEXTOBJ TXTTERMSA) of TEXTOBJ)) DY + FONT) (DSPFONT (SETQ FONT + (fetch CLFONT of LOOKS)) DS) + (* Change the font) (COND + ((IGREATERP (FONTPROP + (fetch CLFONT of LOOKS) + (QUOTE ASCENT)) (fetch + (LINEDESCRIPTOR LTRUEASCENT) of LINE)) + (* The font this character is in is + taller than the existing line. + Adjust the LINEDESCRIPTOR's ascent.) + (\TEDIT.ADJUST.LINES TEXTOBJ LINE DS + (fetch (LINEDESCRIPTOR YBOT) of + (fetch (LINEDESCRIPTOR PREVLINE) of + LINE)) (IDIFFERENCE (fetch + (LINEDESCRIPTOR LTRUEASCENT) of LINE) + (FONTPROP (fetch CLFONT of LOOKS) + (QUOTE ASCENT)))) (* Move other text + to allow for the new height) + (add (fetch (LINEDESCRIPTOR ASCENT) of + LINE) (IDIFFERENCE (FONTPROP + (fetch CLFONT of LOOKS) + (QUOTE ASCENT)) (fetch + (LINEDESCRIPTOR LTRUEASCENT) of LINE))) + (replace (LINEDESCRIPTOR LTRUEASCENT) + of LINE with (FONTPROP + (fetch CLFONT of LOOKS) + (QUOTE ASCENT))))) (COND + ((IGREATERP (FONTPROP + (fetch CLFONT of LOOKS) + (QUOTE DESCENT)) (fetch + (LINEDESCRIPTOR LTRUEDESCENT) of LINE)) + (* If the caret's font will change the + line's descent, adjust lower lines + downward) (\TEDIT.ADJUST.LINES TEXTOBJ + (fetch (LINEDESCRIPTOR NEXTLINE) of + LINE) DS (fetch (LINEDESCRIPTOR YBOT) + of LINE) (IDIFFERENCE + (fetch (LINEDESCRIPTOR LTRUEDESCENT) + of LINE) (FONTPROP (fetch CLFONT of + LOOKS) (QUOTE DESCENT)))) + (add (fetch (LINEDESCRIPTOR DESCENT) + of LINE) (IDIFFERENCE + (FONTPROP (fetch CLFONT of LOOKS) + (QUOTE DESCENT)) (fetch + (LINEDESCRIPTOR LTRUEDESCENT) of LINE))) + (* Fix the line's leading-adjusted + descent to account for this change) + (replace (LINEDESCRIPTOR LTRUEDESCENT) + of LINE with (FONTPROP + (fetch CLFONT of LOOKS) + (QUOTE DESCENT))) (* Also the + unadjusted descent) (replace + (LINEDESCRIPTOR YBOT) of LINE with + (IDIFFERENCE (fetch (LINEDESCRIPTOR + YBASE) of LINE) (fetch + (LINEDESCRIPTOR DESCENT) of LINE))) + (* And note our new location.))) + (BITBLT DS XPOINT (fetch + (LINEDESCRIPTOR YBOT) of LINE) DS + (IPLUS XPOINT CHWIDTH) + (fetch (LINEDESCRIPTOR YBOT) of LINE) + (IDIFFERENCE (fetch (LINEDESCRIPTOR + RIGHTMARGIN) of LINE) XPOINT) + (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE INPUT) (QUOTE REPLACE)) + (* Move the old text over) + (BITBLT NIL 0 0 DS XPOINT + (fetch (LINEDESCRIPTOR YBOT) of LINE) + CHWIDTH (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) (* Blank out the area we're going to write + into) (MOVETO XPOINT + (IPLUS (fetch (LINEDESCRIPTOR YBASE) + of LINE) (OR (fetch CLOFFSET of LOOKS) + 0)) DS) (* Set the display stream + position) (COND (TERMSA + (* Special terminal table for + controlling character display. + Use it.) (RESETLST (RESETSAVE + \PRIMTERMSA TERMSA) (replace + (TEXTSTREAM REALFILE) of + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + with DS) (COND ((STRINGP CH) (for CHAR instring CH do (SELCHARQ CHAR (TAB (* Put down white) + (BITBLT NIL 0 0 DS XPOINT + (fetch (LINEDESCRIPTOR YBOT) of LINE) + 36 (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (BITBLT NIL 0 0 DS XPOINT + (fetch (LINEDESCRIPTOR YBOT) of LINE) + (IMAX 6 (CHARWIDTH CHAR FONT)) + (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE)) + (\DSPPRINTCHAR (fetch + (TEXTOBJ STREAMHINT) of TEXTOBJ) CHAR)))) + (T (SELCHARQ CH (TAB + (* Put down white) (BITBLT NIL 0 0 DS + XPOINT (fetch (LINEDESCRIPTOR YBOT) of + LINE) 36 (fetch (LINEDESCRIPTOR + LHEIGHT) of LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (BITBLT NIL 0 0 DS XPOINT + (fetch (LINEDESCRIPTOR YBOT) of LINE) + (IMAX 6 (CHARWIDTH CH FONT)) + (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE)) + (\DSPPRINTCHAR (fetch + (TEXTOBJ STREAMHINT) of TEXTOBJ) CH)))))) + (T (* No special handling; + just use native character codes) + (COND ((STRINGP CH) (for CHAR instring + CH do (SELCHARQ CHAR + (TAB (* Put down white) + (BITBLT NIL 0 0 DS (DSPXPOSITION NIL + DS) (fetch (LINEDESCRIPTOR YBOT) of + LINE) 36 (fetch (LINEDESCRIPTOR + LHEIGHT) of LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (BITBLT NIL 0 0 DS + (DSPXPOSITION NIL DS) + (fetch (LINEDESCRIPTOR YBOT) of LINE) + (IMAX 6 (CHARWIDTH CHAR FONT)) + (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE)) + (BLTCHAR CHAR DS)))) + (T (SELCHARQ CH (TAB + (* Put down white) (BITBLT NIL 0 0 DS + (DSPXPOSITION NIL DS) + (fetch (LINEDESCRIPTOR YBOT) of LINE) + 36 (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE) + (RELMOVETO 36 0 DS)) + (CR (* Blank out the CR's width.) + (BITBLT NIL 0 0 DS (DSPXPOSITION NIL + DS) (fetch (LINEDESCRIPTOR YBOT) of + LINE) (IMAX 6 (CHARWIDTH CH FONT)) + (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE)) + (BLTCHAR CH DS)))))) + (BITBLT NIL 0 0 DS (fetch + (LINEDESCRIPTOR LXLIM) of LINE) + (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (fetch (LINEDESCRIPTOR LHEIGHT) of + LINE) (QUOTE TEXTURE) + (QUOTE REPLACE) WHITESHADE) + (* Clear after EOL) (TEDIT.MODIFYLOOKS + LINE XPOINT DS LOOKS + (fetch (LINEDESCRIPTOR YBASE) of LINE)) + (* Do underlining, strike-out, etc.))) + (HELP]) + +(TEDIT.INSERT.UPDATESCREEN + [LAMBDA (CH CH# CHARS XPOINT TEXTOBJ SEL OTEXTLEN BLANKSEEN CRSEEN DONTSCROLL INCREMENTAL) + (* ; "Edited 30-May-91 16:06 by jds") + (* ; + "Update the edit window after an insertion") + (PROG ((THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) + (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) + SELINE EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES + NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE) + (replace (SELECTION CH#) of SEL with (IPLUS CHARS CH#)) + (* ; + "These must be here, since SELs are valid even without a window.") + (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) of SEL)) + (replace (SELECTION POINT) of SEL with 'LEFT) + (replace (SELECTION DCH) of SEL with 0) + (replace (SELECTION SELKIND) of SEL with 'CHAR) + (COND + ((AND INCREMENTAL (\SYSBUFP)) + + (* ;; "We're doing incremental updates, and there's type-in waiting. Bail out, now that we have fixed up the selection.") + + (RETURN)) + ((fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ) (* ; + "Don't update the screen if updates are being inhibited.") + (RETURN)) + ((NOT WINDOW) (* ; + "If this textobj has no window to update, don't bother") + (RETURN)) + ((OR T (LISTP WINDOW) + (TEXTPROP TEXTOBJ 'SLOWUPDATE)) (* ; + "FOR NOW, ALWAYS UPDATE THE SCREEN THE HARD WAY") + (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T (fetch (SELECTION CH#) of SEL)) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL NIL T))) + (\COPYSEL SEL TEDIT.SELECTION) + [for WW inside WINDOW as L1 inside (fetch (SELECTION L1) of SEL) as LN + inside (fetch (SELECTION LN) of SEL) as L1LIST on (fetch (SELECTION L1) of SEL) + as LNLIST on (fetch (SELECTION LN) of SEL) + do (COND + (DONTSCROLL + + (* ;; "If scrolling is suppressed, don't bother with the next check:") + + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WW)) + [(EQ WW (fetch (TEXTOBJ SELWINDOW) of TEXTOBJ)) + (COND + ([OR (NULL (SELECTQ (fetch (SELECTION POINT) of SEL) + (LEFT L1) + (RIGHT LN) + NIL)) + (ILEQ (SELECTQ (fetch (SELECTION POINT) of SEL) + (LEFT (fetch (LINEDESCRIPTOR YBOT) of L1)) + (RIGHT (fetch (LINEDESCRIPTOR YBOT) of LN)) + 0) + (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL WW] + + (* ;; + "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.") + + (while (OR [COND + ((SETQ SELINE (SELECTQ (fetch (SELECTION POINT) of SEL) + (LEFT (CAR L1LIST)) + (RIGHT (CAR LNLIST)) + NIL)) + (ILESSP (fetch (LINEDESCRIPTOR YBOT) of SELINE) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + (T (ILESSP (fetch (SELECTION Y0) of SEL) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] + (AND (IGEQ (fetch (SELECTION Y0) of SEL) + (fetch (TEXTOBJ WTOP) of TEXTOBJ)) + (NULL SELINE))) + do + (* ;; "The caret just went off-screen. Move it up some.") + + (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) + (SCROLLW WW 0 (LLSH (COND + [(SELECTQ (fetch (SELECTION POINT) of SEL) + (LEFT (CAR L1LIST)) + (RIGHT (CAR LNLIST)) + NIL) + (fetch (LINEDESCRIPTOR LHEIGHT) + of (SELECTQ (fetch (SELECTION POINT) + of SEL) + (LEFT (CAR L1LIST)) + (RIGHT (CAR LNLIST)) + (SHOULDNT] + (T 12)) + 1] + (T (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WW] + (\COPYSEL SEL TEDIT.SELECTION]) + +(TEDIT.UPDATE.SCREEN + [LAMBDA (TEXTOBJ STARTINGLINE INCREMENTAL? NEXTCARETCH#) (* ; "Edited 30-May-91 15:58 by jds") + (* Update the screen, as needed to fix + up "dirty" lines.) + (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) + (COND + ((NOT (fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ)) (* ; + "Only update the screen if we aren't suppressing updating.") + (bind NLINE for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINE + inside (OR STARTINGLINE (fetch (TEXTOBJ LINES) of TEXTOBJ)) + do (SETQ NLINE (\TEDIT.FIXCHANGEDPART TEXTOBJ LINE WW INCREMENTAL? NEXTCARETCH#)) + (* The last line in the edit window) + (AND NLINE (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of NLINE) + NLINE TEXTOBJ NIL WW NEXTCARETCH#]) + +(\BACKFORMAT + [LAMBDA (LINES TEXTOBJ WHEIGHT) (* ; "Edited 30-May-91 15:58 by jds") + + (* Move back to the next preceding CR (to guarantee a line break)%, then format + lines to reach where we are now.) + (* LINES is the dummy first line for + this window in TEXTOBJ) + + (* Returns a pointer to the last of the back-formatted lines + (i.e., the one that comes latest in the document)%, or to LINES if no lines are + formatted) + + (PROG ((LINE1 (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) + CH1 CHNO CH NLINE) + [SETQ CH1 (COND + (LINE1 (fetch (LINEDESCRIPTOR CHAR1) of LINE1)) + (T (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] + (COND + ((ILEQ CH1 1) (* No more lines can be formatted -- + we're at the front of the file.) + (RETURN LINES)) + (T (* There is more to do.) + (\SETUPGETCH (IDIFFERENCE CH1 1) + TEXTOBJ) + [for old CHNO from (IDIFFERENCE CH1 2) to 1 by -1 + do (* Back up until we find a CR) + (SETQ CH (\GETCHB TEXTOBJ)) + (COND + ((EQ CH (CHARCODE CR)) + (RETURN] + (SETQ CHNO (IMAX (ADD1 CHNO) + 1)) (* But never further than the front of + the document) + (while (ILEQ CHNO (SUB1 CH1)) do (* Now move forward, formatting lines + until we catch up with where we were.) + (SETQ NLINE (\FORMATLINE TEXTOBJ NIL CHNO)) + (* Format the next line) + (replace (LINEDESCRIPTOR YBOT) of NLINE with WHEIGHT + ) (* Make sure it thinks it's off-window) + (replace (LINEDESCRIPTOR YBASE) of NLINE + with WHEIGHT) + (replace (LINEDESCRIPTOR PREVLINE) of NLINE + with LINES) + (* Hook it onto the end of the chain) + (replace (LINEDESCRIPTOR NEXTLINE) of LINES + with NLINE) + (SETQ LINES NLINE) + (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) + of NLINE))) + (* And find the start of the next line)) + (replace (LINEDESCRIPTOR NEXTLINE) of NLINE with LINE1) + + (* Now, with the final line we formatted, hook the rest of the line chain onto + it.) + + (AND LINE1 (replace (LINEDESCRIPTOR PREVLINE) of LINE1 with NLINE)) + (RETURN NLINE]) + +(\FILLWINDOW + [LAMBDA (YBOT CURLINE TEXTOBJ DONTFILLFLG WINDOW NEXTCARETCH#) + (* ; "Edited 30-May-91 16:57 by jds") + (* Fill out TEXTOBJ's window, starting + with the line after CURLINE, whose + ybottom is YBOT) + (* Return T if any lines are moved up.) + (* DONTFILLFLG => Don't bother + printing any new lines at the bottom + of the screen.) + + (* NEXTCARETCH# => always format to at least this CH#, to assure that we know + where the caret will next be.) + + (PROG* ((LINE (fetch (LINEDESCRIPTOR NEXTLINE) of CURLINE)) + (CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of CURLINE)) + (PREVLINE CURLINE) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (LINES\DELETED NIL) + (WINDOW (OR WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) + (WHEIGHT (WINDOWPROP WINDOW 'HEIGHT)) + NEXTLINE OFLOWFN) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) + (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) + WHEIGHT)) do (* Do not start with a line which is + above the top of the screen.) + (SETQ PREVLINE LINE) + (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) + of LINE)) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) + of LINE))) + [repeatwhile (ILESSP CHARLIM TEXTLEN) + do (* Walk thru the lines below the + starting line.) + [COND + ((AND LINE (IGEQ (SETQ YBOT (\TEDIT.NEXT.LINE.BOTTOM YBOT LINE PREVLINE)) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + (* If there is a line to display, and + space to display it, go ahead.) + (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR + DESCENT) + of LINE))) + (\DISPLAYLINE TEXTOBJ LINE WINDOW)) + [(AND LINE NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) + NEXTCARETCH#)) + (* There's a line, and it's earlier + than the next caret location. + Keep going.) + (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR + DESCENT) + of LINE] + (LINE (* There is a line, but it won't fit.) + [COND + ((fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) + (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of PREVLINE))) + (T (SETQ YBOT (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] + + (* This existing line won't fit. Punt out of this, setting YBOT so the screen + gets cleared right.) + + [COND + ((SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) + (* Try calling any user-supplied + overflow fn, to handle the space + overflow) + (AND (APPLY* OFLOWFN WINDOW TEXTOBJ) + (RETFROM '\FILLWINDOW NIL] + (RETURN)) + (DONTFILLFLG (* We are instructed NOT to try + filling the screen, so punt out.) + (RETURN)) + ((OR (ILESSP CHARLIM TEXTLEN) + (AND (IEQP CHARLIM TEXTLEN) + (fetch (LINEDESCRIPTOR CR\END) of CURLINE)) + (ZEROP TEXTLEN)) (* No existing lines to display, but + there's text left (or the doc is empty + and we need a dummy first line)) + (SETQ LINE (\FORMATLINE TEXTOBJ NIL (ADD1 CHARLIM))) + (* Format the next line) + (replace (LINEDESCRIPTOR PREVLINE) of LINE with PREVLINE) + (* Hook it into the chain of line + descriptors) + (replace (LINEDESCRIPTOR NEXTLINE) of LINE with (SETQ NEXTLINE + (fetch (LINEDESCRIPTOR NEXTLINE + ) of PREVLINE))) + (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with LINE) + (AND NEXTLINE (replace (LINEDESCRIPTOR PREVLINE) of NEXTLINE with LINE)) + (COND + ((IGEQ [COND + [(fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LINE)) + (SETQ YBOT (IDIFFERENCE (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT + ) of PREVLINE)) + (IPLUS (fetch FMTBASETOBASE + of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LINE)) + (fetch (LINEDESCRIPTOR DESCENT) + of LINE] + (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE] + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (* If there's room, display the new + line) + (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( + LINEDESCRIPTOR + DESCENT) + of LINE))) + (\DISPLAYLINE TEXTOBJ LINE WINDOW)) + [(AND NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) + NEXTCARETCH#)) + + (* This line is needed to find the next caret location, even tho it won't fit on + the screen) + + (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( + LINEDESCRIPTOR + DESCENT) + of LINE] + (T (* Otherwise, we've overflown the + window again) + (SETQ YBOT (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE))) + [COND + ((SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) + (AND (APPLY* OFLOWFN WINDOW TEXTOBJ) + (RETFROM '\FILLWINDOW NIL] + (RETURN] + (COND + (LINE (* Move forward to the next line in + the chain, if any) + (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) + (SETQ PREVLINE LINE) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + (T (* Otherwise, note that we ran off the + end of the file.) + (SETQ CHARLIM (ADD1 TEXTLEN] + (while LINE do + + (* If there are any existing lines which didn't fit, set their YBOTs to 0 so they + don't show) + + [AND (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) + TEXTLEN) + (replace (LINEDESCRIPTOR YBOT) of LINE + with (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + (COND + ((IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (* If there is space left at the + bottom of the window, blank it out.) + (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (IDIFFERENCE YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + 'TEXTURE + 'REPLACE WHITESHADE))) + (COND + ((AND PREVLINE (fetch (LINEDESCRIPTOR CR\END) of PREVLINE) + (OR (ILESSP (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) + WHEIGHT) + (ILEQ (fetch (LINEDESCRIPTOR CHARTOP) of PREVLINE) + 0)) + (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE) + TEXTLEN)) (* If the last line ends in a CR, put + a dummy line below it.) + [SETQ LINE (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with (\FORMATLINE + TEXTOBJ NIL + (ADD1 TEXTLEN] + (replace (LINEDESCRIPTOR PREVLINE) of LINE with PREVLINE) + (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) + of PREVLINE) + (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE))) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IDIFFERENCE (fetch (LINEDESCRIPTOR + YBOT) of PREVLINE) + (fetch (LINEDESCRIPTOR ASCENT) + of LINE))) + (replace (LINEDESCRIPTOR CHARLIM) of LINE with (ADD1 TEXTLEN)) + (SETQ PREVLINE LINE))) + (COND + ((AND (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE) + TEXTLEN) + (NOT (fetch (LINEDESCRIPTOR CR\END) of PREVLINE))) + (* This line lies at end of text, so + chop off any following lines.) + (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with NIL))) + (RETURN LINES\DELETED]) + +(\FIXDLINES + [LAMBDA (LINES SEL CH#1 CH#LIM TEXTOBJ) (* ; "Edited 30-May-91 15:59 by jds") + + (* ;; + "Fix up the list LINES of line descriptors, given that characters CH#1 thru CH#LIM were deleted.") + + (* ;; "Change CHAR1 and CHARLIM entries in each descriptor, and remove any descriptors for lines which disappeared entirely.") + + (COND + ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) + + (* ;; "Only do this if we're allowed to change the document.") + + (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + do (SETQ LINES (WINDOWPROP WW 'LINES)) + (PROG ((NLINES LINES) + (DCH (IDIFFERENCE CH#LIM CH#1)) + (CH#1L (SUB1 CH#1)) + PL NL CHARLIM) + (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) + CHARLIM CHAR1 while LINE + do (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) + (SETQ CHAR1 (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (COND + [(ILESSP CHARLIM CH#1) + (COND + ((AND (IGEQ CH#1 CHAR1) + (ILEQ CH#1 (fetch (LINEDESCRIPTOR CHARTOP) of LINE))) + + (* ;; "This change happened in a place where it may affect this line's break decision. Better reformat to be safe.") + + (replace (LINEDESCRIPTOR DIRTY) of LINE with T) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T)) + ((AND (fetch (LINEDESCRIPTOR CR\END) of LINE) + (IEQP CHARLIM CH#1L)) + + (* ;; "This line ends in CR, and the deletion starts immediately thereafter. Best to reformat, for safety.") + + (replace (LINEDESCRIPTOR DIRTY) of LINE with T) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T] + ((IGEQ CHAR1 CH#LIM) (* ; + "This line contains none of the deleted text but is after it. Update CHAR1, CHARLIM and CHARTOP") + (replace (LINEDESCRIPTOR CHAR1) of LINE with (IMAX 1 (IDIFFERENCE + CHAR1 DCH))) + (replace (LINEDESCRIPTOR CHARLIM) of LINE with (IDIFFERENCE CHARLIM DCH + )) + (replace (LINEDESCRIPTOR CHARTOP) of LINE + with (IDIFFERENCE (fetch (LINEDESCRIPTOR CHARTOP) of LINE) + DCH))) + [(OR (ILESSP CHAR1 CH#1) + (IGEQ CHARLIM CH#LIM)) (* ; + "This line contains some of the deleted text, mark it as dirty and update CHAR1 and CHARLIM") + (replace (LINEDESCRIPTOR DIRTY) of LINE with T) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T) + (replace (LINEDESCRIPTOR CHAR1) of LINE with (IMAX 1 (IMIN CHAR1 CH#1)) + ) + (COND + [(IGEQ CHARLIM CH#LIM) + (replace (LINEDESCRIPTOR CHARLIM) of LINE + with (IDIFFERENCE CHARLIM (IMIN DCH (IDIFFERENCE CH#LIM CHAR1] + (T (replace (LINEDESCRIPTOR CHARLIM) of LINE with CH#1L] + (T (* ; + "This line is totally within the deleted text, remove it") + (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) + (SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) + (COND + (PL (replace (LINEDESCRIPTOR NEXTLINE) of PL with NL))) + (COND + (NL (replace (LINEDESCRIPTOR PREVLINE) of NL with PL))) + (COND + ((EQ NLINES LINE) + (SETQ NLINES NL))) + (replace (LINEDESCRIPTOR DELETED) of LINE with T) + (* ; + "Mark this line deleted, so DELETETEXTCHARS know to ignore it.") + (AND NL (replace (LINEDESCRIPTOR DIRTY) of NL with T)) + (* ; + "This may well force a reformatting of the next line. Mark it dirty just in case.") + )) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + (\TEDIT.FIXDELSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + TEXTOBJ CH#1 CH#LIM DCH) (* ; + "Fix up the selections in this textobj") + (\TEDIT.FIXDELSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) + TEXTOBJ CH#1 CH#LIM DCH) + (\TEDIT.FIXDELSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) + TEXTOBJ CH#1 CH#LIM DCH) + (\TEDIT.FIXDELSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) + TEXTOBJ CH#1 CH#LIM DCH) + (RETURN NLINES]) + +(\FIXILINES + [LAMBDA (TEXTOBJ SEL CH#1 DCH OTEXTLEN) (* ; "Edited 30-May-91 16:07 by jds") + + (* ;; "Fix the list LINES of line descriptors to account for DCH characters inserted before CH#1") + + (COND + ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) + + (* ;; "Only make this change if you're allowed to change the document.") + + (LET (LINES CH# CHLIM CHAR1 CHARLIM) + (SETQ CH#1 (IMAX CH#1 1)) (* ; + "Make sure we're inserting in a legit spot.") + [for WW inside (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES + inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as L1 in (fetch (SELECTION L1) of SEL) + do + (* ;; "For each pane in the editing window, examine the pane's list of lines") + + (bind [LINE _ (COND + ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINES) + 0) (* ; + "Make sure to skip the initial dummy line") + LINES) + (T (ffetch (LINEDESCRIPTOR NEXTLINE) of LINES] while LINE + do (\DTEST LINE 'LINEDESCRIPTOR) + (COND + ((IGREATERP (SETQ CHAR1 (ffetch (LINEDESCRIPTOR CHAR1) of LINE)) + CH#1) (* ; + "This line starts after the insertion point. Update it's CHAR1") + (freplace (LINEDESCRIPTOR CHAR1) of LINE with (IPLUS CHAR1 DCH))) + ((AND (IEQP CH#1 CHAR1) + (NEQ LINE L1)) (* ; + "The insertion is at the end of the PRIOR line--so go ahead and update this CHAR1") + (freplace (LINEDESCRIPTOR CHAR1) of LINE with (IPLUS CHAR1 DCH)) + (COND + ((ffetch (LINEDESCRIPTOR PREVLINE) of LINE) + (freplace (LINEDESCRIPTOR DIRTY) of (ffetch (LINEDESCRIPTOR PREVLINE + ) of LINE) + with T))) + (freplace (LINEDESCRIPTOR DIRTY) of LINE with T) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T)) + ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINE) + CH#1) (* ; + "This line spans the insert point. Mark it DIRTY.") + (freplace (LINEDESCRIPTOR DIRTY) of LINE with T) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T)) + ((AND (IGEQ (SETQ CHARLIM (ffetch (LINEDESCRIPTOR CHARLIM) of LINE)) + OTEXTLEN) + (NOT (ffetch (LINEDESCRIPTOR CR\END) of LINE))) + + (* ;; "This line is the last in the file, and its CHAR1 is <= the insert point, and it doesn't end in a CR. Therefore, move the line's end upward to accomodate the insertion.") + + (freplace (LINEDESCRIPTOR DIRTY) of LINE with T) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T))) + [COND + ([OR (IGEQ (SETQ CHARLIM (ffetch (LINEDESCRIPTOR CHARLIM) of LINE)) + CH#1) + (AND (IGEQ CHARLIM OTEXTLEN) + (NOT (ffetch (LINEDESCRIPTOR CR\END) of LINE] + (freplace (LINEDESCRIPTOR CHARLIM) of LINE with (IPLUS CHARLIM DCH)) + (COND + ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINE) + CH#1) + (freplace (LINEDESCRIPTOR CHARTOP) of LINE + with (IPLUS (ffetch (LINEDESCRIPTOR CHARTOP) of LINE) + DCH] + (SETQ LINE (ffetch (LINEDESCRIPTOR NEXTLINE) of LINE] + (\TEDIT.FIXINSSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) + TEXTOBJ CH#1 DCH) + (\TEDIT.FIXINSSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) + TEXTOBJ CH#1 DCH) + (\TEDIT.FIXINSSEL SEL TEXTOBJ CH#1 DCH]) + +(\SHOWTEXT + [LAMBDA (TEXTOBJ LINES WINDOW) + + (* ;; "Edited 12-Jan-2022 18:56 by rmk: I took out the WAITINGCURSOR, the resetsave wasn't working for some reason, and it really isn't necessary for modern machines.") + + (* ;; "Edited 12-Jun-90 19:22 by mitani") + + (* ;; "Fill the editor window with text, starting from the top of the file.") + + (COND + ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* ; + "If there is no edit window, just return.") + (PROG1 (PROG (WREG) + (SETQ WINDOW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) + (DSPFILL (PROG1 (DSPCLIPPINGREGION NIL WINDOW) + (* ; "For region within a window:") + + (* ;; "(CREATEREGION (fetch (TEXTOBJ WLEFT) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) (fetch (TEXTOBJ WLEFT) of TEXTOBJ)) (IDIFFERENCE (fetch (TEXTOBJ WTOP) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)))") + + ) + WHITESHADE + 'REPLACE WINDOW) (* ; "Clear the window.") + (RETURN (RESETLST + + (* ;; "RMK: For reasons unknown, the original cursor is not restored when this exits. But there is presumably no need for this waiting indicator in modern times. This only fills lines visible within a window, and machines are really fast.") + + (* ;; "Display the hourglass cursor as we work") + + (AND NIL (RESETSAVE (CURSOR WAITINGCURSOR))) + (SETQ LINES + (create LINEDESCRIPTOR + YBOT _ (WINDOWPROP WINDOW 'HEIGHT) + CHAR1 _ 0 + CHARLIM _ 0 + SPACELEFT _ -1 + RIGHTMARGIN _ (SUB1 (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) + NEXTLINE _ NIL + CHARTOP _ -1 + LHEIGHT _ 0 + LXLIM _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + CR\END _ T + ASCENT _ 0 + DESCENT _ 0 + LTRUEASCENT _ 0 + LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC)) + (* ; + "Make sure we have the anchor pseudo-line") + (WINDOWPROP WINDOW 'LINES LINES) + (\FILLWINDOW (WINDOWPROP WINDOW 'HEIGHT) + LINES TEXTOBJ NIL WINDOW) + (* ; "Fill the window as usual") + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW) + LINES)]) + +(\TEDIT.ADJUST.LINES + [LAMBDA (TEXTOBJ FIRSTLINE WINDOW LINETOP DY) (* ; "Edited 30-May-91 15:59 by jds") + + (* Move all lines from FIRSTLINE (inclusive) on up or down. + Fill in a line or drop one off, accordingly. + Positive DY means move UP.) + + (* LINETOP is the top of the region to be moved as the adjustment is made. + It corresponds to the TOP of FIRSTLINE.) + + (PROG ((OFLOW NIL) + OFLOWFN OYBOT PREVLINE) + [COND + ((ZEROP DY) (* This line's total height HAS NOT + CHANGED. Don't make any adjustments.) + ) + ((ILESSP LINETOP (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (* This line is off the screen. + Don't bother adjusting it.) + ) + (FIRSTLINE + + (* This line's total height changed -- must move the rest of the window, and + adjust YBOT/BASEs.) + + (bind (LL _ FIRSTLINE) while (AND LL (IGEQ (fetch (LINEDESCRIPTOR YBOT) + of LL) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + do + + (* Loop thru the line descriptors that are affected by the change + (i.e., those below it)%, and adjust their Y locations.) + + (SETQ OYBOT (fetch (LINEDESCRIPTOR YBOT) of LL)) + [COND + ((ILESSP (replace (LINEDESCRIPTOR YBOT) of LL with (IPLUS OYBOT DY)) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (* This line moved below the bottom of + the screen) + (BITBLT NIL 0 0 WINDOW 0 OYBOT (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (fetch (LINEDESCRIPTOR LHEIGHT) of LL) + 'TEXTURE + 'REPLACE WHITESHADE) (* So clear the space it used to + occupy.) + (COND + ((AND (SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) + (SETQ OFLOW T) + (APPLY* OFLOWFN WINDOW TEXTOBJ) + (RETURN NIL)) + + (* We walked off the bottom, and the user gave us an OFLOWFN to handle it. + Give it a try.) + + ] + (add (fetch (LINEDESCRIPTOR YBASE) of LL) + DY) (* Adjust the baseline of the line, as + well as its physical bottom.) + (replace (LINEDESCRIPTOR YBOT) of LL with (IDIFFERENCE (fetch ( + LINEDESCRIPTOR + YBASE) + of LL) + (fetch (LINEDESCRIPTOR + DESCENT) + of LL))) + (* I realize this looks redundant, but + the line's descent may have changed, + too.) + (SETQ PREVLINE LL) + + (* Remember the prior line, since we'll need it if we later try to fill out the + window with more text.) + + (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL)) + (* Move to the next line.)) + (AND OFLOW (RETURN NIL)) + + (* If there was an overflow, and it got handled by the user's OFLOWFN, don't + bother trying anything further.) + + (COND + [(IGREATERP DY 0) (* The line is shorter; + move the rest up.) + (BITBLT WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + WINDOW 0 (IPLUS DY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + LINETOP + 'INPUT + 'REPLACE) (* Move the text up) + (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + DY + 'TEXTURE + 'REPLACE WHITESHADE) (* Now clear the bottom part of the + window, which got vacated by the + adjustment) + (COND + ((AND PREVLINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + + (* If there is space left on the screen, try to fill it with new text.) + + (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) + PREVLINE TEXTOBJ NIL WINDOW] + (T (* The line is taller; + move the rest down.) + (BITBLT WINDOW 0 (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + (IMINUS DY)) + WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (IDIFFERENCE LINETOP (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + 'INPUT + 'REPLACE) (* Move the text down) + (BITBLT NIL 0 0 WINDOW 0 (IPLUS LINETOP DY) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (IMINUS DY) + 'TEXTURE + 'REPLACE WHITESHADE) (* Now clear the region we moved it + out of.) + ] + (RETURN T]) + +(\TEDIT.CLEAR.SCREEN.BELOW.LINE + [LAMBDA (TEXTOBJ WINDOW LINE) (* ; "Edited 30-May-91 15:59 by jds") + (* Clears the edit window to white, + clearing only the sapce below the line + given.) + (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + 'TEXTURE + 'REPLACE WHITESHADE]) + +(\TEDIT.CLOSEUPLINES + [LAMBDA (TEXTOBJ PREVLINE NEXTLINE DONTFILLFLG WINDOW) (* ; "Edited 30-May-91 15:59 by jds") + + (* ;; "Given a gap between PREVLINE and NEXTLINE, move NEXTLINE et seq up to coverthe gap, and adjust the YBOTs. If DONTFILLFLG is T then we're not filling the screen") + (* ; + "NEXTLINE = NIL => remove all lower lines.") + (COND + (PREVLINE (* ; + "PREVLINE = NIL => DON'T close up anything.") + (PROG [DY (WWIDTH (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (fetch (TEXTOBJ WLEFT) of TEXTOBJ))) + (LOWESTY (COND + (PREVLINE (fetch (LINEDESCRIPTOR YBOT) of PREVLINE)) + (T (ADD1 (fetch (TEXTOBJ WTOP) of TEXTOBJ] + [COND + (NEXTLINE (* ; + "If the gap isn't at the end, move whatever else up over it.") + [SETQ DY (IDIFFERENCE LOWESTY (IPLUS (fetch (LINEDESCRIPTOR YBOT) + of NEXTLINE) + (fetch (LINEDESCRIPTOR LHEIGHT) + of NEXTLINE] + (AND (ILEQ DY 0) + (RETURN)) (* ; + "If there's no gap, don't bother with anything else.") + (BITBLT WINDOW (fetch (TEXTOBJ WLEFT) of TEXTOBJ) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + WINDOW + (fetch (TEXTOBJ WLEFT) of TEXTOBJ) + (IPLUS DY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + WWIDTH + (IPLUS (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of NEXTLINE) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (fetch (LINEDESCRIPTOR LHEIGHT) of NEXTLINE)) + 'INPUT + 'REPLACE) (* ; "Move the remaining lines upward.") + (bind (LINE _ NEXTLINE) + (NYBOT _ LOWESTY) while LINE + do (* ; + "Scan the remaining lines, fixing up the vertical spacing information") + (SETQ NYBOT (IDIFFERENCE NYBOT (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE))) + (COND + ((IGEQ NYBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (SETQ LOWESTY NYBOT))) + [COND + [(ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (* ; + "Line is off screen. Display it at the right spot.") + (AND DONTFILLFLG (RETURN)) + (* ; + "If we're not filling the screen, then stop here.") + (replace (LINEDESCRIPTOR YBOT) of LINE with NYBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE + with (IPLUS NYBOT (fetch (LINEDESCRIPTOR DESCENT) + of LINE))) + (\DISPLAYLINE TEXTOBJ LINE WINDOW) + (COND + ((fetch (LINEDESCRIPTOR NEXTLINE) of LINE) + (* ; + "There's a next line after the current one. Use it") + ) + ((IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (* ; + "We're at the end of the text; don't bother trying to add more lines") + ) + (T (* ; + "There's more; try adding another line.") + [replace (LINEDESCRIPTOR NEXTLINE) of LINE + with (\FORMATLINE TEXTOBJ NIL + (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) + of LINE] + (replace (LINEDESCRIPTOR PREVLINE) + of (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) + with LINE] + (T (* ; + "Line is visible; just update YBOT/YBASE") + (replace (LINEDESCRIPTOR YBOT) of LINE with NYBOT) + (replace (LINEDESCRIPTOR YBASE) of LINE + with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch (LINEDESCRIPTOR DESCENT) of LINE] + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) + until (ILESSP NYBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] + (BITBLT NIL 0 0 WINDOW (fetch (TEXTOBJ WLEFT) of TEXTOBJ) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + WWIDTH + (IDIFFERENCE LOWESTY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + 'TEXTURE + 'REPLACE WHITESHADE) (* ; + "Clear the part of the screen below the lowest line now displayed") + (RETURN T]) + +(\TEDIT.COPY.LINEDESCRIPTOR + [LAMBDA (FROMLINE TOLINE) (* ; "Edited 30-May-91 16:57 by jds") + + (* Copy the contents of one line descriptor into another -- + except for chaining and Y-location info.) + + (freplace (LINEDESCRIPTOR LEFTMARGIN) of TOLINE with (ffetch (LINEDESCRIPTOR LEFTMARGIN) + of FROMLINE)) + (freplace (LINEDESCRIPTOR RIGHTMARGIN) of TOLINE with (ffetch (LINEDESCRIPTOR RIGHTMARGIN) + of FROMLINE)) + (freplace (LINEDESCRIPTOR LXLIM) of TOLINE with (ffetch (LINEDESCRIPTOR LXLIM) of FROMLINE)) + (freplace (LINEDESCRIPTOR SPACELEFT) of TOLINE with (ffetch (LINEDESCRIPTOR SPACELEFT) + of FROMLINE)) + (freplace (LINEDESCRIPTOR LHEIGHT) of TOLINE with (ffetch (LINEDESCRIPTOR LHEIGHT) of FROMLINE)) + (freplace (LINEDESCRIPTOR CHAR1) of TOLINE with (ffetch (LINEDESCRIPTOR CHAR1) of FROMLINE)) + (freplace (LINEDESCRIPTOR CHARLIM) of TOLINE with (ffetch (LINEDESCRIPTOR CHARLIM) of FROMLINE)) + (freplace (LINEDESCRIPTOR CHARTOP) of TOLINE with (ffetch (LINEDESCRIPTOR CHARTOP) of FROMLINE)) + (freplace (LINEDESCRIPTOR DIRTY) of TOLINE with NIL) + (freplace (LINEDESCRIPTOR CR\END) of TOLINE with (ffetch (LINEDESCRIPTOR CR\END) of FROMLINE)) + (freplace (LINEDESCRIPTOR LDOBJ) of TOLINE with (ffetch (LINEDESCRIPTOR LDOBJ) of FROMLINE)) + (freplace (LINEDESCRIPTOR LHASPROT) of TOLINE with (ffetch (LINEDESCRIPTOR LHASPROT) of FROMLINE) + ) + (freplace (LINEDESCRIPTOR LFMTSPEC) of TOLINE with (ffetch (LINEDESCRIPTOR LFMTSPEC) of FROMLINE) + ) + (freplace (LINEDESCRIPTOR LTRUEDESCENT) of TOLINE with (ffetch (LINEDESCRIPTOR LTRUEDESCENT) + of FROMLINE)) + (freplace (LINEDESCRIPTOR LTRUEASCENT) of TOLINE with (ffetch (LINEDESCRIPTOR LTRUEASCENT) + of FROMLINE)) + (freplace (LINEDESCRIPTOR ASCENT) of TOLINE with (ffetch (LINEDESCRIPTOR ASCENT) of FROMLINE)) + (freplace (LINEDESCRIPTOR DESCENT) of TOLINE with (ffetch (LINEDESCRIPTOR DESCENT) of FROMLINE)) + (freplace (LINEDESCRIPTOR LHASTABS) of TOLINE with (ffetch (LINEDESCRIPTOR LHASTABS) of FROMLINE) + ) + (freplace (LINEDESCRIPTOR LMARK) of TOLINE with (ffetch (LINEDESCRIPTOR LMARK) of FROMLINE)) + (freplace (LINEDESCRIPTOR 1STLN) of TOLINE with (ffetch (LINEDESCRIPTOR 1STLN) of FROMLINE)) + (freplace (LINEDESCRIPTOR LSTLN) of TOLINE with (ffetch (LINEDESCRIPTOR LSTLN) of FROMLINE]) + +(\TEDIT.FIXCHANGEDLINE + [LAMBDA (TEXTOBJ PREVYBOT LINES WINDOW TEXTLEN THISLINE WHEIGHT CHARLIM NEXTCARETCH# PREVDESCENT) + (* ; "Edited 30-May-91 16:57 by jds") + (* Reformat a single line, if need be. + Returns the changed line) + (PROG ((YBOT PREVYBOT) + (FORMATDONE NIL) + LIMITCHANGED WASDIRTY OCHLIM OLHEIGHT (PREVLINE NIL) + (FOUND NIL) + DY OFLOWFN NEWLINE) + [COND + ((IEQP CHARLIM 1) + (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES] + (COND + ([OR (fetch (LINEDESCRIPTOR DIRTY) of LINES) + (NOT (IEQP CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES] + + (* Only act if this line has changed, or if there is a gap or overlap between + this line and the prior one) + + (SETQ OCHLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINES)) + (* This line's old CHLIM, for seeing + if it changes) + (SETQ OLHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES)) + (* This line's old height, for seeing + if it changes.) + (SETQ NEWLINE (\FORMATLINE TEXTOBJ NIL CHARLIM)) + (* Create the fresh line) + (COND + ((AND (ILESSP CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES)) + (IEQP (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of NEWLINE)) + (fetch (LINEDESCRIPTOR CHAR1) of LINES))) + (* If this is a space-filling line, + just move the other lines down.) + (\TEDIT.INSERTLINE NEWLINE LINES)) + (T (* Otherwise, write over existing + lines) + (\TEDIT.COPY.LINEDESCRIPTOR NEWLINE LINES) + (* Move it into place in the chain) + (replace (THISLINE DESC) of THISLINE with LINES) + (* And pretend that LINES is the line + we just formatted--since it + effectively IS.) + (SETQ NEWLINE LINES) (* And copy it back over the original) + )) + (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of NEWLINE))) + (* Find the end of the new line + (this MUST be before this COND, + because LINES is set to NIL inside it.)) + (COND + ((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) + WHEIGHT) (* Do nothing until we see a change to + a line which is on-screen.) + (replace (LINEDESCRIPTOR YBOT) of NEWLINE with (fetch (LINEDESCRIPTOR YBOT) + of LINES)) + (* Except to make sure that the fresh + line also thinks it is off screen) + ) + ((AND (IGEQ (SETQ YBOT (\TEDIT.NEXT.LINE.BOTTOM YBOT NEWLINE (fetch (LINEDESCRIPTOR + PREVLINE) + of NEWLINE))) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (NEQ LINES NEWLINE)) (* If there's space left on the screen + for this line, (and it is a new line)) + (\TEDIT.ADJUST.LINES TEXTOBJ (fetch (LINEDESCRIPTOR NEXTLINE) of NEWLINE) + WINDOW + (fetch (LINEDESCRIPTOR YBOT) of (fetch (LINEDESCRIPTOR PREVLINE) + of NEWLINE)) + (IMINUS (fetch (LINEDESCRIPTOR LHEIGHT) of NEWLINE))) + (* Move the existing lines down to fit + it in) + (replace (LINEDESCRIPTOR YBOT) of NEWLINE with YBOT) + (* Display it where we are now) + (replace (LINEDESCRIPTOR YBASE) of NEWLINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR + DESCENT) + of NEWLINE))) + (* Base line for the characters to sit + on) + (\DISPLAYLINE TEXTOBJ NEWLINE WINDOW) (* Display it) + ) + ((IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + + (* If there's space left on the screen for this line, and we're overlaying an + existing line.) + + [\TEDIT.ADJUST.LINES TEXTOBJ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES) + WINDOW + (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES) + (IMINUS OLHEIGHT)) + (COND + ((fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINES)) + (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINES) + YBOT)) + (T (IDIFFERENCE OLHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES] + (* Adjust for the possible difference + in heights between old and new line) + (replace (LINEDESCRIPTOR YBOT) of LINES with YBOT) + (* Display it where we are now) + (replace (LINEDESCRIPTOR YBASE) of LINES with (IPLUS YBOT (fetch (LINEDESCRIPTOR + DESCENT) + of LINES))) + (* Base line for the characters to sit + on) + (\DISPLAYLINE TEXTOBJ LINES WINDOW) (* Display it) + ) + ((AND NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINES) + NEXTCARETCH#)) (* This line is off-screen, but is + needed for finding the caret's new + location) + (replace (LINEDESCRIPTOR YBOT) of LINES with YBOT) + (replace (LINEDESCRIPTOR YBASE) of LINES with YBOT)) + (T + + (* We have walked off the bottom of the screen. + Chop off the lines from here.) + + (SETQ LINES NEWLINE) + (AND (SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) + (APPLY* OFLOWFN WINDOW TEXTOBJ) + (RETFROM (FUNCTION \TEDIT.FIXCHANGEDLINE))) + [replace (LINEDESCRIPTOR YBOT) of LINES with (replace (LINEDESCRIPTOR YBASE) + of LINES + with (SUB1 (fetch (TEXTOBJ + WBOTTOM) + of TEXTOBJ] + (* Mark this line as being off-screen) + (COND + ((IGREATERP (fetch (LINEDESCRIPTOR CHARLIM) of LINES) + NEXTCARETCH#) + (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL))) + + (* Chop off any lines below it, to preserve changes that may propogate off the + bottom of the window) + + (\TEDIT.CLEAR.SCREEN.BELOW.LINE TEXTOBJ WINDOW (fetch (LINEDESCRIPTOR PREVLINE) + of LINES)) + (* And clear the space below the + bottom line on the screen) + (RETURN))) + (SETQ LINES NEWLINE) + + (* So that if we inserted a line, we start by moving up to the pre-existing line) + + )) + (RETURN LINES]) + +(\TEDIT.FIXCHANGEDPART + [LAMBDA (TEXTOBJ STARTINGLINE WINDOW INCREMENTAL? NEXTCARETCH#) + (* ; "Edited 30-May-91 16:07 by jds") + + (* ;; "Reformat lines as needed after a change. Return the last line changed, or NIL if there's no need for a \FILLWINDOW.") + + (PROG* ((THISW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) + [LINES (fetch (LINEDESCRIPTOR NEXTLINE) of (WINDOWPROP THISW 'LINES] + (REGION (DSPCLIPPINGREGION NIL THISW)) + (YBOT (fetch (REGION PTOP) of REGION)) + (FORMATDONE NIL) + LIMITCHANGED WASDIRTY CHARLIM OCHLIM OLHEIGHT (PREVLINE NIL) + (TPREVLINE NIL) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) + (WHEIGHT (fetch (REGION PTOP) of REGION)) + (WBOTTOM (fetch (REGION BOTTOM) of REGION)) + (CLEARBOTTOM T) + [NEXTCARETCH# (OR NEXTCARETCH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) + of TEXTOBJ] + DY OFLOWFN NEWLINE TYBOT) + (AND LINES (SETQ TPREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of LINES))) + [while LINES do (* ; + "Find the first line descriptor of a DIRTY line.") + (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of LINES)) + (COND + ((ILESSP 0 (SETQ DY (IDIFFERENCE (\TEDIT.NEXT.LINE.BOTTOM + YBOT LINES (fetch (LINEDESCRIPTOR + PREVLINE) + of LINES)) + YBOT))) + (* ; + "There used to be another line above this one. Move this up to cover it.") + (\TEDIT.CLOSEUPLINES TEXTOBJ (fetch (LINEDESCRIPTOR PREVLINE) + of LINES) + LINES NIL (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) + (* ; + "This HAS to fill the window, or we may wind up with missing lines at the bottom of the screen") + )) + (COND + ((AND (ILESSP YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINES) + NEXTCARETCH#)) (* ; + "We've run off the bottom of the screen.") + (replace (LINEDESCRIPTOR NEXTLINE) of TPREVLINE with NIL) + (* ; + "There may be unfixed changes there, so chop off any further lines.") + (SETQ LINES NIL)) + ((fetch (LINEDESCRIPTOR DIRTY) of LINES) + (RETURN)) + ([AND [NOT (IEQP (fetch (LINEDESCRIPTOR CHAR1) of LINES) + (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of TPREVLINE] + (NOT (ZEROP (fetch (LINEDESCRIPTOR CHARLIM) of TPREVLINE] + + (* ;; "This line doesn't match up with the previous line; we should start updating here. But don't worry about the dummy first line") + + (RETURN)) + (T (SETQ TPREVLINE LINES) + (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES] + [COND + ((AND LINES (ILESSP (fetch (LINEDESCRIPTOR CHARTOP) of LINES) + 0)) (* ; + "If we hit on the dummy first line, skip over it -- never try to reformat it.") + (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES] + [COND + ((NOT LINES) (* ; + "No changed lines found -- clear below last line on screen") + (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) + (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)) + (IDIFFERENCE YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + 'TEXTURE + 'REPLACE WHITESHADE) + (COND + [[OR (ZEROP TEXTLEN) + (NOT (fetch (LINEDESCRIPTOR NEXTLINE) of (WINDOWPROP (OR WINDOW ( + \TEDIT.PRIMARYW + TEXTOBJ)) + 'LINES] + + (* ;; "If there is no text, or no image, force a call to \FILLWINDOW, to provide a dummy empty line descriptor for the guy to type at.") + + (RETURN (WINDOWPROP WINDOW 'LINES] + (T (* ; + "We found no changes; return a NIL last-line-changed") + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) + (* ; + "Reset the 'needs-update' flag so we don't come back looking for work again.") + (RETURN NIL] + [SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of (SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) + of LINES] + (* ; + "Y bottom of the first line to reformat.") + (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE))) + (* ; "char to start formatting with") + (while (AND LINES (OR (IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) + (ILEQ CHARLIM NEXTCARETCH#))) + do + (* ;; "Run thru lines, cleaning them up. Start with the first dirty line, and only stop if we're both past the place the caret will be AND off the bottom of the screen.") + + [COND + ([ILESSP 0 (SETQ DY (IDIFFERENCE (\TEDIT.NEXT.LINE.BOTTOM YBOT LINES + (fetch (LINEDESCRIPTOR PREVLINE) + of LINES)) + (fetch (LINEDESCRIPTOR YBOT) of LINES] + (* ; + "There used to be another line above this one. Move this up to cover it.") + (\TEDIT.CLOSEUPLINES TEXTOBJ (fetch (LINEDESCRIPTOR PREVLINE) of LINES) + LINES NIL (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ] + [COND + ((IGREATERP CHARLIM (IMIN (IMAX 1 (fetch (LINEDESCRIPTOR CHARLIM) of LINES)) + TEXTLEN)) (* ; + "This line has been rendered superfluous -- Delete it.") + (TEDIT.DELETELINE LINES TEXTOBJ WINDOW)) + (T + (* ;; "Try updating the line. If the updater returns NIL, it ran off the bottom of the screen, and we should give up.") + + (COND + ((SETQ LINES (\TEDIT.FIXCHANGEDLINE TEXTOBJ YBOT LINES WINDOW TEXTLEN + THISLINE WHEIGHT CHARLIM NEXTCARETCH# + (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE))) + (* ; + "We're still on screen; update the character and Y-position counters for the next loop") + (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINES))) + (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of LINES))) + (T (* ; + "Ran off the bottom of the window; the bottom has already been cleared, so avoid doing it here.") + (SETQ CLEARBOTTOM NIL) + (RETURN] + (COND + ((IGEQ CHARLIM TEXTLEN) (* ; + "If we've run out of text, chop off any remaining line descriptors, since we won't be needing them.") + (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL) + (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) + (* ; + "And there's no more screen updating to do, either.") + ) + ((AND INCREMENTAL? (fetch (LINEDESCRIPTOR NEXTLINE) of LINES) + (IGREATERP CHARLIM NEXTCARETCH#) + (\SYSBUFP)) (* ; + "This is an incremental update, and he hit a key. Stop updating and listen to him") + (* ; + "HOWEVER, NEVER STOP ON THE LAST LINE -- IF THERE ARE NEW LINES TO ADD, ADD ONE.") + (SETQ PREVLINE NIL) + (SETQ CLEARBOTTOM NIL) + (RETURN))) + (SETQ PREVLINE LINES) (* ; + "Remember the last line we really formatted.") + (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) + (* ; "Move to the next line")) + (COND + (CLEARBOTTOM (* ; + "There had been lines yet to be formatted, so there may be garbage below the end of the screen.") + (\TEDIT.CLEAR.SCREEN.BELOW.LINE TEXTOBJ WINDOW PREVLINE))) + (RETURN PREVLINE]) + +(\TEDIT.INSERTLINE + [LAMBDA (NEWLINE BEFORELINE) (* ; "Edited 30-May-91 16:05 by jds") + (* Inserts NEWLINE in front of + BEFORELINE in the line-descriptor + chain) + (PROG ((PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of BEFORELINE))) + (replace (LINEDESCRIPTOR PREVLINE) of NEWLINE with PREVLINE) + (replace (LINEDESCRIPTOR NEXTLINE) of NEWLINE with BEFORELINE) + (replace (LINEDESCRIPTOR PREVLINE) of BEFORELINE with NEWLINE) + (AND PREVLINE (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with NEWLINE]) + +(\TEDIT.LINE.LIST + [LAMBDA (TEXTOBJ WINDOW) (* ; "Edited 12-Jun-90 19:23 by mitani") + (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES inside (fetch (TEXTOBJ LINES) + of TEXTOBJ) + when (EQ WW WINDOW) do (RETURN LINES]) + +(\TEDIT.MARK.LINES.DIRTY + [LAMBDA (TEXTOBJ CH1 CHLIM) (* ; "Edited 30-May-91 16:05 by jds") + (* Mark dirty the lines that intersect + the range ch1 t chlim inclusive) + (bind (CH# _ (IMIN CH1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (CHLIM# _ (COND + ((IEQP CHLIM -1) + (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (T CHLIM))) for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + do (bind (LL _ (WINDOWPROP WW 'LINES)) while LL + do (* Mark changed lines as DIRTY.) + (COND + ((AND (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LL) + CHLIM#) + (IGEQ (fetch (LINEDESCRIPTOR CHARTOP) of LL) + CH#)) + + (* The dirty range overlaps with this line -- + it is between the 1st char on the line, and the last char examined when deciding + where to break the line.) + + (replace (LINEDESCRIPTOR DIRTY) of LL with T))) + (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) + finally (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T]) + +(\TEDIT.NEXT.LINE.BOTTOM + [LAMBDA (CURYBOT LINE PREVLINE) (* ; "Edited 24-Sep-87 10:00 by jds") + +(* ;;; "Given a current Y-bottom for PREVLINE, and a LINE to follow it, compute the new line's YBOT value. Takes into account Base-to-base leading, as well as paragraph leadings.") + + (PROG (NEWYBOT PARALEADING PARALOOKS BASETOBASE) + [COND + [[SETQ BASETOBASE (fetch (FMTSPEC FMTBASETOBASE) of (SETQ PARALOOKS (fetch ( + LINEDESCRIPTOR + LFMTSPEC) + of LINE] + + (* ;; "If base-to-base spacing is specified, we have to do this in two parts: First, compute the proper spacing between the lines; then add in any paragraph leading.") + + [SETQ NEWYBOT (IDIFFERENCE (IPLUS CURYBOT (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE)) + (IPLUS BASETOBASE (fetch (LINEDESCRIPTOR DESCENT) of LINE] + (COND + ((fetch (LINEDESCRIPTOR 1STLN) of LINE) (* ; + "This is the first line of a new paragraph. Add in any paragraph leading.") + [SETQ PARALEADING (IPLUS (fetch (FMTSPEC LEADBEFORE) of PARALOOKS) + (fetch (FMTSPEC LEADAFTER) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of PREVLINE] + + (* ;; "The inter-paragraph space is the sum of the previous para's post-leading and this para's pre-leading.") + + (SETQ NEWYBOT (IDIFFERENCE NEWYBOT PARALEADING] + (T + (* ;; "If there's no base-to-base spacing, then paragraph leading was taken into account in the line formatter, and is already part of LHEIGHT.") + + (SETQ NEWYBOT (IDIFFERENCE CURYBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (RETURN NEWYBOT]) +) + + + +(* RMK%: These duplicate what appears on TEDITHCPY, GLOBALVARS moved to TEDIT-DCL) + + + + +(* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133" +"41,131" "41,127" "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143" "Hira,145" +"Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" "Kata,51" "Kata,103" "Kata,143" +"Kata,145" "Kata,147" "Kata,156"))) (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" +"41,126"))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))) + +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2684 72126 (\FORMATLINE 2694 . 52514) (\TEDIT.NSCHAR.RUN 52516 . 59072) ( +\TEDIT.PURGE.SPACES 59074 . 59468) (\DOFORMATTING 59470 . 72124)) (72127 93156 (\DISPLAYLINE 72137 . +89063) (\TEDIT.LINECACHE 89065 . 89793) (\TEDIT.CREATE.LINECACHE 89795 . 90631) (\TEDIT.BLTCHAR 90633 + . 93154)) (93771 197729 (TEDIT.CR.UPDATESCREEN 93781 . 95000) (TEDIT.DELETELINE 95002 . 95924) ( +TEDIT.INSERT.DISPLAYTEXT 95926 . 111962) (TEDIT.INSERT.UPDATESCREEN 111964 . 117998) ( +TEDIT.UPDATE.SCREEN 118000 . 119100) (\BACKFORMAT 119102 . 122942) (\FILLWINDOW 122944 . 137360) ( +\FIXDLINES 137362 . 143574) (\FIXILINES 143576 . 148697) (\SHOWTEXT 148699 . 152083) ( +\TEDIT.ADJUST.LINES 152085 . 159663) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 159665 . 160403) ( +\TEDIT.CLOSEUPLINES 160405 . 167872) (\TEDIT.COPY.LINEDESCRIPTOR 167874 . 170984) ( +\TEDIT.FIXCHANGEDLINE 170986 . 181369) (\TEDIT.FIXCHANGEDPART 181371 . 192679) (\TEDIT.INSERTLINE +192681 . 193509) (\TEDIT.LINE.LIST 193511 . 193909) (\TEDIT.MARK.LINES.DIRTY 193911 . 195428) ( +\TEDIT.NEXT.LINE.BOTTOM 195430 . 197727))))) +STOP diff --git a/library/TEDITSCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM similarity index 96% rename from library/TEDITSCREEN.LCOM rename to library/tedit/TEDIT-SCREEN.LCOM index 9f8ccc372ba458b4a3770819e2ec8cc120eab060..3174b747771a9e06df357fba806e5df790c8dc2a 100644 GIT binary patch delta 545 zcmey@&(z+}G$BIRMAxe{N7u-}$VkD^%*xc<%EWYHwq$*2acWVqU3OwYPGX*2PJVJ? zj$LkQN=|B}v7V`2d45rLW?s53M8qy9GpQ)CsM4+^H6^peF2vQvGekGoImp%3PtV#= zQ-Mp#5ZMxAD?>{w19K&Xq@vX1{M>@foYWMB)QWae>HUqt9YGrDuq`+0}66{@TgU65c zq%?c1ps+4rHcRn delta 682 zcma)4%SyvQ6veuW;KohG%_X2DLSiRPY7-^2B&m&!O=wcB;3nExl%`2Z6)Ylwg1D^W z)}?>Y|M3G{_zB{qEvWdw&0&Un@44rkncH#ZZJfDltq9z{A96xY5C9bwsi263`|fJe z9N>7McKv?fhpH8w`GMNQ?Enw+yrlMq-0Y$TozvKlhpK1jrsrx6!>IE+2(dt;uf&3^ z2n8Cb(-@ycy?!UaZNQiPc(AU(iCeXgJfr17Cj`3Ev@A$IkMlfFL)$+mBR|mQ5zSIe z#k35vzD$ICYnqxOyRUS&cD?&AXUXt4Yak#|5_6zv)pC8$a5>Kgrc!r5Tu>}1PQy4f z?WW7=MA0`v!nTr^{uH$N@2qo^t;}=susq6UXZdUPfeXwu5ErKJ@=zL;)>xJzI!Q{T zXxU|*v^ng&{y3^F0z*w+Mo*c^_~vyX(KU;N>NGv4VLNl089ivWbKEfZsva=(Ar3Dv zY(NXg(Ise6+>c`ayc2~qAi0=NK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-SELECTION.;1 144823 + + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-SELECTION.;2) + + +(PRETTYCOMPRINT TEDIT-SELECTIONCOMS) + +(RPAQQ TEDIT-SELECTIONCOMS + ((FILES TEDIT-DCL) + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) + (FILES (LOADCOMP) + TEDIT-DCL)) + (FNS TEDIT.SEL.AS.STRING TEDIT.SELECTED.PIECES \TEDIT.FIND.FIRST.LINE \TEDIT.FIND.LAST.LINE + \TEDIT.FIND.OVERLAPPING.LINE \TEDIT.FIND.PROTECTED.END \TEDIT.FIND.PROTECTED.START + \TEDIT.WORD.BOUND) + (INITVARS (TEDIT.EXTEND.PENDING.DELETE T)) + (FNS \CREATE.TEDIT.SELECTION \CREATE.TEDIT.SHIFTEDSELECTION \CREATE.TEDIT.MOVESELECTION + \CREATE.TEDIT.DELETESELECTION) + (* ; + "Added by yabu.fx, for LOADUP without DWIM.") + (VARS (TEDIT.SELECTION (\CREATE.TEDIT.SELECTION)) + (* ; + "Original was %"(create SELECTION)%".") + (TEDIT.SCRATCHSELECTION (\CREATE.TEDIT.SELECTION)) + (* ; + "Original was %"(create SELECTION)%".") + (TEDIT.SHIFTEDSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) + (* ; + "Original was %"(create SELECTION HASCARET _ NIL)%".") + (TEDIT.COPYLOOKSSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) + (* ; + "Original was %"(create SELECTION HASCARET _ NIL)%".") + (TEDIT.MOVESELECTION (\CREATE.TEDIT.MOVESELECTION)) + (* ; + "Original was %"(CREATE SELECTION HASCARET _ NIL HOWHEIGHT _ 32767)%".") + (TEDIT.DELETESELECTION (\CREATE.TEDIT.DELETESELECTION)) + (* ; + "Original was %"(CREATE SELECTION HOW _ BLACKSHADE HASCARET _ NIL HOWHEIGHT _ 32767)%".") + (* ; + "Changed by yabu.fx, for LOADUP without DWIM.") + (TEDIT.SELPENDING NIL)) + (GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION + TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING + TEDIT.EXTEND.PENDING.DELETE) + (COMS (* ; "Selection manipulating code") + (FNS TEDIT.EXTEND.SEL TEDIT.SELECT TEDIT.SCAN.LINE TEDIT.SELECT.LINE.SCANNER + \TEDIT.SELECT.CHARACTER) + (FNS \FIXSEL \TEDIT.FIXDELSEL \TEDIT.FIXINSSEL \TEDIT.FIXSELS) + (FNS TEDIT.RESET.EXTEND.PENDING.DELETE \TEDIT.SET.SEL.LOOKS) + (FNS \SHOWSEL \SHOWSEL.HILIGHT \TEDIT.UPDATE.SHOWSEL \TEDIT.SHOWSELS + \TEDIT.REFRESH.SHOWSEL) + (FNS \COPYSEL \TEDIT.SEL.CHANGED?)) + (COMS + (* ;; "User entries to the selection code") + + (FNS TEDIT.GETPOINT TEDIT.GETSEL TEDIT.MAKESEL TEDIT.SCANSEL TEDIT.SET.SEL.LOOKS + TEDIT.SETSEL TEDIT.SHOWSEL)))) + +(FILESLOAD TEDIT-DCL) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ \SCRATCHLEN 64) + + +(CONSTANTS (\SCRATCHLEN 64)) +) + + +(FILESLOAD (LOADCOMP) + TEDIT-DCL) +) +(DEFINEQ + +(TEDIT.SEL.AS.STRING + [LAMBDA (STREAM SEL) (* ; "Edited 22-Apr-93 16:44 by jds") + + (* ;; + "Given a text stream, go to the TEXTOBJ, get the current selection, and return it as a string.") + + (SETQ STREAM (TEXTSTREAM STREAM)) + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + LEN TSEL RESULT OFFST BASE) + (SETQ TSEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) + (SETQ LEN (fetch (SELECTION DCH) of TSEL)) + (COND + ((ZEROP LEN) (* ; + "There is no selection, or it's zero-width. Return ''") + (RETURN "")) + (T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE))) + (* ; "The resulting string") + (\SETUPGETCH (fetch (SELECTION CH#) of TSEL) + TEXTOBJ) (* ; + "Starting point for the string is start of selection.") + (for I from 1 to LEN do (* ; + "Get chars from the stream, and put them in the string.") + (RPLCHARCODE RESULT I (\GETCH TEXTOBJ))) + (RETURN RESULT]) + +(TEDIT.SELECTED.PIECES + [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 20-Apr-93 17:06 by jds") + + (* ;; "Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result as the copy of the piece") + + (PROG ((CH1 (fetch (SELECTION CH#) of SEL)) + (CHLIM (fetch (SELECTION CHLIM) of SEL)) + (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + (INSERTPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) + LEN INSPC INSPC# PC NPC (PCCH 1) + NPCCH OPLEN EVENT REPLACING INSERTCH# PCLST OBJ COPYFN UNDOCHAIN NODE) + (* ; "Find the insertion point") + (AND (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (RETURN NIL)) + (SETQ PCLST (TCONC NIL)) + (first (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) while PC for I from 1 + do + (* ;; "Gather a list of pieces to be copied") + + (SETQ NODE PC) + [COND + ((IGEQ PCCH CHLIM) (* ; + "We've passed beyond the copy region. Bail out.") + (RETURN)) + ((ILEQ (SETQ NPCCH (IPLUS PCCH (fetch (PIECE PLEN) of PC))) + CH1) (* ; + "The current piece isn't inside the region to be copied.") + ) + (T (* ; + "This piece overlaps the copy-source region of the document") + (* ; "Add it to the copy list.") + (COND + ((ILESSP PCCH CH1) (* ; + "The piece overlaps the bottom of the copy region: Chop off its front part.") + (COND + ((EQ PC INSERTPC) + + (* ;; + "We're splitting the insertion piece. Never let the underlying string be touched again.") + + (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with NIL))) + (SETQ PC (\SPLITPIECE PC (- CH1 PCCH) + TEXTOBJ I)) + (SETQ PCCH CH1))) + (COND + ((ILESSP CHLIM NPCCH) (* ; + "This piece overlaps the end of the copy region. Shorten it at the end.") + (\SPLITPIECE PC (- CHLIM PCCH) + TEXTOBJ I))) + (TCONC PCLST (SETQ NPC (COND + (PIECEMAPFN (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 + FNARG2)) + (T PC] + (add PCCH (fetch (PIECE PLEN) of PC)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + (RETURN (CDAR PCLST]) + +(\TEDIT.FIND.FIRST.LINE + [LAMBDA (TEXTOBJ WHEIGHT CH# WINDOW) (* ; "Edited 30-May-91 23:02 by jds") + (* Find the first line to be + displayed, given that it must include + character CH#) + (PROG ((LINES (OR (AND WINDOW (WINDOWPROP WINDOW 'LINES)) + (fetch (TEXTOBJ LINES) of TEXTOBJ))) + (WWIDTH (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) + (TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) + LINE CHNO CH) + [COND + ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* If there's no text, force an empty + line) + (SETQ CHNO 1) + (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL) + (RETURN LINES)) + ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (* If there's no text on the screen, + just return nil) + (RETURN NIL)) + [(fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) (* For a para-formatted object, back + up to the prior para bound.) + (SETQ CHNO (CAR (\TEDIT.PARABOUNDS TEXTOBJ CH#] + (T (* Otherwise, move back thru the text + until we find a for-sure line break) + (\SETUPGETCH CH# TEXTOBJ) + (SETQ CH 0) + (for old CHNO from (SUB1 CH#) to 2 by -1 repeatwhile (NOT (EQ CH (CHARCODE CR))) + do (SETQ CH (\BACKBIN TEXTSTREAM))) + (SETQ CHNO (COND + ((ILEQ CHNO 1) (* If we moved back to start-of-file, + move forward from there;) + 1) + ((IEQP CHNO CH#) (* If we landed on a CR first shot, + let's try moving forward from there.) + CH#) + (T (* Else, skip the CR we passed over) + (ADD1 CHNO] + (SETQ CH# (IMIN CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + [repeatwhile (ILEQ CHNO CH#) do + + (* Starting from the known line break, move forward until we find the line which + has the right CH# in it) + + (SETQ LINE (\FORMATLINE TEXTOBJ NIL CHNO)) + (replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT) + (replace (LINEDESCRIPTOR NEXTLINE) of LINES with LINE) + (replace (LINEDESCRIPTOR PREVLINE) of LINE with LINES) + (SETQ LINES LINE) + (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) + of LINE] + (RETURN LINE]) + +(\TEDIT.FIND.LAST.LINE + [LAMBDA (TEXTOBJ LINES) (* ; "Edited 30-May-91 23:02 by jds") + + (* Among the line descriptors in LINES, find the last one on the screen; + then return it.) + + (OR LINES (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ))) + (* Make sure a list of line + descriptors is specified.) + (COND + ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* If there's no window, return NIL.) + (bind (OLINE _ LINES) + (LINE _ LINES) + (CURY _ (fetch (LINEDESCRIPTOR YBOT) of LINES)) + while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + do (* Find the lowest line above screen + bottom, and put it in OLINE.) + (SETQ OLINE LINE) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) finally (RETURN OLINE))) + (T NIL]) + +(\TEDIT.FIND.OVERLAPPING.LINE + [LAMBDA (LINES Y) (* ; "Edited 30-May-91 22:57 by jds") + (while LINES do (COND + ((ILEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) + Y) + (RETURN LINES)) + (T (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES]) + +(\TEDIT.FIND.PROTECTED.END + [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 18-Apr-93 23:49 by jds") + + (* ;; "Starting from a CH# in a selectable region, find the CH# of the last selectable character following that. This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow unprotected areas.") + + (* ;; "If LIMITCH# is given, the search will stop there.") + + (bind (OURLIMIT _ (IMIN (OR LIMITCH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (PCTB _ (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + START-OF-PIECE PC first (SETQ PC (\CHTOPC CH# (fetch (TEXTOBJ PCTB) of TEXTOBJ) + T)) while PC + do + (* ;; "Move forward thru the pieces of the document, looking for one that contains protected text. If that comes before the end of the region we're interested in, tell the caller about the earlier end to selectable text.") + + [COND + ((IGREATERP START-OF-PIECE OURLIMIT) (* ; + "We've passed the limit, so it's time to give up. Just return the LIMITCH#") + (RETURN OURLIMIT)) + ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PC)) + + (* ;; "We've found the beginning of a protected region -- i.e., the end of the selectable region. Tell the caller about it.") + + (RETURN (SUB1 START-OF-PIECE] + (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (RETURN (fetch (TEXTOBJ TEXTLEN) + of TEXTOBJ]) + +(\TEDIT.FIND.PROTECTED.START + [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 30-Apr-93 01:39 by jds") + + (* ;; "Starting from a CH# in a selectable region, find the CH# of the earliest contiguously-selectable character preceding that. This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow unprotected areas.") + + (* ;; "Will stop looking when it passes LIMITCH#, or at the beginning of the document.") + + (bind (OURLIMIT _ (OR LIMITCH# 1)) + (PCTB _ (fetch (TEXTOBJ PCTB) of TEXTOBJ)) + PC START-OF-PIECE first (SETQ PC (\CHTOPC CH# PCTB T)) + (AND (LITATOM PC) + (SETQ PC (\CHTOPC CH# (SUB1 START-OF-PIECE) + T))) while PC + do [COND + ((ILEQ START-OF-PIECE OURLIMIT) (* ; + "If he specified a LIMITCH#, and we have passed it, stop bothering and return the LIMITCH#") + (RETURN OURLIMIT)) + ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PC)) + + (* ;; "We hit a PROTECTED piece of text. This is the place to stop. Return the CH# just AFTER the protected text we found.") + + (RETURN (IPLUS START-OF-PIECE (fetch (PIECE PLEN) of PC] + (SETQ PC (fetch (PIECE PREVPIECE) of PC)) + (SETQ START-OF-PIECE (IDIFFERENCE START-OF-PIECE (fetch (PIECE PLEN) of PC]) + +(\TEDIT.WORD.BOUND + [LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 30-May-91 23:02 by jds") + (PROG ((READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) + TEDIT.WORDBOUND.READTABLE))) + SYN1 SYN2) + (COND + ((NOT (AND (FIXP PREVCH) + (FIXP CH))) + (RETURN T))) + (SETQ SYN1 (\SYNCODE READSA PREVCH)) + (SETQ SYN2 (\SYNCODE READSA CH)) + (RETURN (NEQ SYN1 SYN2]) +) + +(RPAQ? TEDIT.EXTEND.PENDING.DELETE T) +(DEFINEQ + +(\CREATE.TEDIT.SELECTION + [LAMBDA NIL + (create SELECTION]) + +(\CREATE.TEDIT.SHIFTEDSELECTION + [LAMBDA NIL + (create SELECTION + HASCARET _ NIL]) + +(\CREATE.TEDIT.MOVESELECTION + [LAMBDA NIL + (CREATE SELECTION + HASCARET _ NIL + HOWHEIGHT _ 32767]) + +(\CREATE.TEDIT.DELETESELECTION + [LAMBDA NIL + (CREATE SELECTION + HOW _ BLACKSHADE + HASCARET _ NIL + HOWHEIGHT _ 32767]) +) + + + +(* ; "Added by yabu.fx, for LOADUP without DWIM.") + + +(RPAQ TEDIT.SELECTION (\CREATE.TEDIT.SELECTION)) + +(RPAQ TEDIT.SCRATCHSELECTION (\CREATE.TEDIT.SELECTION)) + +(RPAQ TEDIT.SHIFTEDSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) + +(RPAQ TEDIT.COPYLOOKSSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) + +(RPAQ TEDIT.MOVESELECTION (\CREATE.TEDIT.MOVESELECTION)) + +(RPAQ TEDIT.DELETESELECTION (\CREATE.TEDIT.DELETESELECTION)) + +(RPAQQ TEDIT.SELPENDING NIL) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION + TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING TEDIT.EXTEND.PENDING.DELETE) +) + + + +(* ; "Selection manipulating code") + +(DEFINEQ + +(TEDIT.EXTEND.SEL + [LAMBDA (X Y OSEL TEXTOBJ SELOPERATION SELWINDOW NEWSEL) (* ; "Edited 19-Apr-93 13:49 by jds") + (* ; + "Gather a new selected character, and extend OSEL to include it. Return the extended selection.") + (PROG ((NSEL (OR NEWSEL (TEDIT.SELECT X Y TEXTOBJ (SELECTQ (fetch (SELECTION SELKIND) + of OSEL) + ((LINE PARA) + 'LINE) + ((WORD CHAR) + 'TEXT) + 'TEXT) + (OR (EQ (fetch (SELECTION SELKIND) of OSEL) + 'WORD) + (EQ (fetch (SELECTION SELKIND) of OSEL) + 'PARA)) + SELOPERATION SELWINDOW T))) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (NPOINT NIL) + (SETOSELFLG NIL) + (FIXUPNEEDED NIL)) + (COND + ((ZEROP TEXTLEN) (* ; + "No sense in extending a selection if there's no text!") + (RETURN NSEL))) + (COND + ((AND NSEL (fetch (SELECTION SET) of NSEL)) (* ; + "If there's no second selection, don't bother trying") + (\TEDIT.SET.SEL.LOOKS NSEL SELOPERATION) + + (* ;; "Make the new selection be the same kind as the original, as to what it's for -- regular, copy-source, etc.") + + [SETQ NPOINT (COND + ((IGEQ (fetch (SELECTION CHLIM) of NSEL) + (fetch (SELECTION CHLIM) of OSEL)) + (* ; + "The new selection ends to the right of the old one. Move this edge.") + 'RIGHT) + ((ILEQ (fetch (SELECTION CH#) of NSEL) + (fetch (SELECTION CH#) of OSEL)) + (* ; + "If the new selection starts to left of old one, caret goes at the LEFT") + 'LEFT) + ([IGREATERP (IABS (IDIFFERENCE (fetch (SELECTION CHLIM) of NSEL) + (fetch (SELECTION CHLIM) of OSEL))) + (IABS (IDIFFERENCE (fetch (SELECTION CH#) of NSEL) + (fetch (SELECTION CH#) of OSEL] + (SETQ SETOSELFLG T) + 'LEFT) + (T (SETQ SETOSELFLG T) + 'RIGHT] + [SELECTQ NPOINT + (LEFT (* ; + "Caret's to the left. Keep the same right end") + [replace (SELECTION CHLIM) of NSEL + with (IMAX (fetch (SELECTION CHLIM) of NSEL) + (SELECTQ (fetch (SELECTION POINT) of OSEL) + (LEFT (IPLUS (fetch (SELECTION CH#) of OSEL) + (fetch (SELECTION DCH) of OSEL))) + (RIGHT (fetch (SELECTION CHLIM) of OSEL)) + (SHOULDNT] + (replace (SELECTION XLIM) of NSEL with (fetch (SELECTION XLIM) of OSEL)) + (replace (SELECTION YLIM) of NSEL with (fetch (SELECTION YLIM) of OSEL)) + (replace (SELECTION LN) of NSEL with (COPY (fetch (SELECTION LN) of OSEL))) + (COND + ((NEQ SELOPERATION 'COPY) (* ; + "The old sel is in a protected area. Only let him extend to the start of it.") + [replace (SELECTION CH#) of NSEL + with (IMAX (fetch (SELECTION CH#) of NSEL) + (\TEDIT.FIND.PROTECTED.START TEXTOBJ + (SUB1 (fetch (SELECTION CHLIM) of OSEL)) + (fetch (SELECTION CH#) of NSEL] + (SETQ FIXUPNEEDED T) (* ; + "Note that the L1/LN may be invalid as a result of this contraction. Force a \FIXSEL later.") + ))) + (RIGHT (* ; + "Point's to the right; keep the same left end.") + [replace (SELECTION CH#) of NSEL + with (IMIN (fetch (SELECTION CH#) of NSEL) + (SELECTQ (fetch (SELECTION POINT) of OSEL) + (LEFT (fetch (SELECTION CH#) of OSEL)) + (RIGHT (IDIFFERENCE (fetch (SELECTION CHLIM) of OSEL) + (fetch (SELECTION DCH) of OSEL))) + (SHOULDNT] + (replace (SELECTION X0) of NSEL with (fetch (SELECTION X0) of OSEL)) + (replace (SELECTION Y0) of NSEL with (fetch (SELECTION Y0) of OSEL)) + (replace (SELECTION L1) of NSEL with (COPY (fetch (SELECTION L1) + of OSEL))) + (COND + ((NEQ SELOPERATION 'COPY) (* ; + "The old sel is in a protected area. Only let him extend to the start of it.") + [replace (SELECTION CHLIM) of NSEL + with (IMIN (fetch (SELECTION CHLIM) of NSEL) + (ADD1 (\TEDIT.FIND.PROTECTED.END + TEXTOBJ + (fetch (SELECTION CH#) of OSEL) + (ADD1 (\TEDIT.FIND.PROTECTED.END + TEXTOBJ + (fetch (SELECTION CH#) of OSEL) + (SUB1 (fetch (SELECTION CHLIM) of NSEL] + (replace (SELECTION CH#) of NSEL with (IMIN (fetch (SELECTION CHLIM) + of NSEL) + (fetch (SELECTION CH#) + of NSEL))) + (SETQ FIXUPNEEDED T) (* ; + "Note that the L1/LN may be invalid as a result of this contraction. Force a \FIXSEL later.") + ))) + (PROGN (replace (SELECTION CHLIM) of NSEL with (fetch (SELECTION CHLIM) + of OSEL)) + (replace (SELECTION XLIM) of NSEL with (fetch (SELECTION XLIM) of OSEL)) + (replace (SELECTION YLIM) of NSEL with (fetch (SELECTION YLIM) of OSEL)) + (replace (SELECTION LN) of NSEL with (COPY (fetch (SELECTION LN) + of OSEL))) + (replace (SELECTION CH#) of NSEL with (fetch (SELECTION CH#) of OSEL)) + (replace (SELECTION X0) of NSEL with (fetch (SELECTION X0) of OSEL)) + (replace (SELECTION Y0) of NSEL with (fetch (SELECTION Y0) of OSEL)) + (replace L1 of NSEL with (COPY (fetch L1 of OSEL))) + (SETQ NPOINT (fetch POINT of OSEL] + (replace DCH of NSEL with (IDIFFERENCE (IMIN (ADD1 TEXTLEN) + (fetch CHLIM of NSEL)) + (fetch CH# of NSEL))) + (* ; + "The selection's length cannot exceed that of the whole text.") + (replace CHLIM of NSEL with (IPLUS (fetch CH# of NSEL) + (fetch DCH of NSEL))) + (* ; + "This assures that the CHLIM corresponds to the DCH.") + (replace POINT of NSEL with NPOINT) + (replace (SELECTION DX) of NSEL with (IDIFFERENCE (fetch XLIM of NSEL) + (fetch X0 of NSEL))) + (COND + ((NEQ (fetch SELOBJ of OSEL) + (fetch SELOBJ of NSEL)) + (replace SELOBJ of NSEL with NIL))) + (COND + (FIXUPNEEDED + + (* ;; "We're in a menu, and this selection got contracted because of a protection violation. Fix up everything.") + + (\FIXSEL NSEL TEXTOBJ))) + (COND + (SETOSELFLG (* ; + "For whatever reason, it is wise to copy the new sel into the old one.") + (\COPYSEL NSEL OSEL)) + (T (* ; + "Otherwise, set the POINT of the old sel to correspond to the new sel's.") + (* ; + "(replace POINT of OSEL with NPOINT)") + (* ; + "THIS WAS REMOVED, BECAUSE EXTENDING A POINT-SELECTION WOULD DIE WHEN THIS WAS DONE") + )) + (RETURN NSEL)) + (T (* ; + "No new selection was made; just return the old one.") + (RETURN OSEL]) + +(TEDIT.SELECT + [LAMBDA (X Y TEXTOBJ REGION WORDSELFLG SELOPERATION WINDOW EXTENDING) + (* ; "Edited 30-May-91 23:07 by jds") + (* Select the character word, line, or + paragraph the mouse is pointing at.) + (PROG ((SEL NIL) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + PREVLINE L1 LN) + (SETQ SEL (TEDIT.SELECT.LINE.SCANNER X Y TEXTOBJ (\TEDIT.LINE.LIST TEXTOBJ WINDOW) + REGION WORDSELFLG SELOPERATION WINDOW EXTENDING)) + (COND + ((AND (type? SELECTION SEL) + (fetch (SELECTION SET) of SEL)) (* He pointed at something real; + return that.) + (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) + [COND + ([AND (CAR (fetch (SELECTION L1) of SEL)) + (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) + of (CAR (fetch (SELECTION L1) of SEL] + (replace (SELECTION X0) of SEL with (FIXR (FQUOTIENT (fetch (SELECTION X0) + of SEL) + 35.27778] + [COND + ([AND (CAR (fetch (SELECTION LN) of SEL)) + (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) + of (CAR (fetch (SELECTION LN) of SEL] + (replace (SELECTION XLIM) of SEL with (FIXR (FQUOTIENT (fetch (SELECTION XLIM) + of SEL) + 35.27778] + (replace (SELECTION DX) of SEL with (IDIFFERENCE (fetch (SELECTION XLIM) of SEL) + (fetch (SELECTION X0) of SEL))) + (\FIXSEL SEL TEXTOBJ WINDOW T) + (RETURN SEL)) + ((type? LINEDESCRIPTOR SEL) + + (* He pointed below the bottom of the text. + Select to the right of the last character on the screen.) + + (COND + ((fetch (LINEDESCRIPTOR LHASPROT) of SEL) (* The last line is protected. + Don't select anything.) + (RETURN))) + (SETQ PREVLINE SEL) + (SETQ SEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) + (replace (SELECTION SET) of SEL with T) + (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) + [replace (SELECTION CH#) of SEL with (IMAX 1 (ADD1 (IMIN TEXTLEN (fetch (LINEDESCRIPTOR + CHARLIM) + of PREVLINE] + (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) of SEL)) + (replace (SELECTION DCH) of SEL with 0) + [replace (SELECTION POINT) of SEL with (COND + ((IGREATERP (fetch (SELECTION CH#) + of SEL) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + + (* Can't select to the right of a character past EOF, only to the left -- + which is the right edge of the text.) + + 'LEFT) + (T 'RIGHT] + (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) + (\FIXSEL SEL TEXTOBJ) + (RETURN SEL]) + +(TEDIT.SCAN.LINE + [LAMBDA (TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION WINDOW EXTENDING) + (* ; "Edited 31-May-91 12:26 by jds") + + (* ;; "Given a line, find the character which straddles the mouse.") + + (PROG ((L NIL) + (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) + (CHLIST (fetch (THISLINE CHARS) of THISLINE)) + (LLIST (fetch (THISLINE LOOKS) of THISLINE)) + (LOOKNO 1) + (DX 0) + OTX YBOT YBASE TX (CH (CHARCODE SPACE)) + PREVCH CHOBJB TXB CHB (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + L1 LN CLOOKS PCLOOKS) + (COND + ((NEQ (fetch DESC of THISLINE) + LINE) (* ; + "If the cache doesn't describe this line, call \FORMATLINE so it will.") + (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) of LINE) + LINE))) + [COND + ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) + (* ; + "This is a hardcopy-mode line. Convert units to micas") + (SETQ X (FIXR (FTIMES X 35.27778] + [SETQ OTX (SETQ TXB (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE] + (SETQ X (IMAX X TX)) (* ; + "The mouse MUST be inside the line being selected.") + (SETQ CHB (SUB1 (fetch (LINEDESCRIPTOR CHAR1) of LINE))) + (SETQ CLOOKS (\EDITELT LLIST 0)) + (\TEDIT.CHECK (IGEQ X (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))) + (* ; + "The mouse MUST be inside the line being selected.") + (for I from 0 to (fetch LEN of THISLINE) as CHNO from (SUB1 (fetch (LINEDESCRIPTOR CHAR1) + of LINE)) + do (SETQ PREVCH CH) + (SETQ PCLOOKS CLOOKS) + (SETQ CH (\EDITELT CHLIST I)) + [COND + ((EQ CH LMInvisibleRun) (* ; "An invisible run -- skip it") + (add CHNO (\EDITELT LLIST LOOKNO)) (* ; "The length of the run") + (add LOOKNO 1) (* ; + "Move to next CLook for next transition") + (add I 1) (* ; + "Don't count this toward the CHNO counter.") + (SETQ CH (\EDITELT CHLIST I] + (\TEDIT.CHECK (NEQ CH LMInvisibleRun)) (* ; + "Can't have 2 invisible runs in a row.") + [COND + ((EQ CH LMLooksChange) (* ; + "Change of CharLooks -- make the switch") + (SETQ CLOOKS (\EDITELT LLIST LOOKNO)) (* ; "New looks") + (add LOOKNO 1) (* ; + "Move to next CLook for next transition") + (add I 1) (* ; + "Don't count this toward the CHNO counter.") + (SETQ CH (\EDITELT CHLIST I] + [COND + ((AND (ILESSP X TX) + (OR (EQ SELOPERATION 'COPY) + (fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + (NOT (fetch (CHARLOOKS CLPROTECTED) of PCLOOKS))) + (OR (NOT WORDSELFLG) + (NOT (SMALLP PREVCH)) + (\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH))) + + (* ;; "If we're beyond the mouse's X, and the character is selectable, and we're in char select or this is a word boundary then SELECT!!!") + + (\TEDIT.CHECK (NOT (ZEROP I))) (* ; + "We had best not have fouled out to the left of the left margin!") + (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) + (* ; "Grab the scratch sel") + (replace (SELECTION SET) of L with T) (* ; "Mark it valid") + [replace (SELECTION SELKIND) of L with (COND + (WORDSELFLG 'WORD) + (T 'CHAR] + (\TEDIT.SELECT.CHARACTER TEXTOBJ L PREVCH LINE X Y TXB WINDOW SELOPERATION + EXTENDING) + (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + (replace (SELECTION X0) of L with (COND + ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + (* ; + "If CLSelHere, then select to RIGHT always.") + TX) + (WORDSELFLG TXB) + (T OTX))) + (replace (SELECTION DX) of L with (COND + ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + 0) + (WORDSELFLG (IDIFFERENCE TX TXB)) + (T DX))) + [replace (SELECTION CH#) of L with (IMAX 1 (COND + ((fetch (CHARLOOKS CLSELHERE) + of PCLOOKS) + (ADD1 CHNO)) + (WORDSELFLG (ADD1 CHB)) + (T CHNO] + (replace (SELECTION XLIM) of L with (COND + ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + TX) + (WORDSELFLG TX) + (T TX))) + [replace (SELECTION CHLIM) of L with (ADD1 (COND + ((fetch (CHARLOOKS CLSELHERE) + of PCLOOKS) + CHNO) + (WORDSELFLG CHNO) + (T CHNO] + (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + (for L1 on (fetch (SELECTION L1) of L) as LN on (fetch (SELECTION LN) + of L) as WW + inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) when (EQ WW WINDOW) + do (RPLACA L1 LINE) + (RPLACA LN LINE)) + [replace (SELECTION POINT) of L + with (COND + ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + (* ; + "Always to the right of an otherwise-protected insertion point marker") + 'RIGHT) + [WORDSELFLG (COND + ((AND (NEQ PREVCH (CHARCODE CR)) + (IGEQ X (LRSH (IPLUS TX TXB) + 1))) + (* ; + "To the right if it isn't a CR and we're right of center.") + 'RIGHT) + (T 'LEFT] + (T (COND + ((AND (IGEQ DX 3) + (NEQ PREVCH (CHARCODE CR)) + (IGEQ X (LRSH (IPLUS TX OTX) + 1))) + + (* ;; "If it's wide enough to sensibly decide on an edge for, this isn't a CR, and we're right of center, then put the caret to the RIGHT") + + 'RIGHT) + (T 'LEFT] + (replace (SELECTION DCH) of L with (COND + ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + 0) + (WORDSELFLG (IDIFFERENCE CHNO CHB)) + (T 1))) + (RETURN)) + (T + (* ;; "We're not past the mouse yet; just track the last word boundary (or protected-text boundary) for word selection.") + + (COND + ((OR (AND (NOT (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) + (\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH)) + (NEQ (fetch (CHARLOOKS CLPROTECTED) of PCLOOKS) + (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) + (fetch (CHARLOOKS CLSELHERE) of PCLOOKS)) + (SETQ TXB TX) + (SETQ CHB CHNO) + (SETQ CHOBJB PREVCH] + (SETQ OTX TX) + (SETQ DX (\EDITELT WLIST I)) + (SETQ TX (IPLUS TX DX))) + [COND + ((AND (NOT L) + (IGEQ (fetch LEN of THISLINE) + 0) + (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) + + (* ;; "He's pointing to the right of the line, but there's protected text at the end. Select a point at the last legal spot.") + + (COND + ((SMALLP CHOBJB) (* ; + "And the last item wasn't a menu button") + (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) + (replace (SELECTION SET) of L with T) + (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + (replace (SELECTION X0) of L with TXB) + (replace (SELECTION DX) of L with 0) + (replace (SELECTION CH#) of L with (IMAX 1 (ADD1 CHB))) + (replace (SELECTION XLIM) of L with TXB) + (replace (SELECTION CHLIM) of L with (IMAX 1 (ADD1 CHB))) + (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + (for L1 on (fetch (SELECTION L1) of L) as LN on (fetch (SELECTION LN) of L) + as WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) when (EQ WW WINDOW) + do (RPLACA L1 LINE) + (RPLACA LN LINE)) + (replace (SELECTION POINT) of L with 'LEFT) + (replace (SELECTION DCH) of L with 0) + (replace (SELECTION SELOBJ) of L with NIL)) + (T (* ; + "Oops--the last item WAS a menu button. Don't let it be selected.") + (RETURN 'DON'T] + (COND + (L (* ; + "If we found the place he's pointing, set up the inter-pointers so each can find the other") + (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ)) + (T (* ; + "We didn't find what he was pointing at. Point to the end of the line.") + (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) + (replace (SELECTION SET) of L with T) + [replace (SELECTION SELKIND) of L with (COND + (WORDSELFLG 'WORD) + (T 'CHAR] + (* ; + "THIS MUST PRECEDE THE \TEDIT.SELECT.CHARACTER, SO OBJECTS CAN TURN THE SELECTION VOLATILE.") + (\TEDIT.SELECT.CHARACTER TEXTOBJ L CH LINE X Y TXB WINDOW SELOPERATION EXTENDING) + (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + [replace (SELECTION X0) of L with (COND + (WORDSELFLG TXB) + (T (IDIFFERENCE TX DX] + (replace (SELECTION XLIM) of L with TX) + (replace (SELECTION DX) of L with (COND + (WORDSELFLG (IDIFFERENCE TX TXB)) + (T DX))) + [replace (SELECTION CH#) of L with (COND + (WORDSELFLG (ADD1 CHB)) + (T (IMIN (fetch (LINEDESCRIPTOR CHARLIM) + of LINE) + TEXTLEN] + (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + (replace (SELECTION CHLIM) of L with (ADD1 (IMIN (fetch (LINEDESCRIPTOR CHARLIM) + of LINE) + TEXTLEN))) + [replace (SELECTION POINT) of L + with (COND + [(NEQ CH (CHARCODE CR)) (* ; + "You can select only to the left of a CR; elsewhere, you can select to the right") + (COND + ([IGEQ X (COND + (WORDSELFLG (* ; + "If it's a word, check our location against mid-word to see which side to put the caret on") + (LRSH (IPLUS TX TXB) + 1)) + (T (* ; + "Otherwise, check against mid-character") + (IDIFFERENCE TX (LRSH DX 1] + (* ; + "If we're to the right of mid-item, put the caret on the right.") + 'RIGHT) + (T (* ; "Otherwise, put it on the left.") + 'LEFT] + (T 'LEFT] + (for L1 on (fetch (SELECTION L1) of L) as LN on (fetch (SELECTION LN) of L) + as WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) when (EQ WW WINDOW) + do (RPLACA L1 LINE) + (RPLACA LN LINE)) + (replace (SELECTION DCH) of L with (COND + (WORDSELFLG (IDIFFERENCE + (IMIN (fetch (LINEDESCRIPTOR + CHARLIM) + of LINE) + TEXTLEN) + CHB)) + (T 1))) + (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ))) + (RETURN L]) + +(TEDIT.SELECT.LINE.SCANNER + [LAMBDA (X Y TEXTOBJ LINE.LIST REGION WORDSELFLG SELOPERATION WINDOW EXTENDING) + (* ; "Edited 31-May-91 12:26 by jds") + (* ; + "Find the text line the mouse is pointing at.") + (* ; + "LINE.LIST is the dummy first line for the window in which selection happened.") + (PROG ((L NIL) + (WWIDTH (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) + (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (WREG (DSPCLIPPINGREGION NIL WINDOW)) + PREVLINE PARABOUNDS PARASTART PARAEND L1 LN) + (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINE.LIST)) + while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch BOTTOM of WREG))) + do + + (* ;; "Search thru the list of (real) displayed lines, looking for the first one whose bottom is below the mouse. That's the line we're pointing at.") + + (COND + ((ILEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) + Y) (* ; "Found it.") + (SELECTQ REGION + ((TEXT WINDOW) (* ; + "We're in the regular text area, so scan accross looking for the character.") + (SETQ L (TEDIT.SCAN.LINE TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION + WINDOW EXTENDING))) + (LINE (* ; + "He is selecting an entire line, or a paragraph.") + (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) + (for TL1 on (fetch (SELECTION L1) of L) as TLN + on (fetch (SELECTION LN) of L) as WW inside (fetch (TEXTOBJ \WINDOW) + of TEXTOBJ) + when (EQ WW WINDOW) do (SETQ L1 TL1) + (SETQ LN TLN) + (RETURN)) + (COND + ((AND (fetch (LINEDESCRIPTOR LHASPROT) of LINE) + (NEQ SELOPERATION 'COPY))(* ; + "In a TEDIT menu, you can't select a whole paragraph or line.") + (replace (SELECTION SET) of L with NIL) + (RETURN L))) (* ; "The scratch selection") + (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ) + (* ; + "Make sure he knows what document the selection's in.") + (replace (SELECTION SET) of L with T) + (* ; "Mark it valid.") + (replace (SELECTION SELOBJ) of L with NIL) + (* ; "Not selecting an object just yet") + (COND + [WORDSELFLG (* ; "Select a paragraph.") + (replace (SELECTION SELKIND) of L with 'PARA) + (* ; + "SEARCH FORWARD FROM THE CURRENT LINE TO A LINE WITH A CR OR CHARLIM=EOTEXT") + [COND + ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) + + (* ;; "If this is a para-formatted document, use the paragraph bounds. Otherwise, delimit a para by the surrounding CRs.") + + (SETQ PARABOUNDS (\TEDIT.PARABOUNDS TEXTOBJ (fetch (LINEDESCRIPTOR + CHAR1) + of LINE))) + (SETQ PARASTART (\TEDIT.FIND.PROTECTED.START TEXTOBJ + (fetch (LINEDESCRIPTOR CHAR1) of LINE) + (CAR PARABOUNDS))) + (SETQ PARAEND (\TEDIT.FIND.PROTECTED.END TEXTOBJ + (fetch (LINEDESCRIPTOR CHAR1) of LINE) + (CDR PARABOUNDS] + (RPLACA L1 LINE) + (RPLACA LN LINE) + (bind (LL _ LINE) + while (AND [COND + ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) + (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LL) + PARAEND)) + (T (NOT (fetch (LINEDESCRIPTOR CR\END) of LL] + (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LL) + TEXTLEN)) + do (* ; + "Walk forward thru the lines, looking for the last line in the paragraph.") + [COND + ((fetch (LINEDESCRIPTOR NEXTLINE) of LL) + (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) + (T [replace (LINEDESCRIPTOR NEXTLINE) of LL + with (\FORMATLINE TEXTOBJ NIL + (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) + of LL] + (replace (LINEDESCRIPTOR PREVLINE) + of (fetch (LINEDESCRIPTOR NEXTLINE) of LL) with LL) + (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL] + finally (RPLACA LN LL)) (* ; + "SEARCH BACK TO A LINE WITH A CR OR BOTEXT") + [COND + ((IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) + 1) (* ; + "Only search backward if we're not on the first line already.") + (bind (LL _ LINE) + while [AND (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) + of LL) + 1) + (COND + ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) + (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) + of LL) + PARASTART)) + (T (NOT (fetch (LINEDESCRIPTOR CR\END) + of (fetch (LINEDESCRIPTOR PREVLINE) + of LL] + do + (* ;; "Back up until we find the first line of the paragraph, or we hit the dummy top line (which claims to end in CR.)") + + (SETQ LL (fetch (LINEDESCRIPTOR PREVLINE) of LL)) + finally + (RPLACA L1 (COND + ((AND (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) + (IEQP (fetch (LINEDESCRIPTOR CHAR1) + of LL) + PARASTART)) + (* ; "We found a true start of para.") + LL) + ([AND (fetch (LINEDESCRIPTOR PREVLINE) + of LL) + (NOT (ZEROP (fetch (LINEDESCRIPTOR CHARLIM) + of (fetch (LINEDESCRIPTOR + PREVLINE) + of LL] + (* ; + "We hit the first line in the paragraph, fair and square") + LL) + ((IEQP 1 (fetch (LINEDESCRIPTOR CHAR1) + of LL)) + (* ; "We hit the front of the document.") + LL) + (T (\BACKFORMAT LINE.LIST TEXTOBJ + (fetch PTOP of WREG)) + (fetch (LINEDESCRIPTOR NEXTLINE) of LINE.LIST] + [replace (SELECTION CH#) of L with (OR PARASTART (fetch ( + LINEDESCRIPTOR + CHAR1) + of (CAR L1] + [replace (SELECTION CHLIM) of L + with (ADD1 (OR PARAEND (fetch (LINEDESCRIPTOR CHARLIM) + of (CAR LN] + [replace (SELECTION POINT) of L + with (COND + ((ILEQ (IDIFFERENCE (fetch (LINEDESCRIPTOR CHAR1) + of LINE) + (fetch (SELECTION CH#) of L)) + (IDIFFERENCE (fetch (SELECTION CHLIM) of L) + (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + 'LEFT) + (T 'RIGHT] + (replace (SELECTION DCH) of L with (IDIFFERENCE (fetch (SELECTION + CHLIM) + of L) + (fetch (SELECTION CH#) + of L))) + (COND + ((fetch (LINEDESCRIPTOR LHASPROT) of LINE) + (* ; + "We have cause to suspect there may be protected text around this para. Fix the sel the hard way.") + (\FIXSEL L TEXTOBJ)) + (T (* ; + "No protected text is evident. DO it the easy way.") + (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) + of (CAR L1))) + (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR + YBOT) + of (CAR LN))) + (replace (SELECTION X0) of L with (fetch (LINEDESCRIPTOR + LEFTMARGIN) + of (CAR L1))) + (replace (SELECTION XLIM) of L with (fetch (LINEDESCRIPTOR + LXLIM) + of (CAR LN))) + (replace (SELECTION DX) of L + with (IPLUS 1 (IDIFFERENCE (fetch (SELECTION XLIM) + of L) + (fetch (SELECTION X0) of L] + (T (* ; + "Select the line we're pointing at.") + (replace (SELECTION SELKIND) of L with 'LINE) + (RPLACA L1 LINE) + (RPLACA LN LINE) + (replace (SELECTION CH#) of L with (fetch (LINEDESCRIPTOR CHAR1) + of LINE)) + (replace (SELECTION CHLIM) of L with (ADD1 (fetch (LINEDESCRIPTOR + CHARLIM) + of LINE))) + (replace (SELECTION DX) of L with (IDIFFERENCE (fetch ( + LINEDESCRIPTOR + LXLIM) + of LINE) + (fetch (LINEDESCRIPTOR + LEFTMARGIN) + of LINE))) + (replace (SELECTION X0) of L with (fetch (LINEDESCRIPTOR LEFTMARGIN) + of LINE)) + (replace (SELECTION XLIM) of L with (fetch (LINEDESCRIPTOR LXLIM) + of LINE)) + (replace (SELECTION Y0) of L with (replace (SELECTION YLIM) + of L with (fetch ( + LINEDESCRIPTOR + YBOT) + of LINE))) + (replace (SELECTION DCH) of L with (IDIFFERENCE (fetch (SELECTION + CHLIM) + of L) + (fetch (SELECTION CH#) + of L))) + (replace (SELECTION POINT) of L with 'LEFT) + (replace (SELECTION SET) of L with T)))) + (SHOULDNT "Unknown text/line-bar region?")) + (RETURN))) + (SETQ PREVLINE LINE) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + (RETURN (OR L PREVLINE]) + +(\TEDIT.SELECT.CHARACTER + [LAMBDA (TEXTOBJ SEL PREVCH LINE X Y TXB SELWINDOW SELOPERATION EXTENDING) + (* ; "Edited 29-Mar-94 13:28 by jds") + + (* ;; "We have moved over a particular character. If it's really a character, OK. Otherwise, call in the selection function!") + + (DECLARE (USEDFREE . WORDSELFLG)) + (COND + ((NULL PREVCH) + (replace (SELECTION SELOBJ) of SEL with NIL)) + ((SMALLP PREVCH) + (replace (SELECTION SELOBJ) of SEL with NIL)) + (T (replace (SELECTION SELOBJ) of SEL with PREVCH) + (replace (SELECTION X0) of SEL with TXB) + (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + [PROG ([OBJBOX (OR (IMAGEOBJPROP PREVCH 'BOUNDBOX) + (IMAGEBOX PREVCH SELWINDOW 'DISPLAY] + (DS (WINDOWPROP SELWINDOW 'DSP)) + SELRES) + (RESETLST + (RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS TXB (DSPXOFFSET NIL DS)) + (fetch XKERN of OBJBOX)) + DS) + (LIST (FUNCTION DSPXOFFSET) + (DSPXOFFSET NIL DS) + DS)) + (RESETSAVE (DSPYOFFSET (IDIFFERENCE (IPLUS (fetch (LINEDESCRIPTOR YBASE) + of LINE) + (DSPYOFFSET NIL DS)) + (fetch YDESC of OBJBOX)) + DS) + (LIST (FUNCTION DSPYOFFSET) + (DSPYOFFSET NIL DS) + DS)) + (RESETSAVE (DSPCLIPPINGREGION (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (IMIN (fetch XSIZE of OBJBOX) + (IDIFFERENCE + (fetch (TEXTOBJ WRIGHT) + of TEXTOBJ) + TXB)) + HEIGHT _ (fetch YSIZE of OBJBOX)) + DS) + (LIST (FUNCTION DSPCLIPPINGREGION) + (DSPCLIPPINGREGION NIL DS) + DS)) + (SETQ SELRES (ERSETQ (APPLY* (IMAGEOBJPROP PREVCH 'BUTTONEVENTINFN) + PREVCH DS SEL (IDIFFERENCE X TXB) + (IDIFFERENCE Y (fetch (LINEDESCRIPTOR YBASE) + of LINE)) + SELWINDOW + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + (COND + (EXTENDING 'RIGHT) + (WORDSELFLG 'MIDDLE) + (T 'LEFT)) + SELOPERATION))) + (* ; + "Go tell him he's being pointed at.") + ) + (COND + ((NULL SELRES) (* ; + "If the event fn returns NIL, do nothing untoward") + ) + ((NULL (CAR SELRES)) (* ; + "If it returns something with a CAR of NIL, then UN-SET the object-ness of the selection") + (replace (SELECTION SELOBJ) of SEL with NIL)) + (T (* ; + "Otherwise, check to see what he wants us to do") + (COND + ((EQ (CAR SELRES) + 'DON'T) (* ; + "The object declines to be selected. Don't permit the select to happen.") + (replace (SELECTION SET) of SEL with NIL)) + ((AND (LISTP (CAR SELRES)) + (FMEMB 'DON'T (CAR SELRES))) (* ; + "The object declines to be selected. Don't permit the select to happen.") + (replace (SELECTION SET) of SEL with NIL))) + (COND + ((EQ (CAR SELRES) + 'CHANGED) (* ; + "If the object claims to have changed, update the screen.") + (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL))) + ((AND (LISTP (CAR SELRES)) + (FMEMB 'CHANGED (CAR SELRES)))(* ; + "If the object claims to have changed, update the screen.") + (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL] + (SETQ WORDSELFLG NIL]) +) +(DEFINEQ + +(\FIXSEL + [LAMBDA (SEL TEXTOBJ THISWINDOW AVOIDINGTHISW) (* ; "Edited 31-May-91 12:26 by jds") + + (* ;; "Given that the selection SEL contains the correct CH# and CHLIM, reset the Y0 X0, DX, and XLIM values.") + + (PROG* ((CH# (fetch (SELECTION CH#) of SEL)) + (CHLIM (fetch (SELECTION CHLIM) of SEL)) + (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) + (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) + (THISW (OR THISWINDOW (\TEDIT.MAINW TEXTOBJ))) + (WREG (AND THISW (DSPCLIPPINGREGION NIL THISW))) + (STARTFOUND NIL) + (ENDFOUND NIL) + WLIST CHLIST LOOKS LINE PREVLINE L1HCPY LNHCPY) + (COND + ((NOT WINDOW) (* ; + "There is no window to go with this edit; don't bother to try updating the selection") + (RETURN)) + ((NOT THISW) (* ; + "There is no window to go with this edit; don't bother to try updating the selection") + (RETURN))) + [COND + ((AND AVOIDINGTHISW (fetch (SELECTION Y0) of SEL))) + (T (replace (SELECTION Y0) of SEL with (fetch PTOP of WREG] + (COND + ((AND AVOIDINGTHISW (fetch (SELECTION YLIM) of SEL))) + (T (replace (SELECTION YLIM) of SEL with -1))) + (OR (fetch (SELECTION XLIM) of SEL) + (replace (SELECTION XLIM) of SEL with -1)) (* ; "Initialize it, if need be.") + (for WW inside WINDOW as L1 on (fetch (SELECTION L1) of SEL) as LN + on (fetch (SELECTION LN) of SEL) as LINES inside (fetch (TEXTOBJ LINES) of TEXTOBJ) + do (COND + ([AND (fetch (SELECTION SET) of SEL) + (OR (NOT THISWINDOW) + (NEQ AVOIDINGTHISW (EQ THISWINDOW WW] + (* ; + "Only if a 'real' SELECTION proceed") + (SETQ WLIST (fetch (THISLINE WIDTHS) of THISLINE)) + (SETQ CHLIST (fetch (THISLINE CHARS) of THISLINE)) + (SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE)) + (RPLACA L1 NIL) + (RPLACA LN NIL) + (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) + TX DX while LINE + do (COND + [(AND (IGEQ CH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (* ; + "The selection starts in this line. Fix L1, X0, and Y0.") + (SETQ STARTFOUND T) + (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) + of LINE)) + (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE))) + (* ; + "Remember that this is a hardcopy-mode line") + (RPLACA L1 LINE) + (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) + (* ; + "Temp. X value for scanning the line from left margin to the right") + (replace (SELECTION X0) of SEL with (fetch (LINEDESCRIPTOR LEFTMARGIN) + of LINE)) + (COND + ((IGREATERP CH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (* ; + "Only bother formatting the line if the selection doesn't include the first character.") + (COND + ((NEQ (fetch DESC of THISLINE) + LINE) (* ; + "If this line isn't cached in THISLINE, reformat it.") + (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) + of LINE) + LINE))) + (COND + ((IGEQ (fetch LEN of THISLINE) + 0) (* ; + "As long as there's something there on the line...") + (bind (LOOKNO _ 0) for I from 0 + to (fetch LEN of THISLINE) as CHNO + from (fetch (LINEDESCRIPTOR CHAR1) of LINE) + do + + (* ;; "Run thru the characters on the line, looking for the first selected one. Keep track of our X position, so we know where the selection starts.") + + (SETQ DX (\EDITELT WLIST I)) + (SETQ TX (IPLUS TX DX)) + (COND + ((IGEQ CHNO CH#) + (* ; + "We've found that first character. Time to bail out.") + (RETURN)) + [(EQ LMInvisibleRun (\EDITELT CHLIST I)) + (* ; + "This is INVISIBLE text. Count the characters as though they were there.") + (add LOOKNO 1) + (add CHNO (SUB1 (\EDITELT LOOKS LOOKNO] + ((EQ LMLooksChange (\EDITELT CHLIST I)) + (* ; + "This is a format effector--reduce CHNO to ignore it") + (add LOOKNO 1) + (SETQ CHNO (SUB1 CHNO))) + (T (* ; + "Not yet; update our running X-position in the SEL.") + (replace (SELECTION X0) of SEL with TX] + ((AND (IEQP CH# (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + + (* ;; "The selection starts after the end of this line, but it's also the end of the text. Go ahead and select there.") + + (COND + ((NEQ (fetch DESC of THISLINE) + LINE) (* ; + "If this line isn't cached in THISLINE, reformat it.") + (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) + of LINE) + LINE))) + (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) + of LINE)) + (RPLACA L1 LINE) (* ; + "Make this line be the first in the selection") + (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE))) + (replace (SELECTION X0) of SEL with (fetch (LINEDESCRIPTOR LXLIM) + of LINE))) + ((AND (NOT STARTFOUND) + (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) + CH#) + (ILESSP (fetch (LINEDESCRIPTOR CHAR1) of LINE) + CHLIM)) (* ; + "The selection starts before this line, so play catch-up") + (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) + of LINE)) + (RPLACA L1 LINE) (* ; + "Grab this line and make it the apparent first line.") + (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE))) + (replace (SELECTION X0) of SEL with (fetch (LINEDESCRIPTOR LEFTMARGIN) + of LINE)) + (SETQ STARTFOUND T))) + [COND + ([AND (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) + (IGEQ CHLIM (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (ILEQ CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] + (* ; + "The selection ends in this line. Fix LN, XLIM, and YLIM.") + + (* ;; "NB that it also has to START before the end of this line. This eliminates the case of a 0-wide selection right after the last char on this line.") + + (replace (SELECTION YLIM) of SEL with (fetch (LINEDESCRIPTOR YBOT) + of LINE)) + (* ; + "Set the lowest-Y value for the selection") + (RPLACA LN LINE) (* ; "Remember the final line") + (SETQ LNHCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE))) + (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) + (* ; "Temp X position") + (replace (SELECTION XLIM) of SEL with (fetch (LINEDESCRIPTOR LXLIM) + of LINE)) + (* ; + "Start by assuming that the selection extends all the way across the line") + [COND + [(AND (IEQP CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) + of LINE))) + (EQ (fetch (SELECTION POINT) of SEL) + 'RIGHT) + (IEQP (fetch (SELECTION DCH) of SEL) + 0) + (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) + (fetch (LINEDESCRIPTOR CR\END) of LINE)) + (* ; + "This selection starts AFTER the CR on a line, and doesn't include it.") + (RPLACA LN (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) + (* ; + "Change the selection to start on the next line, at the margin, instead.") + (replace (SELECTION XLIM) of SEL with (fetch (LINEDESCRIPTOR + LEFTMARGIN) + of (CAR LN))) + (replace (SELECTION YLIM) of SEL with (fetch (LINEDESCRIPTOR + YBOT) + of (CAR LN] + ((ILEQ CHLIM (IMIN (fetch (LINEDESCRIPTOR CHARLIM) of LINE) + (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (* ; + "Only bother formatting if the selection doesn't include the last char on the line") + (COND + ((NEQ (fetch DESC of THISLINE) + LINE) (* ; + "If this line isn't cached in THISLINE, then reformat it.") + (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) + of LINE) + LINE))) + (COND + ((IGEQ (fetch LEN of THISLINE) + 0) (* ; + "If there are characters on the line, go looking for the one that ends the selection.") + (bind (LOOKNO _ 0) for I from 0 + to (fetch LEN of THISLINE) as CHNO + from (fetch (LINEDESCRIPTOR CHAR1) of LINE) + do + + (* ;; "Run thru the characters, until we find the final one that is selected. Kep running track of our X position on the line, so we know how wide the final line's hiliting should be.") + + (SETQ DX (\EDITELT WLIST I)) + (* ; "The current character's width") + (SETQ TX (IPLUS TX DX)) + (* ; "Running Temp-X position") + (COND + ((IGEQ CHNO CHLIM) + (* ; + "OK; this character is past the end of the selection. Stop here.") + (RETURN)) + [(EQ LMInvisibleRun (\EDITELT CHLIST I)) + (* ; + "This is a run of INVISIBLE characters. Count them in the character position, though.") + (add LOOKNO 1) + (add CHNO (SUB1 (\EDITELT LOOKS LOOKNO] + ((EQ LMLooksChange (\EDITELT CHLIST I)) + (* ; + "This is a format effector--reduce CHNO to ignore it") + (SETQ CHNO (SUB1 CHNO)) + (add LOOKNO 1)) + (T (* ; + "Keep track of how far across we've gotten.") + (replace (SELECTION XLIM) of SEL with TX] + (RETURN) (* ; + "And stop looking for an ending line--we've obviously found it!") + ) + ((AND (IEQP CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (* ; + "The selection ends either here or at the start of the next line.") + (* ; + "ANN there is something on this line really selected.") + (replace (SELECTION YLIM) of SEL with (fetch (LINEDESCRIPTOR YBOT) + of LINE)) + (SETQ LNHCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE))) + (RPLACA LN LINE) + (replace (SELECTION XLIM) of SEL with (fetch (LINEDESCRIPTOR LXLIM) + of LINE] + (SETQ PREVLINE LINE) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + [COND + (L1HCPY (* ; + "The first line of the selection is hardcopy-mode. Convert the X0 value to screen units") + (replace (SELECTION X0) of SEL + with (FIXR (FQUOTIENT (fetch (SELECTION X0) of SEL) + 35.27778] + [COND + (LNHCPY (* ; + "The last line of the selection is hardcopy-mode. Convert the XLIM value to screen units") + (replace (SELECTION XLIM) of SEL + with (FIXR (FQUOTIENT (fetch (SELECTION XLIM) of SEL) + 35.27778] + (COND + [(IEQP 0 (fetch (SELECTION DCH) of SEL)) + (* ; + "If this is a point selection, put it on the correct side of the character we selected.") + (replace (SELECTION DX) of SEL with 0) + (COND + ((EQ (fetch (SELECTION POINT) of SEL) + 'LEFT) + (replace (SELECTION XLIM) of SEL with (fetch (SELECTION X0) of SEL))) + (T (replace (SELECTION X0) of SEL with (fetch (SELECTION XLIM) + of SEL] + (T (* ; + "Otherwise, fix DX for the selection") + (replace (SELECTION DX) of SEL with (IDIFFERENCE (fetch (SELECTION XLIM) + of SEL) + (fetch (SELECTION X0) + of SEL]) + +(\TEDIT.FIXDELSEL + [LAMBDA (SELTOFIX TEXTOBJ CH#1 CH#LIM DCH) (* ; "Edited 30-May-91 23:00 by jds") + (* Fix up a SELTOFIX after deletion + inside that textobj) + (* Only if the Selection is set, and + is in THIS textobj) + (COND + ((AND (fetch (SELECTION SET) of SELTOFIX) + (EQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELTOFIX))) + (COND + ((IGEQ (fetch (SELECTION CH#) of SELTOFIX) + CH#LIM) (* The selection is after the deleted + text. Just move it forward) + (replace (SELECTION CH#) of SELTOFIX with (IDIFFERENCE (fetch (SELECTION CH#) + of SELTOFIX) + DCH)) + (replace (SELECTION CHLIM) of SELTOFIX with (IDIFFERENCE (fetch (SELECTION CHLIM) + of SELTOFIX) + DCH))) + ((IGREATERP (fetch (SELECTION CHLIM) of SELTOFIX) + CH#1) (* It overlaps, at least partially.) + (COND + ((IGEQ (fetch (SELECTION CH#) of SELTOFIX) + CH#1) + + (* If the start of the selection was inside the deleted area, it now starts where + the deletion left off.) + + (replace (SELECTION CH#) of SELTOFIX with CH#1))) + (replace (SELECTION CHLIM) of SELTOFIX with (IMAX CH#1 (IDIFFERENCE (fetch (SELECTION + CHLIM) + of SELTOFIX) + DCH))) + (replace (SELECTION DCH) of SELTOFIX with (COND + ((IEQP (fetch (SELECTION CHLIM) of SELTOFIX) + CH#1) + 0) + (T (IDIFFERENCE (fetch (SELECTION CHLIM) + of SELTOFIX) + (fetch (SELECTION CH#) + of SELTOFIX]) + +(\TEDIT.FIXINSSEL + [LAMBDA (SELTOFIX TEXTOBJ CH#1 DCH) (* ; "Edited 30-May-91 23:00 by jds") + (* Fix up a SELTOFIX after deletion + inside that textobj) + (* Only if the Selection is set, and + is in THIS textobj) + (PROG (CH# CHLIM) + (COND + ((AND (fetch (SELECTION SET) of SELTOFIX) + (EQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELTOFIX))) + [COND + ((IGEQ (SETQ CH# (ffetch (SELECTION CH#) of SELTOFIX)) + CH#1) + + (* Fix up the selection; if we're beyond the insert point, move the whole sel + forward) + + (freplace (SELECTION CH#) of SELTOFIX with (IPLUS CH# DCH] + (COND + ((IGREATERP (SETQ CHLIM (ffetch (SELECTION CHLIM) of SELTOFIX)) + CH#1) (* And the tail end of the sel, too.) + (freplace (SELECTION CHLIM) of SELTOFIX with (IPLUS CHLIM DCH]) + +(\TEDIT.FIXSELS + [LAMBDA (TEXTOBJ EXCEPT) (* ; "Edited 30-May-91 23:03 by jds") + (* Fixes all the sels for a given + textobj.) + (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) + (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) + (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) + (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) when (NEQ SELN EXCEPT) + do (AND (fetch (SELECTION SET) of SELN) + (\FIXSEL SELN TEXTOBJ]) +) +(DEFINEQ + +(TEDIT.RESET.EXTEND.PENDING.DELETE + [LAMBDA (SEL) (* ; "Edited 30-May-91 23:03 by jds") + (* Reset the "Extend Pending Delete" + status) + (AND SEL (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)) + (SETQ TEDIT.PENDINGDEL NIL) + (AND (fetch (SELECTION \TEXTOBJ) of SEL) + (replace (TEXTOBJ BLUEPENDINGDELETE) of (fetch (SELECTION \TEXTOBJ) of SEL) with NIL]) + +(\TEDIT.SET.SEL.LOOKS + [LAMBDA (SEL OPERATION) (* ; "Edited 30-May-91 23:00 by jds") + (* Set what the selection should be + displayed like, given what it's for + (NORMAL, COPY, MOVE, etc.)) + (SELECTQ OPERATION + (NORMAL (* Regular selection) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 1) + (replace (SELECTION HASCARET) of SEL with T)) + (COPY (* Copy source) + (replace (SELECTION HOW) of SEL with COPYSELSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 1) + (replace (SELECTION HASCARET) of SEL with NIL)) + (COPYLOOKS (* copylooks source) + (replace (SELECTION HOW) of SEL with COPYLOOKSSELSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 2) + (replace (SELECTION HASCARET) of SEL with NIL)) + (MOVE (* Copy source) + (replace (SELECTION HOW) of SEL with EDITMOVESHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with NIL)) + (DELETE (* To be deleted instantly) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with NIL) + NIL) + (PENDINGDEL (* Delete at next type-in) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with T) + NIL) + (INVERTED (* For people who really want to see + what's selected.) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with T) + NIL) + NIL]) +) +(DEFINEQ + +(\SHOWSEL + [LAMBDA (SEL HOW ON) (* ; "Edited 22-May-92 16:11 by jds") + + (* ;; "Highlight the selection SEL, according to HOW, turning it on or off according to ON") + + (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) + (SHADE (OR (fetch (SELECTION HOW) of SEL) + BLACKSHADE)) + (SHADEHEIGHT (OR (fetch (SELECTION HOWHEIGHT) of SEL) + 1)) + LL SHOWFN) + (COND + ([OR (NOT (fetch (SELECTION SET) of SEL)) + (NOT (fetch (TEXTOBJ \WINDOW) of (fetch (SELECTION \TEXTOBJ) of SEL] + + (* ;; "This operation only makes sense if there is a selection, it has been set, and there's a window to do the highlighting in.") + + (RETURN)) + ((fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ) (* ; + "We're suppressing screen updating, so don't do anything visible.") + (RETURN))) + [for DS inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES + inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as L1 in (fetch (SELECTION L1) of SEL) + as LN in (fetch (SELECTION LN) of SEL) as CARET inside (fetch (TEXTOBJ CARET) + of TEXTOBJ) + do (COND + ((fetch (SELECTION SELOBJ) of SEL) (* ; + "If it is an object and it has a non-nil showselfn then use it") + (\TEDIT.OBJECT.SHOWSEL TEXTOBJ SEL ON DS) + (RETURN))) + (COND + [(AND ON (NOT (fetch (SELECTION ONFLG) of SEL))) + (* ; + "It's off and we want to turn it on") + (\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE) + (COND + [(AND (fetch (SELECTION HASCARET) of SEL) + (ffetch (TEXTOBJ TXTEDITING) of TEXTOBJ)) + + (* ;; + "If the selection has a caret, turn one on. But only if the document is actively being edited.") + + (COND + [(EQ (fetch (SELECTION POINT) of SEL) + 'LEFT) (* ; "At the LEFT end of the selection") + (COND + ((AND L1 (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) + 0)) + (\SETCARET (fetch (SELECTION X0) of SEL) + (fetch (LINEDESCRIPTOR YBASE) of L1) + DS TEXTOBJ CARET)) + (T (MOVETO -10 -10 DS] + ((AND LN (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LN) + 0)) (* ; "Or at the RIGHT end.") + (\SETCARET (fetch (SELECTION XLIM) of SEL) + (fetch (LINEDESCRIPTOR YBASE) of LN) + DS TEXTOBJ CARET)) + (T (* ; + "Neither end is on screen. For self-caret flashers, move the caret location off-screen") + (MOVETO -10 -10 DS] + (T (SELECTQ (fetch (SELECTION POINT) of SEL) + (LEFT (AND L1 (MOVETO (fetch (SELECTION X0) of SEL) + (fetch (LINEDESCRIPTOR YBASE) of L1) + DS))) + (RIGHT (AND LN (MOVETO (fetch (SELECTION XLIM) of SEL) + (fetch (LINEDESCRIPTOR YBASE) of LN) + DS))) + NIL] + ((AND (NOT ON) + (fetch (SELECTION ONFLG) of SEL)) (* ; + "The selection is highlighted and we want to turn it off.") + (COND + ((AND (fetch (SELECTION HASCARET) of SEL) + (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) + (ffetch (TEXTOBJ TXTEDITING) of TEXTOBJ)) + (* ; + "IF the selection has a caret with it, make sure it's turned off.") + (\EDIT.UPCARET CARET) (* ; "Pick the caret up off the screen.") + )) + (\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE] + (replace (SELECTION ONFLG) of SEL with ON]) + +(\SHOWSEL.HILIGHT + [LAMBDA (TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE X0 XLIM) + (* ; "Edited 30-May-91 23:07 by jds") + + (* * Do the actual highlighting and unhighlighting of a selection for \SHOWSEL) + + (PROG (LL LEFT RIGHT) + (COND + ((OR L1 LN) + + (* One end or the other is on-screen, so it makes sense to try displaying + something.) + + (COND + ((AND L1 (EQ L1 LN) + (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) + 0)) (* It's all in a single line; + just underline the right section and + beat it) + (BITBLT NIL 0 0 DS (OR X0 (fetch (SELECTION X0) of SEL)) + (fetch (LINEDESCRIPTOR YBOT) of L1) + (IDIFFERENCE (OR XLIM (fetch (SELECTION XLIM) of SEL)) + (OR X0 (fetch (SELECTION X0) of SEL))) + (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of L1)) + 'TEXTURE + 'INVERT SHADE)) + (T (* Different lines.) + (COND + ((AND L1 (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) + 0)) (* If the first line is known, + underline the right section of it.) + [SETQ RIGHT (COND + ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of L1)) + (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR LXLIM) of L1) + 35.27778))) + (T (fetch (LINEDESCRIPTOR LXLIM) of L1] + (BITBLT NIL 0 0 DS (OR X0 (fetch (SELECTION X0) of SEL)) + (fetch (LINEDESCRIPTOR YBOT) of L1) + (IDIFFERENCE RIGHT (OR X0 (fetch (SELECTION X0) of SEL))) + (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of L1)) + 'TEXTURE + 'INVERT SHADE))) + (SETQ LL (OR L1 LINES)) + (AND LL (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) + + (* The line after the first, or the top line on the screen -- + if we didn't have a first line) + + (while LL until (OR (EQ LL LN) + (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LL) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + do (* Highlight every line between first + and last) + [COND + [(fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LL)) + (* This line is in hardcopy mode. + Scale the margin values) + (SETQ LEFT (\MICASTOPTS (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL))) + (SETQ RIGHT (\MICASTOPTS (fetch (LINEDESCRIPTOR LXLIM) of LL] + (T (SETQ LEFT (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL)) + (SETQ RIGHT (fetch (LINEDESCRIPTOR LXLIM) of LL] + (BITBLT NIL 0 0 DS LEFT (fetch (LINEDESCRIPTOR YBOT) of LL) + (IDIFFERENCE RIGHT LEFT) + (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LL)) + 'TEXTURE + 'INVERT SHADE) + (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) + (COND + ((AND LL (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LL) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + (* The final line is on-screen. + Hilight it, too.) + [SETQ LEFT (COND + ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LL)) + (\MICASTOPTS (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL))) + (T (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL] + (BITBLT NIL 0 0 DS LEFT (fetch (LINEDESCRIPTOR YBOT) of LN) + (IDIFFERENCE (OR XLIM (fetch (SELECTION XLIM) of SEL)) + LEFT) + (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LL)) + 'TEXTURE + 'INVERT SHADE))) (* Highlight the final line of the + selection) + ]) + +(\TEDIT.UPDATE.SHOWSEL + [LAMBDA (NSEL OSEL TSTFLG) (* ; "Edited 30-May-91 23:03 by jds") + (* Update the selection highlighting + to reflect the differences between + NSEL and OSEL) + (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of OSEL))) + (PROG ((SHADE (OR (fetch (SELECTION HOW) of OSEL) + BLACKSHADE)) + (SHADEHEIGHT (OR (fetch (SELECTION HOWHEIGHT) of OSEL) + 1)) + (EXCHFLG NIL) + TSEL LL) + (replace (SELECTION ONFLG) of NSEL with T) (* Make the new selection think that + we've really displayed all its new + aspects.) + [COND + ((fetch (SELECTION HASCARET) of OSEL) (* Turn off the caret, if need be) + (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) do (\EDIT.UPCARET CARET] + [COND + ((NEQ (fetch (SELECTION CH#) of NSEL) + (fetch (SELECTION CH#) of OSEL)) (* The new selection starts earlier; + add hilight at the front) + (COND + ((ILESSP (fetch (SELECTION CH#) of OSEL) + (fetch (SELECTION CH#) of NSEL)) + (* Actually, it starts later; + just exchange the selections) + (swap OSEL NSEL) + (SETQ EXCHFLG T))) + (for NEWL1 inside (fetch (SELECTION L1) of NSEL) as OLDL1 + inside (fetch (SELECTION L1) of OSEL) as LINES + inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as DS + inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES NEWL1 OLDL1 DS SHADEHEIGHT SHADE + (fetch (SELECTION X0) of NSEL) + (fetch (SELECTION X0) of OSEL] + (COND + (EXCHFLG (* Put the selections back as they + were.) + (swap OSEL NSEL) + (SETQ EXCHFLG NIL))) + (COND + ((ILESSP (fetch (SELECTION CHLIM) of NSEL) + (fetch (SELECTION CHLIM) of OSEL)) + + (* Arrange for NSEL to be the selection that ends later, so that one set of code + will do both earlier AND later cases.) + + (swap OSEL NSEL) + (SETQ EXCHFLG T))) + (for OLDLN in (fetch (SELECTION LN) of OSEL) as NEWLN + in (fetch (SELECTION LN) of NSEL) as LINES inside (fetch (TEXTOBJ LINES) + of TEXTOBJ) as OLDL1 + in (fetch (SELECTION L1) of OSEL) as DS inside (fetch (TEXTOBJ \WINDOW) + of TEXTOBJ) + do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES OLDLN NEWLN DS SHADEHEIGHT SHADE + (fetch (SELECTION XLIM) of OSEL) + (fetch (SELECTION XLIM) of NSEL))) + (COND + (EXCHFLG (* Put the selections back as they + were.) + (SETQ TSEL OSEL) + (SETQ OSEL NSEL) + (SETQ NSEL TSEL))) + (COND + ((fetch (SELECTION HASCARET) of NSEL) (* Now put the caret back up.) + (for L1 in (fetch (SELECTION L1) of NSEL) as LN in (fetch (SELECTION LN) + of NSEL) as DS + inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as CARET + inside (fetch (TEXTOBJ CARET) of TEXTOBJ) + do (COND + ((EQ (fetch (SELECTION POINT) of NSEL) + 'LEFT) (* Left end of the selection) + (AND L1 (\SETCARET (fetch (SELECTION X0) of NSEL) + (fetch (LINEDESCRIPTOR YBOT) of L1) + DS TEXTOBJ CARET))) + (LN (* Right end of the selection) + (\SETCARET (fetch (SELECTION XLIM) of NSEL) + (fetch (LINEDESCRIPTOR YBOT) of LN) + DS TEXTOBJ CARET]) + +(\TEDIT.SHOWSELS + [LAMBDA (TEXTOBJ HOW ON) (* ; "Edited 30-May-91 23:03 by jds") + (* Turns all the selections for a + given Textobj on or off) + (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) + (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) + (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) + (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) + do (AND (fetch (SELECTION SET) of SELN) + (\SHOWSEL SELN HOW ON]) + +(\TEDIT.REFRESH.SHOWSEL + [LAMBDA (TEXTOBJ NEWSEL OLDSEL OLDOP NEWOP EXTENDING) (* ; "Edited 30-May-91 23:03 by jds") + + (* * Update the screen hilighting to account for the changes that have taken + place between OLDSEL and NEWSEL.) + + (DECLARE (USEDFREE . GLOBALSEL)) + (PROG (NOSEL) + (COND + ((AND EXTENDING (EQ OLDOP NEWOP)) + + (* If we're extending a selection and the looks haven't changed, we can do it the + fast way, to prevent flicker.) + + (\TEDIT.UPDATE.SHOWSEL NEWSEL OLDSEL) + (\COPYSEL NEWSEL OLDSEL) + (replace (SELECTION ONFLG) of OLDSEL with T)) + (T + + (* Otherwise, we have to turn the old one off, change things, and turn the new + one on.) + + (\SHOWSEL OLDSEL NIL NIL) + (COND + ((NEQ OLDOP NEWOP) + + (* He changed his mind about copying, deleting, or whatever -- + change the kind of selection it is.) + + (SELECTQ NEWOP + ((NORMAL PENDINGDEL) + (SETQ GLOBALSEL TEDIT.SELECTION) + (SETQ NOSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) + (COPY (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION) + (SETQ NOSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) + (MOVE (SETQ GLOBALSEL TEDIT.MOVESELECTION) + (SETQ NOSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))) + (DELETE (SETQ GLOBALSEL TEDIT.DELETESELECTION) + (SETQ NOSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))) + (COPYLOOKS (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION) + (SETQ NOSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) + NIL) (* Remember the new operation type.) + (replace (SELECTION SET) of OLDSEL with NIL) + (* Turn off the old kind of selection, + so it doesn't reappear to haunt us.) + (AND (fetch (SELECTION SET) of NOSEL) + (\SHOWSEL NOSEL NIL NIL)) (* If there was a new-type selection + around, turn it off.) + (SETQ OLDSEL NOSEL) (* Now cut over to the new selection) + (\TEDIT.SET.SEL.LOOKS OLDSEL NEWOP) (* And set it up looking right.) + )) + (\COPYSEL NEWSEL OLDSEL) + (replace (SELECTION ONFLG) of OLDSEL with NIL) + (* Make sure we can turn the + highlighting on.) + (\SHOWSEL OLDSEL NIL T))) + (RETURN (OR NOSEL OLDSEL]) +) +(DEFINEQ + +(\COPYSEL + [LAMBDA (FROM TO) (* ; "Edited 31-May-91 12:27 by jds") + (* Copy a SELECTION record from FROM + to TO, without creating any new ones) + (replace (SELECTION Y0) of TO with (fetch (SELECTION Y0) of FROM)) + (replace (SELECTION X0) of TO with (fetch (SELECTION X0) of FROM)) + (replace (SELECTION DX) of TO with (fetch (SELECTION DX) of FROM)) + (replace (SELECTION CH#) of TO with (fetch (SELECTION CH#) of FROM)) + (replace (SELECTION XLIM) of TO with (fetch (SELECTION XLIM) of FROM)) + (replace (SELECTION CHLIM) of TO with (fetch (SELECTION CHLIM) of FROM)) + (replace (SELECTION DCH) of TO with (fetch (SELECTION DCH) of FROM)) + (replace (SELECTION L1) of TO with (COPY (fetch (SELECTION L1) of FROM))) + (replace (SELECTION LN) of TO with (COPY (fetch (SELECTION LN) of FROM))) + (replace (SELECTION YLIM) of TO with (fetch (SELECTION YLIM) of FROM)) + (replace (SELECTION POINT) of TO with (fetch (SELECTION POINT) of FROM)) + (replace (SELECTION SET) of TO with (fetch (SELECTION SET) of FROM)) + (replace (SELECTION \TEXTOBJ) of TO with (fetch (SELECTION \TEXTOBJ) of FROM)) + (replace (SELECTION SELKIND) of TO with (fetch (SELECTION SELKIND) of FROM)) + (replace (SELECTION HOW) of TO with (fetch (SELECTION HOW) of FROM)) + (replace (SELECTION HOWHEIGHT) of TO with (fetch (SELECTION HOWHEIGHT) of FROM)) + (replace (SELECTION HASCARET) of TO with (fetch (SELECTION HASCARET) of FROM)) + (replace (SELECTION SELOBJ) of TO with (fetch (SELECTION SELOBJ) of FROM)) + (replace (SELECTION ONFLG) of TO with (fetch (SELECTION ONFLG) of FROM]) + +(\TEDIT.SEL.CHANGED? + [LAMBDA (NEWSEL OLDSEL OLDSELOP NEWSELOP) (* ; "Edited 30-May-91 23:01 by jds") + + (* Decide whether there has been an interesting change in the selection, so we + can decide whether to refresh its hilighting on the screen.) + + (AND NEWSEL (fetch (SELECTION SET) of NEWSEL) + (NOT (AND (fetch (SELECTION SET) of OLDSEL) + (EQ (fetch (SELECTION SET) of OLDSEL) + (fetch (SELECTION SET) of NEWSEL)) + (EQUAL (fetch (SELECTION CH#) of NEWSEL) + (fetch (SELECTION CH#) of OLDSEL)) + (EQUAL (fetch (SELECTION CHLIM) of NEWSEL) + (fetch (SELECTION CHLIM) of OLDSEL)) + (EQ (fetch (SELECTION \TEXTOBJ) of NEWSEL) + (fetch (SELECTION \TEXTOBJ) of OLDSEL)) + (IEQP (fetch (SELECTION DX) of NEWSEL) + (fetch (SELECTION DX) of OLDSEL)) + (EQ (fetch (SELECTION POINT) of NEWSEL) + (fetch (SELECTION POINT) of OLDSEL)) + (EQ (fetch (SELECTION HOW) of NEWSEL) + (fetch (SELECTION HOW) of OLDSEL)) + (EQ (fetch (SELECTION HOWHEIGHT) of NEWSEL) + (fetch (SELECTION HOWHEIGHT) of OLDSEL)) + (EQ OLDSELOP NEWSELOP]) +) + + + +(* ;; "User entries to the selection code") + +(DEFINEQ + +(TEDIT.GETPOINT + [LAMBDA (STREAM SEL) (* ; "Edited 30-May-91 23:03 by jds") + + (* Given a selection, tell the CH# that type-in would be inserted in front of. + IF SEL is given, use it to decide. Otherwise, use STREAM's current selection.) + + (PROG [(TSEL (OR SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ STREAM] + (RETURN (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of TSEL) + (LEFT (fetch (SELECTION CH#) of TSEL)) + (RIGHT (fetch (SELECTION CHLIM) of TSEL)) + (SHOULDNT "Selection's POINT is neither RIGHT nor LEFT."]) + +(TEDIT.GETSEL + [LAMBDA (STREAM) (* ; "Edited 30-May-91 23:03 by jds") + (create SELECTION using (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) + +(TEDIT.MAKESEL + [LAMBDA (STREAM CH# LEN POINT) (* ; "Edited 30-May-91 23:03 by jds") + (PROG ((SEL (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) + (TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) + (\SHOWSEL SEL NIL NIL) + (replace (SELECTION CH#) of SEL with CH#) + (replace (SELECTION CHLIM) of SEL with (IMAX CH# (IPLUS CH# LEN))) + (replace (SELECTION DCH) of SEL with LEN) + (replace (SELECTION POINT) of SEL with (OR POINT 'LEFT)) + (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) + (replace (SELECTION SET) of SEL with T) + (AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + (\FIXSEL SEL TEXTOBJ)) + (\SHOWSEL SEL NIL T]) + +(TEDIT.SCANSEL + [LAMBDA (STREAM) (* ; "Edited 30-May-91 23:03 by jds") + + (* Set up to read the selected text; return the sel's length or NIL if nothing + selected.) + + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + SEL) + (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + (COND + ((fetch (SELECTION SET) of SEL) + (\SETUPGETCH (fetch (SELECTION CH#) of SEL) + TEXTOBJ) + (RETURN (fetch (SELECTION DCH) of SEL))) + (T (RETURN NIL]) + +(TEDIT.SET.SEL.LOOKS + [LAMBDA (SEL OPERATION) (* ; "Edited 30-May-91 23:01 by jds") + (* Set what the selection should be + displayed like, given what it's for + (NORMAL, COPY, MOVE, etc.)) + (PROG ((WASON (fetch (SELECTION ONFLG) of SEL))) + (\SHOWSEL SEL NIL NIL) + (SELECTQ OPERATION + (NORMAL (* Regular selection) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 1) + (replace (SELECTION HASCARET) of SEL with T)) + (COPY (* Copy source) + (replace (SELECTION HOW) of SEL with COPYSELSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 1) + (replace (SELECTION HASCARET) of SEL with NIL)) + (COPYLOOKS (* copylooks source) + (replace (SELECTION HOW) of SEL with COPYLOOKSSELSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 2) + (replace (SELECTION HASCARET) of SEL with NIL)) + (MOVE (* Copy source) + (replace (SELECTION HOW) of SEL with EDITMOVESHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with NIL)) + (DELETE (* To be deleted instantly) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with NIL) + NIL) + (PENDINGDEL (* Delete at next type-in) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with T) + NIL) + (INVERTED (* For people who really want to see + what's selected.) + (replace (SELECTION HOW) of SEL with BLACKSHADE) + (replace (SELECTION HOWHEIGHT) of SEL with 16384) + (replace (SELECTION HASCARET) of SEL with T) + NIL) + NIL) + (\SHOWSEL SEL NIL WASON]) + +(TEDIT.SETSEL + [LAMBDA (STREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION) + (* ; "Edited 30-May-91 23:05 by jds") + + (* ;; "Given a text stream or textobj, and a piece of text to select, set the internal selection, and return it.") + (* ; "Make sure we got a stream") + (PROG ((TEXTOBJ (TEXTOBJ STREAM)) + SEL TEXTLEN) + (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (\SHOWSEL SEL NIL NIL) (* ; "First turn the old sel off.") + [COND + ((type? SELECTION CH#) (* ; + "He gave use a selection; just plug it in") + (\COPYSEL CH# SEL) + (replace (SELECTION ONFLG) of SEL with NIL) (* ; + "And make sure it can be turned on.") + ) + (T (* ; "He fed us numbers; use them") + (replace (SELECTION CH#) of SEL with (IMIN (IMAX 1 CH#) + (ADD1 TEXTLEN))) + (* ; "Starting character") + [replace (SELECTION CHLIM) of SEL with (IMAX 1 CH# (IMIN (IPLUS CH# LEN) + (ADD1 TEXTLEN] + (* ; "Last selected character") + [replace (SELECTION DCH) of SEL with (IMIN LEN TEXTLEN (IDIFFERENCE + (fetch (SELECTION CHLIM) + of SEL) + (fetch (SELECTION CH#) + of SEL] + (replace (SELECTION POINT) of SEL with (OR (AND (IGREATERP CH# TEXTLEN) + 'LEFT) + POINT + 'LEFT)) + (* ; "Which side the caret should go on") + (COND + ((OR (IGREATERP (fetch (SELECTION CH#) of SEL) + TEXTLEN) + (NEQ 1 LEN)) + (replace (SELECTION SELOBJ) of SEL with NIL)) + (T (replace (SELECTION SELOBJ) of SEL with (fetch (PIECE POBJ) + of (\CHTOPC (fetch (SELECTION CH#) + of SEL) + (fetch (TEXTOBJ PCTB) + of TEXTOBJ] + (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) (* ; + "Link it back to the associated textobj") + [COND + (PENDINGDELFLG (* ; + "This selection is to be a pending-deletion sel.") + (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) + (* ; + "Warn TEdit that there's a deletion pending") + (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'PENDINGDEL)) + (* ; + "And make the selection look right.") + ) + (T (* ; + "This selection is to be a pending-deletion sel.") + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) + (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL] + (replace (SELECTION SET) of SEL with T) (* ; + "Mark the selection as valid for others to use") + [COND + ((NOT LEAVECARETLOOKS) (* ; + "And set the insertion looks to follow.") + (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL] + (\FIXSEL SEL TEXTOBJ) (* ; + "Update the selection's screen location") + (\SHOWSEL SEL NIL T) (* ; "Highlight it on the screen") + (RETURN SEL]) + +(TEDIT.SHOWSEL + [LAMBDA (STREAM ONFLG SEL) (* ; "Edited 30-May-91 23:04 by jds") + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) + (COND + (SEL (* He's giving us a selection to + highlight. Connect it to this textobj.) + (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) + (\FIXSEL SEL TEXTOBJ))) + (\SHOWSEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + NIL ONFLG]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (4062 18300 (TEDIT.SEL.AS.STRING 4072 . 5538) (TEDIT.SELECTED.PIECES 5540 . 8917) ( +\TEDIT.FIND.FIRST.LINE 8919 . 12548) (\TEDIT.FIND.LAST.LINE 12550 . 13830) ( +\TEDIT.FIND.OVERLAPPING.LINE 13832 . 14246) (\TEDIT.FIND.PROTECTED.END 14248 . 16140) ( +\TEDIT.FIND.PROTECTED.START 16142 . 17741) (\TEDIT.WORD.BOUND 17743 . 18298)) (18344 18823 ( +\CREATE.TEDIT.SELECTION 18354 . 18424) (\CREATE.TEDIT.SHIFTEDSELECTION 18426 . 18529) ( +\CREATE.TEDIT.MOVESELECTION 18531 . 18660) (\CREATE.TEDIT.DELETESELECTION 18662 . 18821)) (19575 77628 + (TEDIT.EXTEND.SEL 19585 . 31241) (TEDIT.SELECT 31243 . 35576) (TEDIT.SCAN.LINE 35578 . 53641) ( +TEDIT.SELECT.LINE.SCANNER 53643 . 71700) (\TEDIT.SELECT.CHARACTER 71702 . 77626)) (77629 104700 ( +\FIXSEL 77639 . 99627) (\TEDIT.FIXDELSEL 99629 . 102654) (\TEDIT.FIXINSSEL 102656 . 103984) ( +\TEDIT.FIXSELS 103986 . 104698)) (104701 108153 (TEDIT.RESET.EXTEND.PENDING.DELETE 104711 . 105286) ( +\TEDIT.SET.SEL.LOOKS 105288 . 108151)) (108154 129235 (\SHOWSEL 108164 . 113480) (\SHOWSEL.HILIGHT +113482 . 119629) (\TEDIT.UPDATE.SHOWSEL 119631 . 125313) (\TEDIT.SHOWSELS 125315 . 126016) ( +\TEDIT.REFRESH.SHOWSEL 126018 . 129233)) (129236 132971 (\COPYSEL 129246 . 131413) ( +\TEDIT.SEL.CHANGED? 131415 . 132969)) (133024 144800 (TEDIT.GETPOINT 133034 . 133743) (TEDIT.GETSEL +133745 . 133985) (TEDIT.MAKESEL 133987 . 134884) (TEDIT.SCANSEL 134886 . 135534) (TEDIT.SET.SEL.LOOKS +135536 . 138691) (TEDIT.SETSEL 138693 . 144152) (TEDIT.SHOWSEL 144154 . 144798))))) +STOP diff --git a/library/TEDITSELECTION.LCOM b/library/tedit/TEDIT-SELECTION.LCOM similarity index 65% rename from library/TEDITSELECTION.LCOM rename to library/tedit/TEDIT-SELECTION.LCOM index 4f1f1c071c5c7cba6fb2b8c516b47d9043d25f5c..0a41f917e3d8843e54c1343416a5566702b4c871 100644 GIT binary patch delta 1159 zcmb_bOH7kN5Do=O+(-cv3E{bxpsm{9wzN=wN`bTmiWHfKudP5G}M6 ziqT{bKGLWhNHif5g+yb7#6*LJaMXhbZ$1wudhx);Sz1wyp7ip4GrO}h-^}jbxW;>Y zm3O&*3?WgS!Kl|-^tD#K4hv-pNyC6!BA3eLSXRa=%UOj&h(*E=ni-j1S z)p18g)dT%bf4`>3-s`q|HEv&r-L3IB9d74vDWlX3`usgEZZPo#f|ZsFal7BSRo*$&>+dgNvDX*qhV0k{a_X9m zM*ORAhGB%*VTV$G%qf!##fi4Z{?@mWRm%TkpFi6Kp$e6}6eHGb(c8uhre;o}gW3N! zdKoKKu~OMTN$@%cw@-UZg5WV+$8c7Qp|KvbIu%-EdBLP4w78u7g$K02 zpQqHig9nS`G&%>)8)T;uH9HSd@}!@jTdRVbfL$3ez?95efODAywkxt?2J-cbPNbf2obD)^U2hQZsq!$OzgCiJE>nobc=I1| zSY$NS>fnG`{3G&SPzf2|2OWTY+4-be56T;6f;y z90-ZPS`VqnOehyDNoX(iz=}rYX;`!$S7Jn}!**Di4VM5`hl|Oluo|p=leFT@WDDSj zNfV$dVga-l=90O{VX!_&=w8FrDZtxPt$?Z1Ed}wf!O=bvE$FnyMEli55Xn!$Rxu*6 vX(=37pDs^}PX;Fh3;A)MtWV~WwTVok4rM`LC`whYM5(fkXnrbcG#Jr$G~Hke delta 1290 zcmb7EUu;uV7|+TavUoQ%0hTegkITQ-*zVrm-mUj;t6Xk7R(88y?(GK4bg^6OXjXcg z+YZ(#jCE}7{t!*hizY-!d=W4{h(=?kVxmDLCdS0X_<)JgH+;Z1^~LYBFemWh%kTGn z=X`(9Ip0}(!|~Rej@J**GS1$x7E+Cn5(@=^<^AqRyx{h7ydOA8=KZoyV8O|bTPL%r zbTR=}23TNT37Y+9x(CgWVFvmYT~h`ET2xiEKqM5@Lc@Yb3}|6fSEEJv*UK*ktWbx>=b-FjGu^SCXzW|^42~XoI{FX!hbtfqY={u zmE*p@6;!oR7i8_^sgyO9tJIIatXIOuY`2851=%Ocytsbi|Eo5^#gHDyjvD6rprcrW z^y8*`4y14D-lcSUivt(QO#N9@{;ZEvi;<_Eqf};w>DDg|mk^7M7ZKaGUPipJmEd;l z>5KJ9_jZ0 zLrfg|%)vOx>P*x1?&CjDmuE(GH=)h%nkp6`ODBWG~lWS-`+So>ZT{ws<*H*ln!TBt7 z0YgR?c>slX{-G%PqAK!)LX&%%T17%bj)AEz+KC!h&}{Q16zS zH>zKhwvo?QTG8ds3N3KwY72fm`d~~qqWZ&g0%}wrHo}MdV)*YIu})-g;K$ E1ELFjfdBvi diff --git a/library/TEXTOFD b/library/tedit/TEDIT-TEXTOFD similarity index 70% rename from library/TEXTOFD rename to library/tedit/TEDIT-TEXTOFD index a55e7a95..bf7082ab 100644 --- a/library/TEXTOFD +++ b/library/tedit/TEDIT-TEXTOFD @@ -1,25 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 3-Jul-2022 00:35:48"  -{DSK}kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;22 183404 +(FILECREATED "14-Jul-2022 17:00:29"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-TEXTOFD.;1 174498 - :CHANGES-TO (FNS \TEXTINIT) - - :PREVIOUS-DATE " 2-Jul-2022 23:48:56" -{DSK}kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;21) + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-TEXTOFD.;2) -(* ; " -Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-TEXTOFDCOMS) -(PRETTYCOMPRINT TEXTOFDCOMS) - -(RPAQQ TEXTOFDCOMS - [(FILES TEDITDCL) +(RPAQQ TEDIT-TEXTOFDCOMS + [(FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (FNS COPYTEXTSTREAM OPENTEXTSTREAM REOPENTEXTSTREAM TEDIT.STREAMCHANGEDP TEXTSTREAMP TXTFILE \DELETECH \SETUPGETCH \TEDIT.REOPEN.STREAM \TEDIT.COPYTEXTSTREAM.PIECEMAPFN \TEXTINIT \TEXTMARK \TEXTTTYBOUT) @@ -51,7 +45,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (NLAML) (LAMA TEXTPROP]) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -63,13 +57,13 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DEFINEQ (COPYTEXTSTREAM - [LAMBDA (ORIGINAL CROSSCOPY) (* ; - "Edited 24-Apr-95 12:02 by sybalsky:mv:envos") + [LAMBDA (ORIGINAL CROSSCOPY) (* ; + "Edited 24-Apr-95 12:02 by sybalsky:mv:envos") (* ;; "Given a stream, textobj or window, returns a new textstream with the same contents. If CROSSCOPY then strings will really be allocated providing copies of the text else the fileptrs still will be aliases as in the rest of TEDIT.") @@ -77,34 +71,28 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor TSEL PCTB PCLST NEWSTREAM NEWTEXTOBJ) (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (SETQ TSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (fetch (TEXTOBJ EDITPROPS) - of TEXTOBJ))) + (SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ))) (* ; - "First create an empty textstream into which the pieces can be hammered") + "First create an empty textstream into which the pieces can be hammered") (SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM)) - (replace (SELECTION CH#) of TSEL with 1) - (* ; - "Set up to select the whole source text") - (replace (SELECTION CHLIM) of TSEL with (ADD1 (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ))) - (replace (SELECTION DCH) of TSEL with (fetch (TEXTOBJ TEXTLEN) of - TEXTOBJ)) + (replace (SELECTION CH#) of TSEL with 1) (* ; + "Set up to select the whole source text") + (replace (SELECTION CHLIM) of TSEL with (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (replace (SELECTION DCH) of TSEL with (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (SETQ PCLST (TEDIT.SELECTED.PIECES TEXTOBJ TSEL CROSSCOPY (FUNCTION \TEDIT.COPYTEXTSTREAM.PIECEMAPFN ) TEXTOBJ NEWTEXTOBJ)) (* ; - "now get a list of copies of the pieces to be inserted into the empty textstream") + "now get a list of copies of the pieces to be inserted into the empty textstream") (\TEDIT.INSERT.PIECES NEWTEXTOBJ 1 PCLST (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) NIL NIL CROSSCOPY) (* ; - "Put the pieces into the copy textstream") - (replace (TEXTOBJ TEXTLEN) of NEWTEXTOBJ with (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ)) + "Put the pieces into the copy textstream") + (replace (TEXTOBJ TEXTLEN) of NEWTEXTOBJ with (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; - "The copy is the same length as the original") - (replace (TEXTOBJ MENUFLG) of NEWTEXTOBJ with (fetch (TEXTOBJ MENUFLG) - of TEXTOBJ)) + "The copy is the same length as the original") + (replace (TEXTOBJ MENUFLG) of NEWTEXTOBJ with (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) (* ; - "And if the original is a menu, so's the copy") + "And if the original is a menu, so's the copy") (RETURN NEWSTREAM]) (OPENTEXTSTREAM @@ -318,7 +306,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (RETURN TEXTSTREAM]) (REOPENTEXTSTREAM - [LAMBDA (STREAM) (* ; "Edited 31-May-91 14:18 by jds") + [LAMBDA (STREAM) (* ; "Edited 31-May-91 14:18 by jds") (replace (STREAM ACCESS) of STREAM with 'BOTH) (replace (STREAM BINABLE) of STREAM with T) (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \TEXTBIN)) @@ -326,34 +314,32 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor STREAM]) (TEDIT.STREAMCHANGEDP - [LAMBDA (STREAM RESET?) (* ; "Edited 31-May-91 13:57 by jds") + [LAMBDA (STREAM RESET?) (* ; "Edited 31-May-91 13:57 by jds") (PROG1 (fetch (TEXTOBJ \DIRTY) of (TEXTOBJ STREAM)) (COND (RESET? (replace (TEXTOBJ \DIRTY) of (TEXTOBJ STREAM) with NIL))))]) (TEXTSTREAMP - (LAMBDA (STREAM) (* jds " 3-Apr-84 14:34") - - (* Returns the stream if it is a text stream, else NIL) - + [LAMBDA (STREAM) (* jds " 3-Apr-84 14:34") + (* Returns the stream if it is a text + stream, else NIL) (AND (STREAMP STREAM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - STREAM))) + STREAM]) (TXTFILE - [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 13:58 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 13:58 by jds") (* This function is for compiled - access to the TXTFILE field in - RESETSAVE expressions) + access to the TXTFILE field in + RESETSAVE expressions) (fetch (TEXTOBJ TXTFILE) of TEXTOBJ]) (\DELETECH - [LAMBDA (CH# CHLIM LEN TEXTOBJ DONTDIRTY) (* ; "Edited 29-Jan-99 17:28 by kaplan") + [LAMBDA (CH# CHLIM LEN TEXTOBJ DONTDIRTY) (* ; "Edited 29-Jan-99 17:28 by kaplan") (* ;; "Delete the indicated characters from the text object represented by TEXTOBJ") - (* ;; - "If DONTDIRTY is non-NIL, then don't notice this change for purposes of UNDO or dirtiness.") + (* ;; "If DONTDIRTY is non-NIL, then don't notice this change for purposes of UNDO or dirtiness.") (COND ((OR DONTDIRTY (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) @@ -371,24 +357,21 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ((AND (fetch (TEXTOBJ \INSERTPCVALID) of TEXTOBJ) (IEQP CHLIM (fetch (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ)) (IGEQ CH# \INFIRSTCH)) (* ; - "The deletion is from the end of the most recent type-in. Just adjust the buffer string.") - (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with - (replace (PIECE PLEN) - of (fetch (TEXTOBJ - \INSERTPC) - of TEXTOBJ) - with (IDIFFERENCE CH# - \INFIRSTCH))) - (* ; "Cut back the length") - (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ - with (IPLUS (fetch (TEXTOBJ \INSERTLEN) of TEXTOBJ) - \INFIRSTCH)) (* ; - "and ch# of next insertion (i.e., 1 past the top CH# in the insert piece.)") + "The deletion is from the end of the most recent type-in. Just adjust the buffer string.") + (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with (replace (PIECE PLEN) + of (fetch (TEXTOBJ \INSERTPC) + of TEXTOBJ) + with (IDIFFERENCE CH# \INFIRSTCH)) + ) (* ; "Cut back the length") + (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ \INSERTLEN) + of TEXTOBJ) + \INFIRSTCH)) + (* ; + "and ch# of next insertion (i.e., 1 past the top CH# in the insert piece.)") (replace THLEN of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - with (IDIFFERENCE (fetch THLEN of (fetch (TEXTOBJ TXTHISTORY) - of TEXTOBJ)) - LEN)) (* ; - "Reduce the length of the insertion in the history list, too.") + with (IDIFFERENCE (fetch THLEN of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) + LEN)) (* ; + "Reduce the length of the insertion in the history list, too.") (COND ((ZEROP (fetch (TEXTOBJ \INSERTLEN) of TEXTOBJ)) @@ -396,48 +379,47 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (\DELETEPIECE (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) PCTB) (* UPDATEPCNODES (fetch - (TEXTOBJ \INSERTPC) of TEXTOBJ) - (IMINUS LEN) PCTB) + (TEXTOBJ \INSERTPC) of TEXTOBJ) + (IMINUS LEN) PCTB) (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Force the next insertion to be in a fresh piece.") + "Force the next insertion to be in a fresh piece.") ) (T (UPDATEPCNODES (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) (IMINUS LEN) PCTB))) (* ; "Adjust CH#s in the Piece Table.") ) ((ILEQ CH# TEXTLEN) (* ; - "General case of deletion: Remove pieces as needed to do it.") + "General case of deletion: Remove pieces as needed to do it.") (PROG (PCN PC1 PCNON PCSOUT (HIPC NIL) HI LO) - (SETQ PC1 (\CHTOPC CH# PCTB T)) (* ; - "Piece # of piece containing start of deleted text") + (SETQ PC1 (\CHTOPC CH# PCTB T)) (* ; + "Piece # of piece containing start of deleted text") (COND ((IGREATERP CH# START-OF-PIECE) (* ; - "Split the piece, so the deleted text now starts on a piece boundary") + "Split the piece, so the deleted text now starts on a piece boundary") (\SPLITPIECE PC1 (- CH# START-OF-PIECE) TEXTOBJ)) (T (SETQ PC1 (fetch (PIECE PREVPIECE) of PC1)) (* ; - "PC1 _ piece before the first piee to be deleted.-") + "PC1 _ piece before the first piee to be deleted.-") )) (COND ((ILEQ CHLIM TEXTLEN) (* ; - "Find the peice that contains the END of the deleted section") + "Find the peice that contains the END of the deleted section") (SETQ PCN (\CHTOPC CHLIM PCTB T))) (T (* ;; - "Deleting past end, so n+1-th piece is the symbol LASTPIECE, which starts 1 past end of all text.") + "Deleting past end, so n+1-th piece is the symbol LASTPIECE, which starts 1 past end of all text.") (SETQ START-OF-PIECE (ADD1 TEXTLEN)) (SETQ PCN 'LASTPIECE) (SETQ HIPC NIL))) [COND - ((ATOM PCN) (* ; - "Deleting before the end of text.") + ((ATOM PCN) (* ; "Deleting before the end of text.") ) (T (* ; - "Deleting in front of a real piece of text") + "Deleting in front of a real piece of text") (COND ([AND (IGREATERP CHLIM START-OF-PIECE) (ILESSP CHLIM (IPLUS START-OF-PIECE (fetch (PIECE PLEN) @@ -446,22 +428,20 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor TEXTOBJ PCNON)) (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ))) (T (SETQ HIPC PCN] (* ; - "if not on a piece bound, split the last piece.") + "if not on a piece bound, split the last piece.") (AND PC1 (EQ PC1 HIPC) (HELP "circular")) [SETQ PCLST (bind NPC [PC _ (COND - (PC1 (fetch (PIECE NEXTPIECE) - of PC1)) - (T - (* ;; + (PC1 (fetch (PIECE NEXTPIECE) of PC1)) + (T + (* ;;  "(\EDITELT PCTB (ADD1 \FirstPieceOffset))") - (\GETBASEPTR (\FIRSTNODE PCTB) - 0] + (\GETBASEPTR (\FIRSTNODE PCTB) + 0] while (AND PC (NEQ PC HIPC)) collect (PROG1 PC - (SETQ PC (fetch (PIECE NEXTPIECE) - of PC)))] + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)))] [OR DONTDIRTY (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ 'Delete @@ -469,25 +449,20 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor THCH# _ CH# THFIRSTPIECE _ (CAR PCLST] (* ; - "Add this event to the history list") + "Add this event to the history list") (* ;; "Actually delete the pieces:") (for PC in PCLST do [AND (fetch (PIECE POBJ) of PC) - (IMAGEOBJPROP (fetch (PIECE POBJ) - of PC) - 'WHENDELETEDFN) - (APPLY* (IMAGEOBJPROP (fetch - (PIECE POBJ) - of PC) - 'WHENDELETEDFN) - (fetch (PIECE POBJ) - of PC) - (CAR (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ] + (IMAGEOBJPROP (fetch (PIECE POBJ) of PC) + 'WHENDELETEDFN) + (APPLY* (IMAGEOBJPROP (fetch (PIECE POBJ) + of PC) + 'WHENDELETEDFN) + (fetch (PIECE POBJ) of PC) + (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ] (* \DELETEPIECE PC PCTB) - (\DELETETREE PC (fetch (PIECE PTREENODE) - of PC))) + (\DELETETREE PC (fetch (PIECE PTREENODE) of PC))) (* ;; "Link around the deleted pieces:") @@ -504,16 +479,16 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (replace (PIECE PREVPIECE) of (CAR PCLST) with NIL)) (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Force the next insertion to be in a fresh piece.") + "Force the next insertion to be in a fresh piece.") (\TEDIT.DIFFUSE.PARALOOKS PC1 HIPC) (* ; - "PROPOGATE PARALOOKS THRU THE DELETION") + "PROPOGATE PARALOOKS THRU THE DELETION") ] (freplace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IDIFFERENCE TEXTLEN LEN)) (* ; "Update the file's length") (OR DONTDIRTY (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T]) (\SETUPGETCH - [LAMBDA (CH# TEXTOBJ) (* ; "Edited 14-Apr-93 17:14 by jds") + [LAMBDA (CH# TEXTOBJ) (* ; "Edited 14-Apr-93 17:14 by jds") (* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#") @@ -527,12 +502,12 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) [COND [(LISTP CH#) (* ; - "If CH# is a piece-offset pair, make use of it.") + "If CH# is a piece-offset pair, make use of it.") (SETQ PC (fetch (EDITMARK PC) of CH#)) (SETQ CHOFFSET (fetch (EDITMARK PCOFF) of CH#)) (COND ((ATOM PC) (* ; - "This SETUPGETCH is to the final pseudo-piece!") + "This SETUPGETCH is to the final pseudo-piece!") (freplace (TEXTSTREAM PIECE) of STREAM with PC) (freplace (STREAM COFFSET) of STREAM with 0) (freplace (STREAM CPAGE) of STREAM with 0) @@ -556,42 +531,37 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor CHOFFSET)) (freplace (TEXTSTREAM PCOFFSET) of STREAM with CHOFFSET) (COND - ((SETQ PS (ffetch (PIECE PSTR) of PC)) (* ; "This piece resides in a STRING.") + ((SETQ PS (ffetch (PIECE PSTR) of PC)) (* ; "This piece resides in a STRING.") (\TEDIT.TEXTBIN.STRINGSETUP CHOFFSET CHARSLEFT STREAM PS)) - ((SETQ PF (ffetch (PIECE PFILE) of PC)) (* ; "This piece resides on a FILE") + ((SETQ PF (ffetch (PIECE PFILE) of PC)) (* ; "This piece resides on a FILE") (\TEDIT.TEXTBIN.FILESETUP PC CHOFFSET CHARSLEFT STREAM PF (fetch (PIECE PFATP) - of PC))) - [(SETQ PF (ffetch (PIECE POBJ) of PC)) (* ; - "This piece points to an object. set up so \TextBin will be called, and will return it.") + of PC))) + [(SETQ PF (ffetch (PIECE POBJ) of PC)) (* ; + "This piece points to an object. set up so \TextBin will be called, and will return it.") (COND ((SETQ SUBSTREAM (IMAGEOBJPROP PF 'SUBSTREAM)) (* ; - "There is a stream below this one! Reflect things upward.") + "There is a stream below this one! Reflect things upward.") (* ; - "This is a simple object. Just set things up so it gets read.") + "This is a simple object. Just set things up so it gets read.") (\SETUPGETCH (ADD1 CHOFFSET) (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM)) (replace (STREAM BINABLE) of STREAM with NIL) (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) (freplace (STREAM COFFSET) of STREAM with CHOFFSET) - (freplace (STREAM CBUFSIZE) 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 CHOFFSET) (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with - (fetch (TEXTSTREAM - + (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with (fetch (TEXTSTREAM CURRENTPARALOOKS - ) of - SUBSTREAM)) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (fetch - (TEXTSTREAM - CURRENTLOOKS) - of SUBSTREAM)) + ) of SUBSTREAM) + ) + (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (fetch (TEXTSTREAM CURRENTLOOKS) + of SUBSTREAM)) (RETURN)) (T (* ; - "This is a simple object. Just set things up so it gets read.") + "This is a simple object. Just set things up so it gets read.") (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 1) (freplace (STREAM COFFSET) of STREAM with 0) (freplace (STREAM CBUFSIZE) of STREAM with 1) @@ -600,28 +570,27 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) (replace (STREAM BINABLE) of STREAM with NIL) (* ; - "Force the next BIN to go thru our code.") + "Force the next BIN to go thru our code.") ] (T (ERROR "Piece is neither a file nor a string??" PC))) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with - (\TEDIT.APPLY.PARASTYLES - (fetch (PIECE PPARALOOKS) - of PC) - PC TEXTOBJ)) + (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with (\TEDIT.APPLY.PARASTYLES + (fetch (PIECE PPARALOOKS) + of PC) + PC TEXTOBJ)) (* ; - "Set the character looks and font caches.") - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (\TEDIT.APPLY.STYLES - (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ]) + "Set the character looks and font caches.") + (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (\TEDIT.APPLY.STYLES (ffetch (PIECE + PLOOKS) + of PC) + PC TEXTOBJ]) (\TEDIT.REOPEN.STREAM - [LAMBDA (TEXTSTREAM PIECESTREAM) (* ; "Edited 11-Jun-99 15:12 by rmk:") - (* ; "Edited 11-Jun-99 15:12 by rmk:") - (* ; "Edited 11-Jun-99 14:24 by rmk:") - (* ; "Edited 15-Apr-93 15:53 by jds") + [LAMBDA (TEXTSTREAM PIECESTREAM) (* ; "Edited 11-Jun-99 15:12 by rmk:") + (* ; "Edited 11-Jun-99 15:12 by rmk:") + (* ; "Edited 11-Jun-99 14:24 by rmk:") + (* ; "Edited 15-Apr-93 15:53 by jds") - (* ;; "Re-open the backing file stream, and propogate the change thru the entire piece table. Also, if TXTFILE is set to the closed stream, fill it in as well.") + (* ;; "Re-open the backing file stream, and propogate the change thru the entire piece table. Also, if TXTFILE is set to the closed stream, fill it in as well.") (LET* ([NEWSTREAM (OPENSTREAM PIECESTREAM 'INPUT NIL '((TYPE TEXT] (TEXTOBJ (TEXTOBJ TEXTSTREAM)) @@ -630,37 +599,37 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) 0)) - (* ;; "Run thru the pieces, correcting any that used this stream to use the new one:") + (* ;; "Run thru the pieces, correcting any that used this stream to use the new one:") (while PC do (COND - ((EQ (fetch (PIECE PFILE) of PC) - PIECESTREAM) - (replace (PIECE PFILE) of PC with NEWSTREAM))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + ((EQ (fetch (PIECE PFILE) of PC) + PIECESTREAM) + (replace (PIECE PFILE) of PC with NEWSTREAM))) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (* ;; "Check the TXTFILE, and if it uses the closed stream, fix it as well:") + (* ;; "Check the TXTFILE, and if it uses the closed stream, fix it as well:") (COND ((EQ (fetch (TEXTOBJ TXTFILE) of TEXTOBJ) - PIECESTREAM) (* ; - "Yup, it was the old, closed stream. Fix it.") + PIECESTREAM) (* ; + "Yup, it was the old, closed stream. Fix it.") (replace (TEXTOBJ TXTFILE) of TEXTOBJ with NEWSTREAM))) - (* ;; "Return the new value for the stream:") + (* ;; "Return the new value for the stream:") NEWSTREAM]) (\TEDIT.COPYTEXTSTREAM.PIECEMAPFN - [LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* ; "Edited 31-May-91 14:00 by jds") + [LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* ; "Edited 31-May-91 14:00 by jds") (* Called by COPYTEXTSTREAM via - TEDIT.SELECTED.PIECES, to do the - copy-operation processing on the - candidate pieces.) + TEDIT.SELECTED.PIECES, to do the + copy-operation processing on the + candidate pieces.) (PROG (OBJ NEWOBJ COPYFN) - (SETQ PC (create PIECE using PC PNEW _ T)) (* No matter what, we need a fresh - copy.) + (SETQ PC (create PIECE using PC PNEW _ T)) (* No matter what, we need a fresh + copy.) [COND - ((fetch (PIECE POBJ) of PC) (* This piece describes an object) + ((fetch (PIECE POBJ) of PC) (* This piece describes an object) (SETQ OBJ (fetch (PIECE POBJ) of PC)) [COND [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN)) @@ -668,18 +637,18 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (fetch (TEXTOBJ STREAMHINT) of TOOBJ))) (COND ((EQ NEWOBJ 'DON'T) (* He said not to copy this piece -- - abort the whole copy.) + abort the whole copy.) (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T) (RETFROM 'TEDIT.COPY)) (NEWOBJ (replace (PIECE POBJ) of PC with NEWOBJ)) (T (replace (PIECE POBJ) of PC with (COPYALL OBJ] - (OBJ (* No copy fn; just strike off a - copy of our own) + (OBJ (* No copy fn; just strike off a copy + of our own) (replace (PIECE POBJ) of PC with (COPYALL OBJ] (COND ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) - (* If there's an eventfn for - copying, use it.) + (* If there's an eventfn for copying, + use it.) (APPLY* COPYFN OBJ (CAR (fetch (TEXTOBJ \WINDOW) of TOOBJ)) (fetch (TEXTOBJ STREAMHINT) of FROMOBJ) (fetch (TEXTOBJ STREAMHINT) of TOOBJ] @@ -807,7 +776,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION]) (\TEXTMARK - [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 14:18 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 14:18 by jds") (PROG ((STREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) (RETURN (CONS (ffetch (TEXTSTREAM PIECE) of STREAM) (IDIFFERENCE (create BYTEPTR @@ -818,18 +787,16 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor OFFSET _ (ffetch (TEXTSTREAM PCSTARTCH) of STREAM]) (\TEXTTTYBOUT - [LAMBDA (STREAM BYTE) (* ; "Edited 31-May-91 14:18 by jds") - (* Do BOUT to a text stream, which - is an insertion at the caret.) + [LAMBDA (STREAM BYTE) (* ; "Edited 31-May-91 14:18 by jds") + (* Do BOUT to a text stream, which is + an insertion at the caret.) (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) (COND ((EQ BYTE ERASECHARCODE) (\TEDIT.CHARDELETE TEXTOBJ "" (fetch (TEXTOBJ SEL) of TEXTOBJ))) - ((EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (fetch (TEXTOBJ TXTTERMSA) - of TEXTOBJ) - \PRIMTERMSA) - BYTE))) - (* Nothing, ignore it) + ((EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ) + \PRIMTERMSA) + BYTE))) (* Nothing, ignore it) ) (T (SELCHARQ BYTE ((EOL CR LF) @@ -837,12 +804,12 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (replace (STREAM CHARPOSITION) of STREAM with 0)) (PROGN (\TEXTBOUT STREAM BYTE) (add (fetch (STREAM CHARPOSITION) of STREAM) - 1]) + 1]) ) (DEFINEQ (\INSERTCH - [LAMBDA (CH CH# TEXTOBJ INSERTMARK) (* ; "Edited 29-Jan-99 17:19 by kaplan") + [LAMBDA (CH CH# TEXTOBJ INSERTMARK) (* ; "Edited 29-Jan-99 17:19 by kaplan") (* ;; "If the current ch is 1+last ch in the distinguished INPUTPIECE, then append this text to that piece (make a new one if need be.), and fix up ch#s in the PCTB") @@ -860,8 +827,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor [FATP (COND [(type? STRINGP CH) (AND (fetch (STRINGP FATSTRINGP) of CH) - (NOT (NULL (for CHAR instring CH - thereis (IGREATERP CHAR \MAXTHINCHAR] + (NOT (NULL (for CHAR instring CH thereis (IGREATERP CHAR + \MAXTHINCHAR] (T (IGREATERP CH \MAXTHINCHAR] CHNO NEWPC PREVPC EVENT REPLACING (NEWFLAG NIL) (\INEXTCH (fetch (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ)) @@ -878,20 +845,19 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor [COND ((ZEROP LEN) (* ; "Nothing to insert, really!") (RETURN)) - [(ZEROP (fetch (BTREENODE COUNT) of PCTB)) - (* ; "PCTB is empty.") + [(ZEROP (fetch (BTREENODE COUNT) of PCTB)) (* ; "PCTB is empty.") (\INSERT.FIRST.PIECE TEXTOBJ) (SETQ \INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) (SETQ \INSTRING (fetch (TEXTOBJ \INSERTSTRING) of TEXTOBJ)) (COND - ((type? STRINGP CH) (* ; - "If input is a string, copy it to the insert piece's string") + ((type? STRINGP CH) (* ; + "If input is a string, copy it to the insert piece's string") (RPLSTRING \INSTRING 1 CH)) (T (* ; - "If it's a single charcode, move it to the piece's string") + "If it's a single charcode, move it to the piece's string") (RPLCHARCODE \INSTRING 1 CH))) - (replace (PIECE PLEN) of \INPC (freplace (TEXTOBJ \INSERTLEN) - of TEXTOBJ with LEN)) + (replace (PIECE PLEN) of \INPC (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ + with LEN)) (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE 512 LEN)) (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with LEN) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT @@ -902,8 +868,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor THPOINT _ 'RIGHT] ((OR [AND (fetch (TEXTOBJ \INSERTPCVALID) of TEXTOBJ) (OR (IEQP CH# \INEXTCH) - (AND INSERTMARK (EQ IMARKPC (fetch (PIECE NEXTPIECE) of \INPC) - ) + (AND INSERTMARK (EQ IMARKPC (fetch (PIECE NEXTPIECE) of \INPC)) (EQ IMARKCH 0] (AND NIL (EQ CH# 1) (EQ \INEXTCH -1))) @@ -914,88 +879,80 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (COND ((IGEQ \INLEFT LEN) (* ; - "There's enough room in this piece -- fill it in.") + "There's enough room in this piece -- fill it in.") (COND - ((type? STRINGP CH) (* ; - "If input is a string, copy it to the insert piece's string") + ((type? STRINGP CH) (* ; + "If input is a string, copy it to the insert piece's string") (RPLSTRING \INSTRING (ADD1 \INLEN) CH)) (T (* ; - "If it's a single charcode, move it to the piece's string") + "If it's a single charcode, move it to the piece's string") (RPLCHARCODE \INSTRING (ADD1 \INLEN) CH))) - (replace (PIECE PLEN) of \INPC with (freplace (TEXTOBJ - \INSERTLEN - ) - of TEXTOBJ - with (IPLUS \INLEN LEN)) - ) (* ; - "Fix the length of the insert piece") - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE - \INLEFT LEN) - ) (* ; "And the space left in the piece") - (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS \INEXTCH - LEN)) + (replace (PIECE PLEN) of \INPC with (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ + with (IPLUS \INLEN LEN))) + (* ; + "Fix the length of the insert piece") + (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE \INLEFT LEN)) + (* ; "And the space left in the piece") + (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS \INEXTCH LEN)) (* ; "And the next CH#") (* ; "And the piece # for future use") ) (T (* ; - "No room. Chop this piece & start a new one.") - (replace (PIECE PSTR) of \INPC with (SUBSTRING \INSTRING 1 \INLEN - )) + "No room. Chop this piece & start a new one.") + (replace (PIECE PSTR) of \INPC with (SUBSTRING \INSTRING 1 \INLEN)) (* ; - "Chop the current piece's string to length") + "Chop the current piece's string to length") (SETQ NEWPC (create PIECE PSTR _ (ALLOCSTRING 512 '% ) PLOOKS _ (fetch (PIECE PLOOKS) of \INPC) PPARALOOKS _ (fetch (PIECE PPARALOOKS) of \INPC) PPARALAST _ NIL PNEW _ T)) (* ; "Create the new piece") - (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ - with (SETQ \INSTRING (fetch (PIECE PSTR) of NEWPC))) + (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ with (SETQ \INSTRING + (fetch (PIECE PSTR) + of NEWPC))) (* ; - "Set the \INSTRING field in TEXTOBJ") + "Set the \INSTRING field in TEXTOBJ") (COND - ((type? STRINGP CH) (* ; - "If input is a string, copy it to the insert piece's string") + ((type? STRINGP CH) (* ; + "If input is a string, copy it to the insert piece's string") (RPLSTRING \INSTRING 1 CH)) (T (* ; - "If it's a single charcode, move it to the piece's string") + "If it's a single charcode, move it to the piece's string") (RPLCHARCODE \INSTRING 1 CH))) (replace (PIECE PLEN) of NEWPC with LEN) (* ; - "So far, the present input is the only thing in the piece") + "So far, the present input is the only thing in the piece") (replace (TEXTOBJ \INSERTPCNO) of TEXTOBJ - with (\INSERTPIECE NEWPC (OR (fetch (PIECE NEXTPIECE) - of \INPC) - 'LASTPIECE) - TEXTOBJ)) (* ; - "Insert the new piece into the text and save the piece #") + with (\INSERTPIECE NEWPC (OR (fetch (PIECE NEXTPIECE) of \INPC) + 'LASTPIECE) + TEXTOBJ)) (* ; + "Insert the new piece into the text and save the piece #") (* ;; "(SETQ PCTB (fetch PCTB of TEXTOBJ))") (* ; - "Which may have caused a PCTB overflow") + "Which may have caused a PCTB overflow") (* ; - "This does not happen, after change pctree.") + "This does not happen, after change pctree.") (freplace (TEXTOBJ \INSERTPC) of TEXTOBJ with (SETQ \INPC NEWPC)) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE - 512 LEN)) + (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE 512 LEN)) (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with LEN) (replace (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ with CH#) (* ; - "CH# of the first inserted character") + "CH# of the first inserted character") (replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS CH# LEN)) (* ; - "The CH# of the next character, if it's inserted at the current caret.") - (replace THFIRSTPIECE of (fetch (TEXTOBJ TXTHISTORY) of - TEXTOBJ) + "The CH# of the next character, if it's inserted at the current caret.") + (replace THFIRSTPIECE of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) with (NCONC1 (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - NEWPC)) + NEWPC)) (SETQ NEWFLAG T) (* ; "Note the new piece's creation") )) (add (fetch THLEN of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - LEN) (* ; - "Update the length of the insertion/replacement text.") + LEN) (* ; + "Update the length of the insertion/replacement text.") ) (T (* ;; "NEW INSERTION POINT; IF THERE'S ANYTHING LEFT OF THE PREVIOUS INSERT PIECE, CRACK OFF A NEW ONE & FILL IT. THEN FIGURE OUT WHERE TO SHOEHORN IT IN.") @@ -1003,110 +960,117 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (SETQ PC (OR IMARKPC (\CHTOPC CH# PCTB T))) [COND ((AND \INPC (IGEQ \INLEFT LEN)) (* ; - "There's room left in the prior input-piece's string; re-use it.") + "There's room left in the prior input-piece's string; re-use it.") (SETQ NEWPC (create PIECE PSTR _ (SUBSTRING \INSTRING (ADD1 \INLEN)) PLOOKS _ (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) PPARALOOKS _ (fetch (PIECE PPARALOOKS) of \INPC) PPARALAST _ NIL PNEW _ T)) (* ; "Build the new piece") - (replace (PIECE PSTR) of \INPC with (SUBSTRING \INSTRING 1 \INLEN - )) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE - \INLEFT LEN))) + (replace (PIECE PSTR) of \INPC with (SUBSTRING \INSTRING 1 \INLEN)) + (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE \INLEFT LEN))) (T (* ; - "No room left; build a whole new piece.") + "No room left; build a whole new piece.") (SETQ NEWPC (create PIECE - PSTR _ (freplace (TEXTOBJ \INSERTSTRING) - of TEXTOBJ with (ALLOCSTRING 512)) + PSTR _ (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ + with (ALLOCSTRING 512)) PLOOKS _ (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - PPARALOOKS _ (OR (AND \INPC (fetch (PIECE PPARALOOKS - ) + PPARALOOKS _ (OR (AND \INPC (fetch (PIECE PPARALOOKS) of \INPC)) (\TEDIT.UNIQUIFY.PARALOOKS (create FMTSPEC - copying (fetch (TEXTOBJ - FMTSPEC) - of TEXTOBJ)) + copying (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) TEXTOBJ)) PPARALAST _ NIL PNEW _ T)) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE - 512 LEN] + (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE 512 LEN] (freplace (TEXTOBJ \INSERTPC) of TEXTOBJ with (SETQ \INPC NEWPC)) (replace (PIECE PLEN) of NEWPC with LEN) - (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ with - (SETQ \INSTRING - (fetch (PIECE PSTR) - of NEWPC))) + (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ with (SETQ \INSTRING + (fetch (PIECE PSTR) + of NEWPC))) (COND - ((type? STRINGP CH) (* ; - "Insert the characters into the piece") + ((type? STRINGP CH) (* ; + "Insert the characters into the piece") (RPLSTRING \INSTRING 1 CH)) (T (RPLCHARCODE \INSTRING 1 CH))) (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with LEN) (freplace (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ with CH#) (* ; - "Cache the first-inserted-ch #, for backspace speed") + "Cache the first-inserted-ch #, for backspace speed") (SETQ NEWFLAG T) (COND ((OR (IGREATERP CH# TEXTLEN) (IEQP CH# START-OF-PIECE)) (* ; - "We're inserting on a piece boundary; do it, then remember the prior piece.") + "We're inserting on a piece boundary; do it, then remember the prior piece.") (\INSERTPIECE \INPC PC TEXTOBJ NIL)) (T (* ; - "Not on a piece boundary; split the piece we're inside of, then insert.") + "Not on a piece boundary; split the piece we're inside of, then insert.") (\INSERTPIECE \INPC (\SPLITPIECE PC (- CH# START-OF-PIECE) - TEXTOBJ) + TEXTOBJ) TEXTOBJ NIL))) [COND ((NOT (fetch (PIECE PPARALOOKS) of \INPC)) (* ; - "There weren't any paralooks available at creation time. Find some now.") + "There weren't any paralooks available at creation time. Find some now.") [SETQ PLOOKS (AND (fetch (PIECE PREVPIECE) of \INPC) - (fetch (PIECE PPARALOOKS) of (fetch - (PIECE PREVPIECE) - of \INPC] + (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) + of \INPC] [SETQ NLOOKS (AND (fetch (PIECE NEXTPIECE) of \INPC) - (fetch (PIECE PPARALOOKS) of (fetch - (PIECE NEXTPIECE) - of \INPC] - (replace (PIECE PPARALOOKS) of \INPC - with (COND - ((NOT PLOOKS) (* ; - "No preceding para to take looks from") - (OR NLOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) - ((NOT NLOOKS) (* ; - "No succeeding paras to take looks from") - (OR PLOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) - (T PLOOKS] + (fetch (PIECE PPARALOOKS) of (fetch (PIECE NEXTPIECE) + of \INPC] + (replace (PIECE PPARALOOKS) of \INPC with (COND + ((NOT PLOOKS) + (* ; + "No preceding para to take looks from") + (OR NLOOKS (fetch (TEXTOBJ + FMTSPEC) + of TEXTOBJ))) + ((NOT NLOOKS) + (* ; + "No succeeding paras to take looks from") + (OR PLOOKS (fetch (TEXTOBJ + FMTSPEC) + of TEXTOBJ))) + (T PLOOKS] (replace (TEXTOBJ \INSERTPCNO) of TEXTOBJ with 0) (* ; - "Save the pcno for future insertions") + "Save the pcno for future insertions") (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (* ; - "The PCTB may have expanded during the insert.") + "The PCTB may have expanded during the insert.") (SETQ PREVPC (OR (fetch (PIECE PREVPIECE) of NEWPC) PC)) (* ; - "The piece we're to take the inserted characters' looks from") - (replace (PIECE PLOOKS) of NEWPC with (fetch (TEXTOBJ CARETLOOKS) - of TEXTOBJ)) - [replace (PIECE PPARALOOKS) of NEWPC - with (COND - ((ZEROP TEXTLEN) (* ; - "No text yet; use default paralooks") - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) - ((SETQ PREVPC (fetch (PIECE NEXTPIECE) of \INPC)) + "The piece we're to take the inserted characters' looks from") + (replace (PIECE PLOOKS) of NEWPC with (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) + [replace (PIECE PPARALOOKS) of NEWPC with (COND + ((ZEROP TEXTLEN) (* ; - "There's later text. Use its para looks") - (fetch (PIECE PPARALOOKS) of PREVPC)) - ((SETQ PREVPC (fetch (PIECE PREVPIECE) of \INPC)) + "No text yet; use default paralooks") + (fetch (TEXTOBJ FMTSPEC) + of TEXTOBJ)) + ((SETQ PREVPC (fetch (PIECE + NEXTPIECE + ) + of \INPC)) (* ; - "There's earlier text. Use its looks, copied if need be.") - (COND - ((fetch (PIECE PPARALAST) of PREVPC) - (fetch (PIECE PPARALOOKS) of PREVPC)) - (T (fetch (PIECE PPARALOOKS) of PREVPC] + "There's later text. Use its para looks") + (fetch (PIECE PPARALOOKS) + of PREVPC)) + ((SETQ PREVPC (fetch (PIECE + PREVPIECE + ) + of \INPC)) + (* ; + "There's earlier text. Use its looks, copied if need be.") + (COND + ((fetch (PIECE PPARALAST) + of PREVPC) + (fetch (PIECE PPARALOOKS) + of PREVPC)) + (T (fetch (PIECE PPARALOOKS) + of PREVPC] (SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) (* ; "Prior edit event.") [SETQ REPLACING (AND (EQ (fetch THACTION of EVENT) @@ -1121,21 +1085,20 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (* ;; "We're continuing a prior insertion, even if we had to create a new piece. Just continue the old history event, too.") (add (fetch THLEN of EVENT) - LEN)) + LEN)) (T (* ; - "Nope, this is a new insertion/replacement. Make the new history event.") + "Nope, this is a new insertion/replacement. Make the new history event.") (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ (COND (REPLACING 'Replace) (T 'Insert)) - THLEN _ (fetch (PIECE PLEN) - of \INPC) + THLEN _ (fetch (PIECE PLEN) of \INPC) THCH# _ CH# THFIRSTPIECE _ \INPC THPOINT _ 'RIGHT THOLDINFO _ (AND REPLACING EVENT] [OR NEWFLAG (PROGN (* ; - "We didn't add a piece, so we must update character numbers in the PCTB") + "We didn't add a piece, so we must update character numbers in the PCTB") (* ; "The insert-piece's PCTB entry") (* ;; "(for I from (IPLUS PCNO \EltsPerPiece) to (\EDITELT PCTB \PCTBLastPieceOffset) by \EltsPerPiece do (\EDITSETA PCTB I (IPLUS (\EDITELT PCTB I) LEN)))") @@ -1144,19 +1107,17 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ((NOT (AND (EQ CH# 1) (EQ \INEXTCH -1))) (* ; - "Update character numbers in the PCTB doesn't need when 1st insertion.") + "Update character numbers in the PCTB doesn't need when 1st insertion.") (UPDATEPCNODES \INPC LEN PCTB] - (freplace (TEXTOBJ TEXTLEN) of TEXTOBJ with (SETQ TEXTLEN (IPLUS LEN - TEXTLEN))) + (freplace (TEXTOBJ TEXTLEN) of TEXTOBJ with (SETQ TEXTLEN (IPLUS LEN TEXTLEN))) (replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS CH# LEN)) (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with T) (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) - (replace (PIECE PFATP) of \INPC with (OR (fetch (PIECE PFATP) - of \INPC) - FATP]) + (replace (PIECE PFATP) of \INPC with (OR (fetch (PIECE PFATP) of \INPC) + FATP]) (\INSERTCR - [LAMBDA (CH CH# TEXTOBJ) (* ; "Edited 31-May-91 14:00 by jds") + [LAMBDA (CH CH# TEXTOBJ) (* ; "Edited 31-May-91 14:00 by jds") (* ;; "Handle insertion of CR and meta-CR. The former causes a paragraph break, while the latter doesn't. Note, though, that inserting a meta-CR causes the doucment to become formatted.") @@ -1166,20 +1127,20 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (COND ([AND (NOT (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ)) (NOT (IEQP CH (CHARCODE CR] (* ; - "Inserting a meta-CR into an unformatted document. Start by setting up para breaks.") + "Inserting a meta-CR into an unformatted document. Start by setting up para breaks.") (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ))) (\INSERTCH (CHARCODE CR) CH# TEXTOBJ) (* ; "Put the CR in") (COND ((IEQP CH (CHARCODE CR)) (* ; - "It's really a CR, rather than a meta-CR so do para breaking.") + "It's really a CR, rather than a meta-CR so do para breaking.") (SETQ INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) (AND INPC (replace (PIECE PPARALAST) of INPC with T)) (* ; - "Mark the end of the paragraph (INPC might be NIL if the insert got refused somehow).") + "Mark the end of the paragraph (INPC might be NIL if the insert got refused somehow).") (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "FORCE A NEW PIECE ON THE NEXT CHARACTER") + "FORCE A NEW PIECE ON THE NEXT CHARACTER") ]) ) @@ -1190,7 +1151,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (DEFINEQ (\CHTOPC - [LAMBDA (CH# PCTB TELL-PC-START?) (* ; "Edited 15-Apr-93 16:05 by jds") + [LAMBDA (CH# PCTB TELL-PC-START?) (* ; "Edited 15-Apr-93 16:05 by jds") (* ;; "Given a character # in a text object, and the object's piece table, return a pointer to the piece containing that character, else NIL.") @@ -1199,22 +1160,22 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (LET ((TREE PCTB) (BASE-CH# 1) TBASE-CH# FOUND) - (while (type? BTREENODE TREE) - do [for I from 1 to (fetch (BTREENODE COUNT) of TREE) - as OFST from 2 by 4 - do (COND - ((IGREATERP (SETQ TBASE-CH# (IPLUS BASE-CH# (\GETBASEFIXP TREE OFST)) - ) - CH#) - (SETQ FOUND (\GETBASEPTR TREE (- OFST 2))) - (RETURN)) - (T (SETQ BASE-CH# TBASE-CH#] - (SETQ TREE FOUND)) + (while (type? BTREENODE TREE) do [for I from 1 to (fetch (BTREENODE COUNT) of TREE) + as OFST from 2 by 4 + do (COND + ((IGREATERP (SETQ TBASE-CH# + (IPLUS BASE-CH# (\GETBASEFIXP TREE + OFST))) + CH#) + (SETQ FOUND (\GETBASEPTR TREE (- OFST 2))) + (RETURN)) + (T (SETQ BASE-CH# TBASE-CH#] + (SETQ TREE FOUND)) (AND TELL-PC-START? (SETQ START-OF-PIECE BASE-CH#)) (OR TREE 'LASTPIECE]) (\CHTOPCNO - [LAMBDA (CH# PCTB) (* ; "Edited 13-Jun-90 00:47 by mitani") + [LAMBDA (CH# PCTB) (* ; "Edited 13-Jun-90 00:47 by mitani") (* ;; "Given a character # in a text object, and the object's piece table, return a pointer to the piece containing that character, else NIL") @@ -1223,83 +1184,81 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (TREE (fetch (PCTNODE HI) of PCTB)) CHNUM) [while TREE do (COND - [(IEQP CH# (SETQ CHNUM (fetch (PCTNODE CHNUM) of TREE))) + [(IEQP CH# (SETQ CHNUM (fetch (PCTNODE CHNUM) of TREE))) (* ; "FIND NODE") - (RETURN (SETQ INDEX (IPLUS INDEX (fetch (PCTNODE RANK) - of TREE] - ((IGREATERP CH# CHNUM) (* ; "MOVE RIGHT") - (SETQ INDEX (IPLUS INDEX (fetch (PCTNODE RANK) of TREE))) - (SETQ TREE (fetch (PCTNODE HI) of TREE))) - ((ILESSP CH# CHNUM) (* ; "MOVE LEFT") - (SETQ TREE (fetch (PCTNODE LO) of TREE] + (RETURN (SETQ INDEX (IPLUS INDEX (fetch (PCTNODE RANK) of TREE] + ((IGREATERP CH# CHNUM) (* ; "MOVE RIGHT") + (SETQ INDEX (IPLUS INDEX (fetch (PCTNODE RANK) of TREE))) + (SETQ TREE (fetch (PCTNODE HI) of TREE))) + ((ILESSP CH# CHNUM) (* ; "MOVE LEFT") + (SETQ TREE (fetch (PCTNODE LO) of TREE] (IMAX INDEX 1]) (\CLEARPCTB - [LAMBDA (PCTB) (* ; "Edited 23-Feb-88 11:11 by jds") - - (* ;; "(PROG ((OLASTPC (\EDITELT PCTB \PCTBLastPieceOffset))) (\EDITSETA PCTB \FirstPieceOffset 1) (* Create the LASTPIECE pseudo-piece placeholder in the first piece of the table) (\EDITSETA PCTB (ADD1 \FirstPieceOffset) (QUOTE LASTPIECE)) (for I from \SecondPieceOffset to OLASTPC do (* Now remove the other pieces, setting them to NIL) (\EDITSETA PCTB I NIL)) (\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 \FirstPieceOffset)) (* Fix up the last-piece pointer) (\EDITSETA PCTB \PCTBFreePieces (IPLUS (\EDITELT PCTB \PCTBFreePieces) (LRSH (IDIFFERENCE OLASTPC (ADD1 \FirstPieceOffset)) 1))) (* And the free count of pieces.) (RETURN PCTB))") + [LAMBDA (PCTB) (* ; "Edited 23-Feb-88 11:11 by jds") + + (* ;; "(PROG ((OLASTPC (\EDITELT PCTB \PCTBLastPieceOffset))) (\EDITSETA PCTB \FirstPieceOffset 1) (* Create the LASTPIECE pseudo-piece placeholder in the first piece of the table) (\EDITSETA PCTB (ADD1 \FirstPieceOffset) (QUOTE LASTPIECE)) (for I from \SecondPieceOffset to OLASTPC do (* Now remove the other pieces, setting them to NIL) (\EDITSETA PCTB I NIL)) (\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 \FirstPieceOffset)) (* Fix up the last-piece pointer) (\EDITSETA PCTB \PCTBFreePieces (IPLUS (\EDITELT PCTB \PCTBFreePieces) (LRSH (IDIFFERENCE OLASTPC (ADD1 \FirstPieceOffset)) 1))) (* And the free count of pieces.) (RETURN PCTB))") (HELP]) (\CREATEPIECEORSTREAM - [LAMBDA (STRING LOOKS PARALOOKS START END) (* ; "Edited 11-Jun-99 14:25 by rmk:") - (* ; "Edited 31-May-91 14:18 by jds") + [LAMBDA (TEXT LOOKS PARALOOKS START END) (* ; "Edited 13-Jul-2022 18:46 by rmk") + (* ; "Edited 11-Jun-99 14:25 by rmk:") + (* ; "Edited 31-May-91 14:18 by jds") - (* ;; "Given a source for text, build a PIECE to describe it.") + (* ;; "Given a source for text, build a PIECE to describe it.") - (* ;; "HOWEVER-- if it's aformatted file, return the stream for that file.") + (* ;; "HOWEVER-- if it's aformatted file, return the stream for that file.") (PROG (PC) [SETQ PC (COND - ((STRINGP STRING) (* ; "It's a string.") + ((STRINGP TEXT) (* ; "It's a string.") (create PIECE - PSTR _ STRING + PSTR _ TEXT PFILE _ NIL - PLEN _ (NCHARS STRING) + PLEN _ (NCHARS TEXT) PPARALAST _ NIL PPARALOOKS _ PARALOOKS - PFATP _ (fetch (STRINGP FATSTRINGP) of STRING))) - ((NULL STRING) (* ; - "If it's NIL, use an empty string for the text.") + PFATP _ (fetch (STRINGP FATSTRINGP) of TEXT))) + ((NULL TEXT) (* ; + "If it's NIL, use an empty string for the text.") (create PIECE PSTR _ "" PFILE _ NIL PLEN _ 0 PPARALAST _ NIL PPARALOOKS _ PARALOOKS)) - ((ATOM STRING) (* ; - "An atom is a file name. Open it.") - [SETQ STRING (OPENSTREAM STRING 'INPUT 'OLD '(TYPE TEXT] - (RETURN STRING)) - [(STREAMP STRING) - (COND - [(EQ NoBits (fetch (STREAM ACCESSBITS) of STRING)) - (* ; - "If the stream is no longer open, open it.") - (RETURN (OPENSTREAM STRING 'INPUT 'OLD '((TYPE TEXT] - (T (RETURN STRING] - ((type? PIECE STRING) - STRING) - (T (* ; - "Anything else is coerced to a string first.") - (SETQ STRING (MKSTRING STRING)) + ((ATOM TEXT) (* ; "An atom is a file name. Open it.") + [SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '(TYPE TEXT] + (RETURN TEXT)) + ((STREAMP TEXT) (* ; + "Make sure it's open, then bail out") + (CL:UNLESS (\GETSTREAM TEXT 'INPUT T) + [OPENSTREAM TEXT 'INPUT 'OLD `((TYPE TEXT) + (:EXTERNAL-FORMAT ,(GETSTREAMPROP TEXT + :EXTERNAL-FORMAT]) + (RETURN TEXT)) + ((type? PIECE TEXT) + TEXT) + (T (* ; + "Anything else is coerced to a string first.") + (SETQ TEXT (MKSTRING TEXT)) (create PIECE - PSTR _ STRING + PSTR _ TEXT PFILE _ NIL - PLEN _ (NCHARS STRING) + PLEN _ (NCHARS TEXT) PPARALAST _ NIL - PPARALOOKS _ PARALOOKS] - (replace (PIECE PLOOKS) of PC with (OR LOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)) - ) - (replace (PIECE PPARALOOKS) of PC with (OR PARALOOKS (create FMTSPEC - using + PPARALOOKS _ PARALOOKS + PFATP _ (fetch (STRINGP FATSTRINGP) of TEXT] + (replace (PIECE PLOOKS) of PC with (OR LOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (replace (PIECE PPARALOOKS) of PC with (OR PARALOOKS (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC - ))) + ))) (RETURN PC]) (\DELETEPIECE - [LAMBDA (PC PCTB PC#) (* ; "Edited 20-Apr-93 19:06 by jds") + [LAMBDA (PC PCTB PC#) (* ; "Edited 20-Apr-93 19:06 by jds") (* ;; "Remove piece PC from the piece table PCTB. Adjust the character numbers of succeeding pieces, if need be.") @@ -1309,17 +1268,17 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (COND (NEXT (replace (PIECE PREVPIECE) of NEXT with PREV))) (* ; - "Break any forward link from the piece") + "Break any forward link from the piece") (COND (PREV (replace (PIECE NEXTPIECE) of PREV with NEXT))) (* ; "and any backward link.") ]) (\FINDPIECE - [LAMBDA (PC PCTB) (* ; "Edited 31-May-91 13:53 by jds") + [LAMBDA (PC PCTB) (* ; "Edited 31-May-91 13:53 by jds") (* Given a piece and the pctb it's in, return the elt %# of the CH# entry for - that piece in the table) + that piece in the table) (LET ((NODE (FINDPCNODE PC PCTB))) (INDEX (fetch (PCTNODE CHNUM) of NODE) @@ -1335,8 +1294,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) OLDLEN PCNODE PREVPC) (COND - ((ZEROP (fetch (BTREENODE COUNT) of PCTB)) - (* ; "PCTB is empty.") + ((ZEROP (fetch (BTREENODE COUNT) of PCTB)) (* ; "PCTB is empty.") (replace (PIECE NEXTPIECE) of NEW with NIL) (replace (PIECE PREVPIECE) of NEW with NIL) (replace (BTREENODE DOWN1) of PCTB with NEW) @@ -1349,7 +1307,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (ATOM OLD)) (* ; "Inserting in front of a symbol OR NIL, which must be LASTPIECE, the end-of-doc marker. Go find the node that contains it.") (\LASTNODE PCTB)) (T (* ; - "Normal case; go find the btree node that contains the piece we're inserting in front of.") + "Normal case; go find the btree node that contains the piece we're inserting in front of.") (FINDPCNODE OLD PCTB] (\INSERTTREE NEW OLD PCNODE NEW-PREVLEN NIL PREV) @@ -1360,19 +1318,17 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (ATOM OLD)) (* ; "Inserting in front of a symbol OR NIL, which must be LASTPIECE, the end-of-doc marker. Go find the node that contains it.") (replace (PIECE NEXTPIECE) of NEW with NIL) (replace (PIECE PREVPIECE) of NEW with (AND (NOT (ZEROP OLDLEN)) - (SETQ PREVPC (\CHTOPC - OLDLEN PCTB] + (SETQ PREVPC (\CHTOPC OLDLEN PCTB] (T (* ; - "Normal case; go find the btree node that contains the piece we're inserting in front of.") + "Normal case; go find the btree node that contains the piece we're inserting in front of.") (replace (PIECE NEXTPIECE) of NEW with OLD) - (replace (PIECE PREVPIECE) of NEW with (SETQ PREVPC (ffetch - (PIECE PREVPIECE) - of OLD))) + (replace (PIECE PREVPIECE) of NEW with (SETQ PREVPC (ffetch (PIECE PREVPIECE) + of OLD))) (replace (PIECE PREVPIECE) of OLD with NEW))) (AND PREVPC (replace (PIECE NEXTPIECE) of PREVPC with NEW]) (\MAKEPCTB - [LAMBDA (PC1 MINLEN) (* ; "Edited 15-Apr-93 15:48 by jds") + [LAMBDA (PC1 MINLEN) (* ; "Edited 15-Apr-93 15:48 by jds") (* ;; "Create a new piece table, with PC1 as its first piece, and a dummy piece at the end, with 1st ch# of 1+ (chlim of pc1)") @@ -1388,9 +1344,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor PLEN) (COND (PC1 (FREPLACE (BTREENODE COUNT) OF PCTB WITH 2) - (FREPLACE (BTREENODE TOTLEN) OF PCTB WITH (SETQ PLEN (FETCH - (PIECE PLEN) - OF PC1))) + (FREPLACE (BTREENODE TOTLEN) OF PCTB WITH (SETQ PLEN (FETCH (PIECE PLEN) + OF PC1))) (FREPLACE (BTREENODE DOWN1) OF PCTB WITH PC1) (FREPLACE (BTREENODE DLEN1) OF PCTB WITH PLEN) (FREPLACE (BTREENODE DOWN2) OF PCTB WITH 'LASTPIECE) @@ -1398,7 +1353,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (FREPLACE (PIECE PTREENODE) OF PC1 WITH PCTB)) (T (* ;; - "No initial piece, so create a 0-long document, with only the ending-piece dummy") + "No initial piece, so create a 0-long document, with only the ending-piece dummy") (FREPLACE (BTREENODE COUNT) OF PCTB WITH 1) (FREPLACE (BTREENODE TOTLEN) OF PCTB WITH 0) @@ -1407,7 +1362,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor PCTB]) (\SPLITPIECE - [LAMBDA (PC CH TEXTOBJ PC#) (* ; "Edited 21-Apr-93 17:49 by jds") + [LAMBDA (PC CH TEXTOBJ PC#) (* ; "Edited 21-Apr-93 17:49 by jds") (* ;; "Split the piece PC before CH (rel to start of PIECE); return the new second piece.") @@ -1417,66 +1372,52 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (NEWPC (create PIECE using PC)) CHNO NEWLEN NEXTPC) (SETQ CHNO CH) (* ; - "Offset within the piece before which to break") + "Offset within the piece before which to break") (COND ((ILEQ CHNO 0) (SHOULDNT "Splitting a piece at the start."))) - (replace (PIECE PPARALAST) of PC with NIL) - (* ; - "There can be no para break before the split, as things now work.") + (replace (PIECE PPARALAST) of PC with NIL) (* ; + "There can be no para break before the split, as things now work.") (COND - ((ffetch (PIECE PSTR) of PC) (* ; - "This piece points to a string. Split it for the two new pieces") - (freplace (PIECE PSTR) of NEWPC with (SUBSTRING (ffetch (PIECE PSTR) - of PC) - (ADD1 CHNO))) - (freplace (PIECE PLEN) of NEWPC with (IDIFFERENCE (ffetch (PIECE - PLEN) - of PC) - CHNO)) - (freplace (PIECE PSTR) of PC with (SUBSTRING (ffetch (PIECE PSTR) - of PC) - 1 CHNO)) + ((ffetch (PIECE PSTR) of PC) (* ; + "This piece points to a string. Split it for the two new pieces") + (freplace (PIECE PSTR) of NEWPC with (SUBSTRING (ffetch (PIECE PSTR) of PC) + (ADD1 CHNO))) + (freplace (PIECE PLEN) of NEWPC with (IDIFFERENCE (ffetch (PIECE PLEN) of PC) + CHNO)) + (freplace (PIECE PSTR) of PC with (SUBSTRING (ffetch (PIECE PSTR) of PC) + 1 CHNO)) (freplace (PIECE PLEN) of PC with CHNO)) - ((ffetch (PIECE PFILE) of PC) (* ; - "This piece points to a file. Set the fileptrs accordingly") - (freplace (PIECE PFILE) of NEWPC with (ffetch (PIECE PFILE) - of PC)) + ((ffetch (PIECE PFILE) of PC) (* ; + "This piece points to a file. Set the fileptrs accordingly") + (freplace (PIECE PFILE) of NEWPC with (ffetch (PIECE PFILE) of PC)) [freplace (PIECE PFPOS) of NEWPC with (COND - ((fetch (PIECE PFATP) - of NEWPC) + ((fetch (PIECE PFATP) of NEWPC) (* ; - "This is a FAT piece; need to allow 2 bytes per char skipped") - (IPLUS (ffetch (PIECE PFPOS) - of PC) - CHNO CHNO)) - (T - (* ; - "Regular piece; allow 1 byte per char") - (IPLUS (ffetch - (PIECE PFPOS) - of PC) - CHNO] - (freplace (PIECE PLEN) of NEWPC with (IDIFFERENCE (ffetch (PIECE - PLEN) - of PC) - CHNO)) + "This is a FAT piece; need to allow 2 bytes per char skipped") + (IPLUS (ffetch (PIECE PFPOS) of PC) + CHNO CHNO)) + (T (* ; + "Regular piece; allow 1 byte per char") + (IPLUS (ffetch (PIECE PFPOS) of PC) + CHNO] + (freplace (PIECE PLEN) of NEWPC with (IDIFFERENCE (ffetch (PIECE PLEN) of PC) + CHNO)) (FREPLACE (PIECE PLEN) OF PC WITH CHNO))) (PROGN (* UNINTERRUPTABLY) (SETQ NEXTPC (ffetch (PIECE NEXTPIECE) of PC)) (* LET ((PCNODE (FETCH - (PIECE PTREENODE) OF PC))) - (* ;; - "Update the length of the original piece in it's tree entry.") - (for ITEM# from 0 by 4 as I from 1 - to (fetch (BTREENODE COUNT) of - PCNODE) when (EQ (\GETBASEPTR PCNODE - ITEM#) PC) do (* ;; - "FIXME - I think this can be done as aport of \INSERTPIECE / \INSERTTREEE, by looking back 1 from the OLD entry and updating. --JDS") - (\PUTBASEFIXP PCNODE - (IPLUS ITEM# 2) (fetch - (PIECE PLEN) of PC)) - (RETURN))) + (PIECE PTREENODE) OF PC))) + (* ;; + "Update the length of the original piece in it's tree entry.") + (for ITEM# from 0 by 4 as I from 1 to + (fetch (BTREENODE COUNT) of PCNODE) + when (EQ (\GETBASEPTR PCNODE ITEM#) PC) + do (* ;; "FIXME - I think this can be done as aport of \INSERTPIECE / \INSERTTREEE, by looking back 1 from the OLD entry and updating. --JDS") + (\PUTBASEFIXP PCNODE + (IPLUS ITEM# 2) (fetch + (PIECE PLEN) of PC)) + (RETURN))) (\INSERTPIECE NEWPC (OR NEXTPC 'LASTPIECE) TEXTOBJ NIL NIL (IMINUS (fetch (PIECE PLEN) of NEWPC)) PC) @@ -1484,8 +1425,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (* ;; "update nextlink and prevlink") (COND - ((NULL NEXTPC) (* ; - "PC is last piece (not LASTPIECE)") + ((NULL NEXTPC) (* ; "PC is last piece (not LASTPIECE)") (* ; "NEWPC is new last piece.") (replace (PIECE NEXTPIECE) of NEWPC with NIL)) (T (replace (PIECE NEXTPIECE) of NEWPC with NEXTPC) @@ -1495,24 +1435,23 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (* ; "Now set its starting CH#") (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Whenever you split a piece, you can't add to it anymore.") + "Whenever you split a piece, you can't add to it anymore.") (RETURN NEWPC]) (\INSERT.FIRST.PIECE - [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 14:00 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 14:00 by jds") (* ;; "Insert 1st piece to empty PCTB.") (PROG (PC) (\INSERTPIECE [SETQ PC (\CREATEPIECEORSTREAM NIL (CHARLOOKS.FROM.FONT DEFAULTFONT) - (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) - (T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC - ] + (COND + (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) + (T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC] NIL TEXTOBJ) (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with PC) - (replace (PIECE PSTR) of PC with (freplace (TEXTOBJ \INSERTSTRING) - of TEXTOBJ with (ALLOCSTRING 512]) + (replace (PIECE PSTR) of PC with (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ + with (ALLOCSTRING 512]) ) @@ -1522,29 +1461,29 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (DEFINEQ (\TEXTCLOSEF - [LAMBDA (STREAM) (* ; "Edited 15-Apr-93 16:43 by jds") + [LAMBDA (STREAM) (* ; "Edited 15-Apr-93 16:43 by jds") (* ; - "Close the files underlying a stream") + "Close the files underlying a stream") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) PCTB PC) (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) [OR (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (COND ((TYPE? PIECE (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0))) + 0))) (fetch (PIECE PFILE) of PC) (CLOSEF? (fetch (PIECE PFILE) of PC)) (SETQ PC (FETCH (PIECE NEXTPIECE) OF PC)) (WHILE PC DO (AND (fetch (PIECE PFILE) of PC) - (CLOSEF? (fetch (PIECE PFILE) of PC))) - (SETQ PC (FETCH (PIECE NEXTPIECE) OF PC] + (CLOSEF? (fetch (PIECE PFILE) of PC))) + (SETQ PC (FETCH (PIECE NEXTPIECE) OF PC] (* ;; "And close the REAL file as well, in case we'd made a local cache.") (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ]) (\TEXTCLOSEF-SUBTREE - [LAMBDA (PCTREE) (* ; "Edited 31-May-91 14:00 by jds") + [LAMBDA (PCTREE) (* ; "Edited 31-May-91 14:00 by jds") (* ;; "Run thru the pieces in the document, closing the underlying file") @@ -1562,7 +1501,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (\TEXTCLOSEF-SUBTREE (fetch (PCTNODE HI) of PCTREE]) (\TEXTDSPFONT - [LAMBDA (STREAM NEWFONT) (* ; "Edited 31-May-91 14:02 by jds") + [LAMBDA (STREAM NEWFONT) (* ; "Edited 31-May-91 14:02 by jds") (* ;; "Set the font for a TEdit window. Need change the caret looks, for character insertion, and the WINDOW's looks, so that TEXEC type-out to the window does the right thing.") @@ -1583,7 +1522,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor do (DSPFONT NEWFONT WIN])]) (\TEXTEOFP - [LAMBDA (STREAM) (* ; "Edited 31-May-91 14:18 by jds") + [LAMBDA (STREAM) (* ; "Edited 31-May-91 14:18 by jds") (* ;; "Test for EOF on a text stream: At end of a piece, and there's no more pieces.") @@ -1593,23 +1532,19 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (AND (IEQP (fetch (STREAM COFFSET) of STREAM) (fetch (STREAM CBUFSIZE) of STREAM)) (ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) - (OR (NOT (fetch (PIECE NEXTPIECE) of (fetch (TEXTSTREAM PIECE) of STREAM - ))) - (bind (PC _ (fetch (PIECE NEXTPIECE) of (fetch (TEXTSTREAM PIECE) - of STREAM))) while - PC - do (COND - ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (RETURN NIL))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (RETURN - T]) + (OR (NOT (fetch (PIECE NEXTPIECE) of (fetch (TEXTSTREAM PIECE) of STREAM))) + (bind (PC _ (fetch (PIECE NEXTPIECE) of (fetch (TEXTSTREAM PIECE) of STREAM))) + while PC do (COND + ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) + (RETURN NIL))) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (RETURN T]) (\TEXTGETEOFPTR - [LAMBDA (STREAM) (* ; "Edited 31-May-91 13:58 by jds") + [LAMBDA (STREAM) (* ; "Edited 31-May-91 13:58 by jds") (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) (\TEXTGETFILEPTR - [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:32 by jds") + [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:32 by jds") (* ;; "GETFILEPTR fn for text streams.") @@ -1622,28 +1557,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ((EQ PC 'LASTPIECE) (* ; "STREAM is Empty Document") (RETURN 0)) [PC (* ; - "There's a piece. That means he's inside the file somewhere.") + "There's a piece. That means he's inside the file somewhere.") (SETQ PLEN (fetch (PIECE PLEN) of PC)) (RETURN (IMIN [SUB1 (IPLUS (\TEDIT.PIECE-CHNO PC) (IDIFFERENCE PLEN CHARSLEFT) (COND ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) (* ; - "This is a 16-bit stream; The difference is in BYTES, and needs to be divided by 2 to get chars") + "This is a 16-bit stream; The difference is in BYTES, and needs to be divided by 2 to get chars") (IQUOTIENT (IDIFFERENCE OFFSET LIMIT) 2)) (T (IDIFFERENCE OFFSET LIMIT] - (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) - of STREAM] + (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM] (T (* ; - "Lack of a current piece means he walked off the end.") - (RETURN (IMAX 1 (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) - of STREAM]) + "Lack of a current piece means he walked off the end.") + (RETURN (IMAX 1 (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) (\TEXTOPENF - [LAMBDA (STREAM ACCESS ASDF QWER ZXCV) (* ; "Edited 31-May-91 13:58 by jds") - (* Return the stream, opened for - input) + [LAMBDA (STREAM ACCESS ASDF QWER ZXCV) (* ; "Edited 31-May-91 13:58 by jds") + (* Return the stream, opened for input) (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) PCTB PC) (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) @@ -1654,7 +1586,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (RETURN STREAM]) (\TEXTOPENF-SUBTREE - [LAMBDA (PCTREE) (* ; "Edited 31-May-91 14:19 by jds") + [LAMBDA (PCTREE) (* ; "Edited 31-May-91 14:19 by jds") (LET (PC) (COND ((NULL PCTREE) @@ -1662,21 +1594,19 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (T (SETQ PC (fetch (PCTNODE PCE) of PCTREE)) [COND ((AND (fetch (PIECE PFILE) of PC) - (EQ (fetch (STREAM ACCESSBITS) of (fetch (PIECE PFILE) - of PC)) + (EQ (fetch (STREAM ACCESSBITS) of (fetch (PIECE PFILE) of PC)) NoBits)) (\TEDIT.REOPEN.STREAM STREAM (fetch (PIECE PFILE) of PC] (\TEXTOPENF-SUBTREE (fetch (PCTNODE LO) of PCTREE)) (\TEXTOPENF-SUBTREE (fetch (PCTNODE HI) of PCTREE]) (\TEXTOUTCHARFN - [LAMBDA (CH STREAM) (* ; "Edited 31-May-91 13:59 by jds") - (\INSERTCH CH (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) - of STREAM)) + [LAMBDA (CH STREAM) (* ; "Edited 31-May-91 13:59 by jds") + (\INSERTCH CH (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) (\TEXTBACKFILEPTR - [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:32 by jds") + [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:32 by jds") (* ;; "Use this to BACKFILEPTR a text stream.") @@ -1687,27 +1617,29 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (IEQP (fetch (STREAM COFFSET) of STREAM) (fetch (TEXTSTREAM PCSTARTCH) of STREAM))) (* ; - "Hit start of piece; back to PREVPIECE & keep going.") - [SETQ PC (replace (TEXTSTREAM PIECE) of STREAM - with (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) - of STREAM] + "Hit start of piece; back to PREVPIECE & keep going.") + [SETQ PC (replace (TEXTSTREAM PIECE) of STREAM with (fetch (PIECE PREVPIECE) + of (fetch (TEXTSTREAM PIECE) + of STREAM] (* ; "Move to previous piece") (replace (STREAM BINABLE) of STREAM with T) (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) (* add (fetch (TEXTSTREAM PCNO) of - STREAM) -1) - (while (AND PC (ZEROP (fetch (PIECE PLEN) of PC))) - do (* ; - "Skip over any zero-length pieces as we back along.") - (SETQ PC (fetch (PIECE PREVPIECE) of PC))) + STREAM) -1) + (while (AND PC (ZEROP (fetch (PIECE PLEN) of PC))) do + (* ; + "Skip over any zero-length pieces as we back along.") + (SETQ PC (fetch (PIECE PREVPIECE) + of PC))) (COND - [PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS) of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) + [PC (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.") + ((SETQ PS (fetch (PIECE PSTR) of PC))(* ; "This piece lives in a string.") (\TEDIT.TEXTBIN.STRINGSETUP (SUB1 (fetch (PIECE PLEN) of PC)) 1 STREAM PS) @@ -1723,47 +1655,37 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)) (T (ERROR "CAN'T GET TO NEXT PIECE"] (T (ERROR "Trying to BACKFILEPTR thru start of text."] - ((ZEROP (fetch (STREAM COFFSET) of STREAM)) - (* ; "Move back 1 file page") + ((ZEROP (fetch (STREAM COFFSET) of STREAM)) (* ; "Move back 1 file page") (SETQ REALFILE (fetch (TEXTSTREAM REALFILE) of STREAM)) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IPLUS (fetch - (TEXTSTREAM - CHARSLEFT) - of STREAM) - (fetch - (STREAM CBUFSIZE) - of STREAM))) + (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IPLUS (fetch (TEXTSTREAM CHARSLEFT) + of STREAM) + (fetch (STREAM CBUFSIZE) + of STREAM))) (replace (STREAM COFFSET) of REALFILE with 0) (COND - ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (* ; - "16 bit stream, so back up 2 bytes.") + ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) (* ; + "16 bit stream, so back up 2 bytes.") (\BACKFILEPTR REALFILE) (\BACKFILEPTR REALFILE)) (T (\BACKFILEPTR REALFILE))) (\PEEKBIN REALFILE) - (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) - of REALFILE)) - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) - of REALFILE)) - (replace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM CBUFSIZE) - of REALFILE)) - (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) - of REALFILE))) + (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) of REALFILE)) + (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) of REALFILE)) + (replace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM CBUFSIZE) of REALFILE)) + (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) of REALFILE))) (T (* ; "JUST ACT CASUAL & DO IT.") (COND - ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (* ; - "16 bit stream, so back up 2 bytes.") + ((fetch (TEXTSTREAM FATSTREAMP) of STREAM)(* ; + "16 bit stream, so back up 2 bytes.") (\PAGEDBACKFILEPTR STREAM) (\PAGEDBACKFILEPTR STREAM)) (T (\PAGEDBACKFILEPTR STREAM] T]) (\TEXTBOUT - [LAMBDA (STREAM BYTE) (* ; "Edited 10-May-93 16:59 by jds") + [LAMBDA (STREAM BYTE) (* ; "Edited 10-May-93 16:59 by jds") (* ; - "Do BOUT to a text stream, which is an insertion at the caret.") + "Do BOUT to a text stream, which is an insertion at the caret.") (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) (CH# (ADD1 (\TEXTGETFILEPTR STREAM))) WINDOW TEXTLEN PS PC PSTR OFFST) @@ -1774,37 +1696,27 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (AND WINDOW (TEDIT.UPDATE.SCREEN TEXTOBJ)) (AND (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (RETURN)) (* ; - "If teh stream is readonly, nothing happened!") - [SETQ PS (ffetch (PIECE PSTR) of (SETQ PC (fetch (TEXTOBJ \INSERTPC) - of TEXTOBJ] + "If teh stream is readonly, nothing happened!") + [SETQ PS (ffetch (PIECE PSTR) of (SETQ PC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ] (* ; "This piece resides in a STRING.") (replace (TEXTSTREAM PIECE) of STREAM with PC) - (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) - of PS) - (LRSH (SETQ OFFST - (ffetch (STRINGP - OFFST) - of PS)) - 1))) + (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS) + (LRSH (SETQ OFFST (ffetch (STRINGP OFFST) + of PS)) + 1))) (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (STREAM COFFSET) of STREAM with (IPLUS (freplace (TEXTSTREAM - PCSTARTCH) - of STREAM - with (LOGAND 1 OFFST)) - (fetch (TEXTOBJ \INSERTLEN - ) - of TEXTOBJ))) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (* ; - "Page # within the 'file' where this piece starts") - (freplace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM COFFSET) - of STREAM)) + (freplace (STREAM COFFSET) of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH) + of STREAM with (LOGAND 1 OFFST)) + (fetch (TEXTOBJ \INSERTLEN) of TEXTOBJ))) + (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) (* ; + "Page # within the 'file' where this piece starts") + (freplace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM COFFSET) of STREAM)) (freplace (STREAM EPAGE) of STREAM with 1) (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) (freplace (TEXTSTREAM REALFILE) of STREAM with NIL]) (\TEDITOUTCCODEFN - [LAMBDA (STREAM CHARCODE) (* ; "Edited 12-Oct-2021 15:38 by rmk:") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 12-Oct-2021 15:38 by rmk:") (* ;; "OUTCCODEFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes (via \TEXTBOUT). BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.") @@ -1813,26 +1725,24 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (\BOUT STREAM (CHARCODE CR)) (freplace (STREAM CHARPOSITION) of STREAM with 0)) (T (\BOUT STREAM CHARCODE) - (freplace (STREAM CHARPOSITION) of STREAM with - (PROGN + (freplace (STREAM CHARPOSITION) of STREAM with (PROGN (* ; "Ugh. Don't overflow") - (IPLUS16 (ffetch (STREAM - CHARPOSITION - ) - of STREAM) - 1]) + (IPLUS16 (ffetch (STREAM CHARPOSITION + ) + of STREAM) + 1]) (\TEXTSETEOF - [LAMBDA (STREAM EOFPTR) (* ; "Edited 31-May-91 14:19 by jds") - (* Set the EPAGE/EOFFSET of the - stream to be (SUB1 of EOFPTR)) + [LAMBDA (STREAM EOFPTR) (* ; "Edited 31-May-91 14:19 by jds") + (* Set the EPAGE/EOFFSET of the stream + to be (SUB1 of EOFPTR)) (replace (STREAM EPAGE) of STREAM with (fetch (BYTEPTR PAGE) of EOFPTR)) (replace (STREAM EOFFSET) of STREAM with (fetch (BYTEPTR OFFSET) of EOFPTR]) (\TEXTSETFILEPTR - [LAMBDA (STREAM FILEPOS) (* ; "Edited 22-Apr-93 13:44 by jds") + [LAMBDA (STREAM FILEPOS) (* ; "Edited 22-Apr-93 13:44 by jds") (* ; - "Sets the file ptr for a text stream.") + "Sets the file ptr for a text stream.") (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) (COND ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) @@ -1845,75 +1755,70 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ((OR (ILESSP FILEPOS 0) (IGREATERP FILEPOS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) (* ; - "If the fileptr is not within the text, punt.") + "If the fileptr is not within the text, punt.") (\ILLEGAL.ARG FILEPOS)) (T (\SETUPGETCH (IMAX 1 (ADD1 FILEPOS)) TEXTOBJ]) (\TEXTDSPXPOSITION - [LAMBDA (STREAM XPOSITION) (* ; "Edited 3-Jan-2001 17:27 by rmk:") - (* ; - "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:") + [LAMBDA (STREAM XPOSITION) (* ; "Edited 3-Jan-2001 17:27 by rmk:") + (* ; + "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:") - (* ;; -"Simply returns the XPOSITION of the primary window's display stream, this is a read-only function") + (* ;; + "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function") (LET [(WINDOW (CAR (fetch \WINDOW of (TEXTOBJ STREAM] (COND (WINDOW (DSPXPOSITION NIL WINDOW)) - (T (* ; - "If there is no window, estimate from character position") + (T (* ; + "If there is no window, estimate from character position") (TIMES (CHARWIDTH (CHARCODE SPACE) STREAM) (POSITION STREAM]) (\TEXTDSPYPOSITION - [LAMBDA (STREAM YPOSITION) (* ; "Edited 31-May-91 13:59 by jds") + [LAMBDA (STREAM YPOSITION) (* ; "Edited 31-May-91 13:59 by jds") - (* Simply returns the XPOSITION of the primary window's display stream, this is - a read-only function) + (* Simply returns the XPOSITION of the primary window's display stream, this is a + read-only function) (LET [(WINDOW (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM] (IF WINDOW THEN (DSPYPOSITION NIL WINDOW) ELSE (AND \#DISPLAYLINES (NEQ \CURRENTDISPLAYLINE -1) - (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE]) + (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE]) (\TEXTLEFTMARGIN - [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") + [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") (* ;;; "Returns the left margin of the textstream. This is a read-only function") (IF (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM))) - THEN [IPLUS 8 (fetch (FMTSPEC LEFTMAR) of (fetch (TEXTOBJ FMTSPEC) - of (TEXTOBJ STREAM] + THEN [IPLUS 8 (fetch (FMTSPEC LEFTMAR) of (fetch (TEXTOBJ FMTSPEC) of (TEXTOBJ STREAM] ELSE 0]) (\TEXTRIGHTMARGIN - [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") + [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") -(* ;;; "Returns the right margin of the textstream. This is a read-only function") +(* ;;; "Returns the right margin of the textstream. This is a read-only function") (LET ((TEXTOBJ (TEXTOBJ STREAM))) (IF (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - THEN (LET [(RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of (fetch (TEXTOBJ - FMTSPEC) - of TEXTOBJ] - (IF (ZEROP RIGHTMAR) - THEN (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - ELSE RIGHTMAR)) + THEN (LET [(RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] + (IF (ZEROP RIGHTMAR) + THEN (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + ELSE RIGHTMAR)) ELSE (TIMES (CHARWIDTH (CHARCODE A) - STREAM) - (LINELENGTH NIL STREAM]) + STREAM) + (LINELENGTH NIL STREAM]) (\TEXTDSPCHARWIDTH - [LAMBDA (STREAM CHARCODE) (* ; - "Edited 9-Feb-99 12:59 by kaplan") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 9-Feb-99 12:59 by kaplan") (CHARWIDTH CHARCODE (DSPFONT NIL STREAM]) (\TEXTDSPSTRINGWIDTH - [LAMBDA (STREAM STRING) (* ; - "Edited 9-Feb-99 13:00 by kaplan") + [LAMBDA (STREAM STRING) (* ; "Edited 9-Feb-99 13:00 by kaplan") (STRINGWIDTH STRING (DSPFONT NIL STREAM]) (\TEXTDSPLINEFEED @@ -2168,88 +2073,78 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ELSE BYTE]) (\TEDIT.TEXTBIN.STRINGSETUP - [LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* ; "Edited 31-May-91 14:21 by jds") + [LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* ; "Edited 31-May-91 14:21 by jds") (PROG (OFFST) (COND ((fetch (STRINGP FATSTRINGP) of PS) - (* The string is FAT. Therefore, make all the offsets and things take account - of the fact that each char is really 2 bytes.) + (* The string is FAT. Therefore, make all the offsets and things take account of + the fact that each char is really 2 bytes.) - (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP - BASE) - of PS) - (ffetch (STRINGP OFFST) - of PS))) + (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS) + (ffetch (STRINGP OFFST) of PS))) (* The char page ptr can point to the real first char, since it's a word.) (freplace (STREAM CPAGE) of STREAM with 0) (freplace (STREAM COFFSET) of STREAM with (UNFOLD CHOFFSET 2)) (* Offset into the string, in bytes. - That 2 should really be something - like BYTESPERFATCHAR.) + That 2 should really be something like + BYTESPERFATCHAR.) (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) (* Page %# within the "file" where - this piece starts) + this piece starts) (freplace (TEXTSTREAM PCSTARTCH) of STREAM with 0) - (* Char within "page" where the - piece starts (for BACKFILEPTR)) + (* Char within "page" where the piece + starts (for BACKFILEPTR)) (freplace (STREAM CBUFSIZE) of STREAM with (IPLUS (UNFOLD CHARSLEFT 2) - (ffetch (STREAM - COFFSET) - of STREAM))) + (ffetch (STREAM COFFSET) of STREAM))) (* Since the chars-left field is - words, and we're talking bytes.) + words, and we're talking bytes.) (freplace (STREAM EPAGE) of STREAM with 1) (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) (* When we hit the end of the string, we'll have run out off the piece, too.) (freplace (TEXTSTREAM REALFILE) of STREAM with NIL) - (replace (STREAM BINABLE) of STREAM with NIL) - (* To force BINs thru the \TEXTBIN - function so we can get two bytes.) + (replace (STREAM BINABLE) of STREAM with NIL) (* To force BINs thru the \TEXTBIN + function so we can get two bytes.) (replace (TEXTSTREAM FATSTREAMP) of STREAM with T) - (* And mark the stream as having - wide characters, so \TEXTBIN knows - what to do.) + (* And mark the stream as having wide + characters, so \TEXTBIN knows what to + do.) ) - (T (* Characters are thin in this - string (the usual case)) - (freplace (STREAM CPPTR) of STREAM with - (ADDBASE (ffetch (STRINGP BASE) - of PS) - (LRSH (SETQ OFFST - (ffetch (STRINGP OFFST) - of PS)) - 1))) + (T (* Characters are thin in this string + (the usual case)) + (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS) + (LRSH (SETQ OFFST (ffetch (STRINGP + OFFST) + of PS)) + 1))) (freplace (STREAM CPAGE) of STREAM with 0) (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) (* Page %# within the "file" where - this piece starts) + this piece starts) (freplace (TEXTSTREAM PCSTARTCH) of STREAM with (LOGAND 1 OFFST)) - (* Char within "page" where the - piece starts (for BACKFILEPTR)) + (* Char within "page" where the piece + starts (for BACKFILEPTR)) (freplace (STREAM COFFSET) of STREAM with (IPLUS (LOGAND 1 OFFST) - CHOFFSET)) - (freplace (STREAM CBUFSIZE) of STREAM with (IPLUS CHARSLEFT - (ffetch - (STREAM COFFSET) - of STREAM))) + CHOFFSET)) + (freplace (STREAM CBUFSIZE) of STREAM with (IPLUS CHARSLEFT (ffetch (STREAM COFFSET) + of STREAM))) (freplace (STREAM EPAGE) of STREAM with 1) (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) (freplace (TEXTSTREAM REALFILE) of STREAM with NIL) (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL]) (\TEDIT.TEXTBIN.FILESETUP - [LAMBDA (PC CHOFFSET CHARSLEFT STREAM PF FATP OPERATION NOERRORFLG) - (* ; "Edited 8-Jun-99 23:37 by rmk:") - (* ; "Edited 8-Jun-99 23:33 by rmk:") - (* ; "Edited 8-Jun-99 23:32 by rmk:") - (* ; "Edited 15-Apr-93 15:53 by jds") - (* ; - "Do the setup needed to make a text stream read from a file.") + [LAMBDA (PC CHOFFSET CHARSLEFT STREAM PF FATP OPERATION NOERRORFLG) + (* ; "Edited 8-Jun-99 23:37 by rmk:") + (* ; "Edited 8-Jun-99 23:33 by rmk:") + (* ; "Edited 8-Jun-99 23:32 by rmk:") + (* ; "Edited 15-Apr-93 15:53 by jds") + (* ; + "Do the setup needed to make a text stream read from a file.") (PROG ((BYTESLEFT (COND (FATP (UNFOLD CHARSLEFT 2)) (T CHARSLEFT))) @@ -2259,139 +2154,118 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor CH FPOS) [COND ((IEQP (ffetch (STREAM ACCESSBITS) of PF) - NoBits) (* ; "ASSURE THAT THE FILE IS OPEN") + NoBits) (* ; "ASSURE THAT THE FILE IS OPEN") (SETQ PF (\TEDIT.REOPEN.STREAM STREAM PF] [freplace (TEXTSTREAM PCSTARTPG) of STREAM with (ffetch (BYTEPTR PAGE) - of (SETQ FPOS - (ffetch - (PIECE PFPOS) - of PC] - (* ; - "Page within the file where the piece starts") - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with (ffetch (BYTEPTR OFFSET) - of FPOS)) - (* ; - "Char within the page where it starts.") + of (SETQ FPOS (ffetch (PIECE PFPOS) + of PC] + (* ; + "Page within the file where the piece starts") + (freplace (TEXTSTREAM PCSTARTCH) of STREAM with (ffetch (BYTEPTR OFFSET) of FPOS)) + (* ; + "Char within the page where it starts.") (SETFILEPTR PF (IPLUS FPOS BYTEOFFSET)) [COND - ((ZEROP (GETEOFPTR PF)) (* ; - "For zero-length files, do nothing.") + ((ZEROP (GETEOFPTR PF)) (* ; + "For zero-length files, do nothing.") ) ((ILESSP (IPLUS FPOS BYTEOFFSET) - (GETEOFPTR PF)) (* ; - "Only get the next character if we aren't positioning past the end of the file.") + (GETEOFPTR PF)) (* ; + "Only get the next character if we aren't positioning past the end of the file.") (SETQ CH (IF (EQ OPERATION 'BIN) THEN (CL:IF FATP - (LOGOR (UNFOLD (\PAGEDBIN PF) - 256) - (\PAGEDPEEKBIN PF NOERRORFLG)) - (\BIN PF)) + (LOGOR (UNFOLD (\PAGEDBIN PF) + 256) + (\PAGEDPEEKBIN PF NOERRORFLG)) + (\BIN PF)) ELSE (CL:IF FATP - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PF) - 256) - (\PAGEDPEEKBIN PF NOERRORFLG)) - (\PAGEDBACKFILEPTR PF)) - (\PEEKBIN PF NOERRORFLG))] + (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PF) + 256) + (\PAGEDPEEKBIN PF NOERRORFLG)) + (\PAGEDBACKFILEPTR PF)) + (\PEEKBIN PF NOERRORFLG))] -(* ;;; "Move all the relevant fields from the backing file's stream into the text stream, so that microcoded BINs will do the right thing.") +(* ;;; "Move all the relevant fields from the backing file's stream into the text stream, so that microcoded BINs will do the right thing.") - (freplace (STREAM CPPTR) of STREAM with (ffetch (STREAM CPPTR) of - PF)) - (freplace (STREAM CPAGE) of STREAM with (ffetch (STREAM CPAGE) of - PF)) - (freplace (STREAM COFFSET) of STREAM with (ffetch (STREAM COFFSET) - of PF)) + (freplace (STREAM CPPTR) of STREAM with (ffetch (STREAM CPPTR) of PF)) + (freplace (STREAM CPAGE) of STREAM with (ffetch (STREAM CPAGE) of PF)) + (freplace (STREAM COFFSET) of STREAM with (ffetch (STREAM COFFSET) of PF)) (freplace (STREAM EPAGE) of STREAM with 32767) - (freplace (STREAM CBUFSIZE) of STREAM with (IMIN (ffetch (STREAM CBUFSIZE) - of PF) - (IPLUS (ffetch - (STREAM COFFSET) - of PF) - BYTESLEFT))) - [freplace (TEXTSTREAM CHARSLEFT) of STREAM with - (IDIFFERENCE BYTESLEFT - (IDIFFERENCE (ffetch - (STREAM CBUFSIZE) - of STREAM) - (ffetch (STREAM - COFFSET - ) - of STREAM] + (freplace (STREAM CBUFSIZE) of STREAM with (IMIN (ffetch (STREAM CBUFSIZE) of PF) + (IPLUS (ffetch (STREAM COFFSET) + of PF) + BYTESLEFT))) + [freplace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE BYTESLEFT + (IDIFFERENCE (ffetch (STREAM + CBUFSIZE + ) + of STREAM) + (ffetch (STREAM COFFSET) + of STREAM] (freplace (TEXTSTREAM REALFILE) of STREAM with PF) (replace (TEXTSTREAM FATSTREAMP) of STREAM with FATP) - (* ; - "Mark the stream, if it contains fat characters for this piece.") + (* ; + "Mark the stream, if it contains fat characters for this piece.") (replace (STREAM BINABLE) of STREAM with (NOT FATP)) - (* ; - "A stream that has fat chars can't use the micrododed BIN.") - (* ; - "And return the next character in line") + (* ; + "A stream that has fat chars can't use the micrododed BIN.") + (* ; + "And return the next character in line") (RETURN CH]) (\TEDIT.TEXTBIN.NEW.PAGE - [LAMBDA (STREAM SPLITCHAR) (* ; "Edited 11-Jun-99 15:10 by rmk:") - (* ; "Edited 11-Jun-99 15:10 by rmk:") - (* ; "Edited 11-Jun-99 15:01 by rmk:") - (* ; "Edited 11-Jun-99 15:01 by rmk:") - (* ; "Edited 11-Jun-99 14:18 by rmk:") - (* ; "Edited 31-May-91 14:21 by jds") + [LAMBDA (STREAM SPLITCHAR) (* ; "Edited 11-Jun-99 15:10 by rmk:") + (* ; "Edited 11-Jun-99 15:10 by rmk:") + (* ; "Edited 11-Jun-99 15:01 by rmk:") + (* ; "Edited 11-Jun-99 15:01 by rmk:") + (* ; "Edited 11-Jun-99 14:18 by rmk:") + (* ; "Edited 31-May-91 14:21 by jds") - (* * Handle crossing a file-page boundary within TEXTBIN) + (* * Handle crossing a file-page boundary within TEXTBIN) - (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte - character, and only need to read the second byte. - Otherwise, this function will read 2 bytes for a fat character.) + (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte + character, and only need to read the second byte. + Otherwise, this function will read 2 bytes for a fat character.) (PROG ((FILE (fetch (TEXTSTREAM REALFILE) of STREAM)) - CH) (* Get the STREAM which describes - the file for real) + CH) (* Get the STREAM which describes the + file for real) [COND ((IEQP (fetch (STREAM ACCESSBITS) of FILE) - NoBits) (* The file was closed for some - reason; reopen it.) + NoBits) (* The file was closed for some + reason; reopen it.) (SETQ FILE (\GETSTREAM [OPENFILE (fetch (STREAM FULLNAME) of FILE) 'INPUT NIL '((TYPE TEXT] 'INPUT] - (replace (STREAM COFFSET) of FILE with (fetch (STREAM CBUFSIZE) - of FILE)) - (* Force it to do a page switch for - us) - (SETQ CH (\BIN FILE)) (* Get the next character in the - usual manner) + (replace (STREAM COFFSET) of FILE with (fetch (STREAM CBUFSIZE) of FILE)) + (* Force it to do a page switch for us) + (SETQ CH (\BIN FILE)) (* Get the next character in the usual + manner) (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) of FILE)) - (* Steal the fields we need to - simulate that stream) - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) - of FILE)) + (* Steal the fields we need to + simulate that stream) + (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) of FILE)) (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) of FILE)) - (replace (STREAM CBUFSIZE) of STREAM with (IMIN (fetch (TEXTSTREAM - CHARSLEFT) + (replace (STREAM CBUFSIZE) of STREAM with (IMIN (fetch (TEXTSTREAM CHARSLEFT) of STREAM) + (fetch (STREAM CBUFSIZE) of FILE))) + (* Can't read farther than + end-of-piece, tho) + (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE (fetch (TEXTSTREAM CHARSLEFT) of STREAM) - (fetch (STREAM CBUFSIZE) - of FILE))) - (* Can't read farther than - end-of-piece, tho) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE (fetch - (TEXTSTREAM - CHARSLEFT) - of STREAM) - (fetch (STREAM - CBUFSIZE - ) - of STREAM))) + (fetch (STREAM CBUFSIZE) of STREAM))) (COND [(AND (fetch (TEXTSTREAM FATSTREAMP) of STREAM) (NOT SPLITCHAR)) - (* This piece contains fat characters. Need to grab a second byte from the - file, and construct a 16-bit character) + (* This piece contains fat characters. Need to grab a second byte from the file, + and construct a 16-bit character) (RETURN (LOGOR (UNFOLD CH 256) (\PAGEDBIN STREAM] - (T (* Regular, 8-bit characters. - Just return the one we BINned.) + (T (* Regular, 8-bit characters. + Just return the one we BINned.) - (* or we only need the second byte, since the first byte was on the prior page.) + (* or we only need the second byte, since the first byte was on the prior page.) (RETURN CH]) ) @@ -2538,29 +2412,27 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ELSE BYTE]) (\TEDIT.PEEKBIN.NEW.PAGE - [LAMBDA (STREAM NOERRORFLG) (* ; "Edited 11-Jun-99 15:11 by rmk:") - (* ; "Edited 31-May-91 14:21 by jds") + [LAMBDA (STREAM NOERRORFLG) (* ; "Edited 11-Jun-99 15:11 by rmk:") + (* ; "Edited 31-May-91 14:21 by jds") - (* * Handle crossing a file-page boundary within \TEXTPEEKBIN) + (* * Handle crossing a file-page boundary within \TEXTPEEKBIN) - (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte - character, and only need to read the second byte. - Otherwise, this function will read 2 bytes for a fat character.) + (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte + character, and only need to read the second byte. + Otherwise, this function will read 2 bytes for a fat character.) (PROG ((FILE (fetch (TEXTSTREAM REALFILE) of STREAM)) - CH) (* Get the STREAM which describes - the file for real) + CH) (* Get the STREAM which describes the + file for real) [COND ((IEQP (fetch (STREAM ACCESSBITS) of FILE) - NoBits) (* The file was closed for some - reason; reopen it.) + NoBits) (* The file was closed for some + reason; reopen it.) (SETQ FILE (\GETSTREAM [OPENFILE (fetch (STREAM FULLNAME) of FILE) 'INPUT NIL '((TYPE TEXT] 'INPUT] - (replace (STREAM COFFSET) of FILE with (fetch (STREAM CBUFSIZE) - of FILE)) - (* Force it to do a page switch for - us) + (replace (STREAM COFFSET) of FILE with (fetch (STREAM CBUFSIZE) of FILE)) + (* Force it to do a page switch for us) [SETQ CH (COND [(\EOFP FILE) (COND @@ -2571,29 +2443,20 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor 256) (\PAGEDPEEKBIN FILE NOERRORFLG)) (\PAGEDBACKFILEPTR FILE))) - (T (\PEEKBIN FILE NOERRORFLG] (* Get the next character in the - usual manner) + (T (\PEEKBIN FILE NOERRORFLG] (* Get the next character in the usual + manner) (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) of FILE)) - (* Steal the fields we need to - simulate that stream) - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) - of FILE)) + (* Steal the fields we need to + simulate that stream) + (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) of FILE)) (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) of FILE)) - (replace (STREAM CBUFSIZE) of STREAM with (IMIN (fetch (TEXTSTREAM - CHARSLEFT) + (replace (STREAM CBUFSIZE) of STREAM with (IMIN (fetch (TEXTSTREAM CHARSLEFT) of STREAM) + (fetch (STREAM CBUFSIZE) of FILE))) + (* Can't read farther than + end-of-piece, tho) + (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE (fetch (TEXTSTREAM CHARSLEFT) of STREAM) - (fetch (STREAM CBUFSIZE) - of FILE))) - (* Can't read farther than - end-of-piece, tho) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE (fetch - (TEXTSTREAM - CHARSLEFT) - of STREAM) - (fetch (STREAM - CBUFSIZE - ) - of STREAM))) + (fetch (STREAM CBUFSIZE) of STREAM))) (RETURN CH]) ) @@ -2605,8 +2468,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (CGETTEXTPROP [LAMBDA (TEXTOBJ PROP) (* ; "Edited 20-Oct-87 12:36 by jds") - - (* ;; "compiles calls on TEXTPROP that are fetching values. This needs to be changed whenever GETTEXTPROP is changed.") + + (* ;; "compiles calls on TEXTPROP that are fetching values. This needs to be changed whenever GETTEXTPROP is changed.") (SELECTQ PROP ((READONLY READ-ONLY) @@ -2615,7 +2478,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor ',PROP]) (CTEXTPROP - [LAMBDA (FORMTAIL) (* ; "Edited 31-May-91 13:59 by jds") + [LAMBDA (FORMTAIL) (* ; "Edited 31-May-91 13:59 by jds") (* ;; "compiles calls to TEXTPROP") @@ -2657,7 +2520,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (CADDR FORMTAIL]) (GETTEXTPROP - [LAMBDA (TEXTOBJ PROP) (* ; "Edited 9-Feb-89 11:20 by jds") + [LAMBDA (TEXTOBJ PROP) (* ; "Edited 9-Feb-89 11:20 by jds") (* ;; "Gets values for document properties. Used by TEXTPROP.") @@ -2672,9 +2535,9 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor PROP]) (PUTTEXTPROP - [LAMBDA (TEXTOBJ PROP VALUE) (* ; "Edited 9-Feb-89 11:19 by jds") + [LAMBDA (TEXTOBJ PROP VALUE) (* ; "Edited 9-Feb-89 11:19 by jds") (* ; - "put a value on prop list for a textobj") + "put a value on prop list for a textobj") (SELECTQ PROP ((READONLY READ-ONLY) (PROG1 (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) @@ -2695,7 +2558,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor NIL]) (TEXTPROP - [LAMBDA X (* ; "Edited 9-Feb-89 11:20 by jds") + [LAMBDA X (* ; "Edited 9-Feb-89 11:20 by jds") (* ;; "general top level entry for both fetching and setting window properties.") @@ -2730,28 +2593,26 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor (ADDTOVAR LAMA TEXTPROP) ) -(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 (2991 53769 (COPYTEXTSTREAM 3001 . 6123) (OPENTEXTSTREAM 6125 . 21392) (REOPENTEXTSTREAM - 21394 . 21816) (TEDIT.STREAMCHANGEDP 21818 . 22116) (TEXTSTREAMP 22118 . 22432) (TXTFILE 22434 . -22879) (\DELETECH 22881 . 34137) (\SETUPGETCH 34139 . 41418) (\TEDIT.REOPEN.STREAM 41420 . 43270) ( -\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43272 . 45710) (\TEXTINIT 45712 . 51662) (\TEXTMARK 51664 . 52412) ( -\TEXTTTYBOUT 52414 . 53767)) (53770 79202 (\INSERTCH 53780 . 77506) (\INSERTCR 77508 . 79200)) (79268 -99584 (\CHTOPC 79278 . 80467) (\CHTOPCNO 80469 . 81731) (\CLEARPCTB 81733 . 82529) ( -\CREATEPIECEORSTREAM 82531 . 85505) (\DELETEPIECE 85507 . 86420) (\FINDPIECE 86422 . 86788) ( -\INSERTPIECE 86790 . 89800) (\MAKEPCTB 89802 . 91717) (\SPLITPIECE 91719 . 98678) (\INSERT.FIRST.PIECE - 98680 . 99582)) (99636 123874 (\TEXTCLOSEF 99646 . 100873) (\TEXTCLOSEF-SUBTREE 100875 . 101581) ( -\TEXTDSPFONT 101583 . 102575) (\TEXTEOFP 102577 . 103936) (\TEXTGETEOFPTR 103938 . 104148) ( -\TEXTGETFILEPTR 104150 . 106213) (\TEXTOPENF 106215 . 107045) (\TEXTOPENF-SUBTREE 107047 . 107848) ( -\TEXTOUTCHARFN 107850 . 108198) (\TEXTBACKFILEPTR 108200 . 114101) (\TEXTBOUT 114103 . 117451) ( -\TEDITOUTCCODEFN 117453 . 118719) (\TEXTSETEOF 118721 . 119230) (\TEXTSETFILEPTR 119232 . 120457) ( -\TEXTDSPXPOSITION 120459 . 121316) (\TEXTDSPYPOSITION 121318 . 121863) (\TEXTLEFTMARGIN 121865 . -122348) (\TEXTRIGHTMARGIN 122350 . 123286) (\TEXTDSPCHARWIDTH 123288 . 123526) (\TEXTDSPSTRINGWIDTH -123528 . 123768) (\TEXTDSPLINEFEED 123770 . 123872)) (123875 161712 (\TEXTBIN 123885 . 144764) ( -\TEDIT.TEXTBIN.STRINGSETUP 144766 . 150479) (\TEDIT.TEXTBIN.FILESETUP 150481 . 156867) ( -\TEDIT.TEXTBIN.NEW.PAGE 156869 . 161710)) (161713 177475 (\TEXTPEEKBIN 161723 . 173216) ( -\TEDIT.PEEKBIN.NEW.PAGE 173218 . 177473)) (177513 182731 (CGETTEXTPROP 177523 . 177999) (CTEXTPROP -178001 . 180345) (GETTEXTPROP 180347 . 180942) (PUTTEXTPROP 180944 . 182269) (TEXTPROP 182271 . 182729 + (FILEMAP (NIL (2896 51935 (COPYTEXTSTREAM 2906 . 5645) (OPENTEXTSTREAM 5647 . 20914) (REOPENTEXTSTREAM + 20916 . 21342) (TEDIT.STREAMCHANGEDP 21344 . 21646) (TEXTSTREAMP 21648 . 22062) (TXTFILE 22064 . +22517) (\DELETECH 22519 . 32935) (\SETUPGETCH 32937 . 39715) (\TEDIT.REOPEN.STREAM 39717 . 41542) ( +\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 41544 . 44016) (\TEXTINIT 44018 . 49968) (\TEXTMARK 49970 . 50722) ( +\TEXTTTYBOUT 50724 . 51933)) (51936 77485 (\INSERTCH 51946 . 75777) (\INSERTCR 75779 . 77483)) (77551 +96475 (\CHTOPC 77561 . 79013) (\CHTOPCNO 79015 . 80169) (\CLEARPCTB 80171 . 80955) ( +\CREATEPIECEORSTREAM 80957 . 84017) (\DELETEPIECE 84019 . 84938) (\FINDPIECE 84940 . 85312) ( +\INSERTPIECE 85314 . 88080) (\MAKEPCTB 88082 . 89908) (\SPLITPIECE 89910 . 95647) (\INSERT.FIRST.PIECE + 95649 . 96473)) (96527 118502 (\TEXTCLOSEF 96537 . 97751) (\TEXTCLOSEF-SUBTREE 97753 . 98463) ( +\TEXTDSPFONT 98465 . 99461) (\TEXTEOFP 99463 . 100526) (\TEXTGETEOFPTR 100528 . 100742) ( +\TEXTGETFILEPTR 100744 . 102676) (\TEXTOPENF 102678 . 103448) (\TEXTOPENF-SUBTREE 103450 . 104186) ( +\TEXTOUTCHARFN 104188 . 104479) (\TEXTBACKFILEPTR 104481 . 110030) (\TEXTBOUT 110032 . 112586) ( +\TEDITOUTCCODEFN 112588 . 113699) (\TEXTSETEOF 113701 . 114216) (\TEXTSETFILEPTR 114218 . 115451) ( +\TEXTDSPXPOSITION 115453 . 116313) (\TEXTDSPYPOSITION 116315 . 116862) (\TEXTLEFTMARGIN 116864 . +117286) (\TEXTRIGHTMARGIN 117288 . 118036) (\TEXTDSPCHARWIDTH 118038 . 118215) (\TEXTDSPSTRINGWIDTH +118217 . 118396) (\TEXTDSPLINEFEED 118398 . 118500)) (118503 153841 (\TEXTBIN 118513 . 139392) ( +\TEDIT.TEXTBIN.STRINGSETUP 139394 . 144358) (\TEDIT.TEXTBIN.FILESETUP 144360 . 149881) ( +\TEDIT.TEXTBIN.NEW.PAGE 149883 . 153839)) (153842 168715 (\TEXTPEEKBIN 153852 . 165345) ( +\TEDIT.PEEKBIN.NEW.PAGE 165347 . 168713)) (168753 173973 (CGETTEXTPROP 168763 . 169223) (CTEXTPROP +169225 . 171573) (GETTEXTPROP 171575 . 172174) (PUTTEXTPROP 172176 . 173507) (TEXTPROP 173509 . 173971 ))))) STOP diff --git a/library/TEXTOFD.LCOM b/library/tedit/TEDIT-TEXTOFD.LCOM similarity index 55% rename from library/TEXTOFD.LCOM rename to library/tedit/TEDIT-TEXTOFD.LCOM index f34f768b1c7214ed6d0458ba99524720c19811bd..89c8e8e72b3e6d96cedf64269c3d1e41bfaaac6b 100644 GIT binary patch delta 7693 zcmaJ`3v650c_t~#58AQypkzsLtYamysmxaHi@cYVW0N8;Em{;WO;S(GrtMIPUXfkL z&K~i=I4!ayp3~SjHQITtTes;}tXL&8YS(rRvlZAPH_c-Y%)^!r!)6R9FhE%`VC@ii z-#O=A^2&B67}x)QUjKjo|3Cl#ox^`Ad#)^bULWy^%ASK~=k`c~BoR>!3qn{{FU_`Z zKKtzC>1X%N9zQjAe16}Y`Kfzn>C9wt`pmw(9#7`?T))y8HOC8UvXCaVu8jiKD0IF|R`wY(S>w6GxlKg+kz zPyXh8B}nBS&*$B4ulaV}J0-8b+iPU>G&Nf;pVgy-Bplbg{tO8ONW#bt5>QH&l1WZa zrD>Z)GFc-t98FP1WK23bsDo29k{L;+!m!Rlm(0 zFfY~{LXh;0#-dq0PZA`clDM9T4yE#JDjGC0!8)_BbvIf63$4!FwRXEF(q$f4`k*> z!4*p@Q!CA$x}|rFVK&!D_}Xk8jN$itY&Z`woBX2S!SZSojlGw zwy)qMZado#g|IJDF~V$^?Ha`%eT)j~j25qyY*qKd9(#T3E5&Kw=E}$^)?C8w-?P_>-AJoE~)p2C*l- zk95gtrgpi-j+F%8q|2vNqBlB?RQW-xX9~$S3Of!Xep%2hwAnT-9J^{yKjur-f_Y}P z16hlQ({O{!FG*UEOyu3(wK&K@(nn%q?k>wSrCx$AV*U=up%27*BXI+;FzVF4xJ z)LRV5wCqyV`i7FJcn>SJqN0Y#1mJ<5O-EC+SpkN zvf^)$IHm@}8E@_TNF$BODH`2Qh#UVH!!$CN7M#Reifwfo<2|#lWUJHq&&lpO_ z^U*%)ehtxL+eXx23>=7RAN&WH$_)p*(UI9fHW2}>0Yz4MuyW0Eq9%!KAtRll&J!In zR7o=5X>Kj4I4o7cLDJ<|c8c>BBrG>sUkI2tvX zB-5E8+K;VeqWOM?o5g^Xu7P88!n4&?70k9zu%aq}=p4P`!V-kMxIPRDdq-rm+YdM? zWV&10k0{7Cj#g2sEh?)H2{N2$OOR!!1Q}t=CCGwPf}~Li50;$kOR8gi$#EP+q{NzJ zG32nAh-_NjDDFNECg@mA#Cft66mc5us4S(4D8iXGPg%s5gB1{7PB!QeE&%vfg$s(q z;{q-iwH~D68YAMg@~cuvlgy9nx0XVxO3tmROAO|78Jyy=jQ;RB5(?JV4&la8y9b3} zV0Q5c;WTps-sXfL5Pn(Gpc-q^pcXyjRx_?fyjiF&?r(cF3)-S`9wf?7YS>pzh zLJ}V!1wxJi)qa{IGe#13(=4hXZk0AojcL;`2iDH_Cv&M}TDMjf5&iIs`Q5E&n_w9~ zZDyP9CP7UwpJ@ASTz|jUwto%1{+hpPyV>aV*IbN?JzD?1y&r?NceL_BTF0ISufJ+d zHl}>GqoLmIEx*)x-QDc<;|{Blt|zBYKY4cU_-VWklzVqPTZjJdJn}7i-yYj}6yHDF z`6<5N-IZv;3{fP0hj!hV)9AlQ2Vd)c6JPx?KjzOr_I>vzddVgNi3&IgWqJ451L(dO z>So%Ne-PS1C;fByuotT$({)kt(cX*h((%V#t~GrO2{L%~7A_3y4slF=h5z@$EdL*v z@72gn4=~s_dBbPH{oY)B<*nx;jfd*{i>&WW29eLdTld4&4a=@SA9&`@t^T<+3@hFG z0qZtXPc(KO{G|NQ;1^N@AHM5)F*Wd)V{>;tc_X>Bar&i!*;|Jf{;m8wPyBFg2e8Qf zzUj#k_1P+);jO!Ezh;jf7V3eNC zXOemh^+m>kn#g5R$!ddu8k0%ULl&a|4&lQZaLNIcz#?aFiKW7v$C^m(z$FisK*$Ui z&{rf;z$_3(%$_F%Q4WXtEH(sX9UPADM65q=;9Wz*NtsCFRuu#OK;2%Yt_l%O2elQlzyH?qkC{S=8K7?SfPyfU6aB%xAeC-Kzy z@9R5VBBqIkW!M~V+>4BTB~Y7!JkuvZef4kerd1z5&vmJ!-E3D?`CS{o3o zT3>?OtpO5hm_-7q)MSftbqyS$TDt)EAe&=KDOSzp0;&UFBvh40>#4nykj%;p8)D^u z&EaMZ0M{O>ISimdhiW@w-KJI8G8HZ5tmL3pU8P!ulhxR2+^HzxTswN{vZ$()0-+#z zl;C-h;RC0NfvVpFh;KemL9|&^380+^q=L(V6=+H|KomeRTVd*(Dh;s4SCAZGPw%HS zz$!UVvEjW z+?~$4*PEsEc8|N;yq10p%*}MC`)B6Q(>u025n(S4)9eYeyaz8$EnU2c6(z@OQ>1}E zNL`LBJa6_If_XUIQhK|XX74r)4VA*?#)kFA=Hk0e^DC~~Q-3qR<<9MY|0$koH_tWA z-uiIrZ-44)F47l{QU3lEUD`0x#7d)YQ$H)WefPYT`WpK2fS@3t?YlExx{<$abZ7pf zvB?t%A~Ci`;2A6H$vEhP16CEGwa9Uyr-&Q3Ty)~;p51UI85tN&=9z z!Y>N+V66tI3VlsyS*Vr(WMnUX0;>m50)Dn)3KcjE@35DEJ=WER!u)$1fmY~sN5ZMc zZD$j%JCZE%i;uaK(SWyzglMi|pUa2Z5g{FizJ%{vhxYI|xqaw3M$$ALV^1p_b&X`3 zJQy{T|0Ww%_6?W?f$L(@A6898;sEjP_ zKZa*0{+Mm<9oxS{SyeoNTUV80?7$>%wCK3pR{iI|<~<4A_j@Qfhn}c|_Mrq$w#;11 zGPrR9ptd1V-0c>&M|0Eo3e^5|Ji`rf=!0{L+B?BFZ1x`c8Q6}a&-30d z9SwKDYPCaa-&gq3|9SM682ulGGkkR6*fp?sjuFm2eEcuK-adYSv%-mSuoq5rGPeAu zCwvsp{&@0rYT^9T88B}?{S(T3X8N;y%KuEi*ADUQor(UQv|9SdGrz*%TeHCjD9UD6 z(|9g3YA(+`Waj6$ng{15smrT5o9q0}T=_n&pL^yxto6UobaBBu=4lH0#k>_fkDNTR z-bylF^Oci@8nbe;bwiSf1TSPmy4iTDrwtNCcC7-ejAfGXj zxODC_o_enzh0Xl%l@@bbN#L^G&$X4ON)k21)fYaZ&>pV>cR_pe{P_-dp!|pDUs~%4 z3gt&${v$g4y;pAkn&E%->Us3{Ul_pmjSCV?{nrA4M8J}2l1O};CfmKm@{)ScH%PUF0!ZQIOyFd%MD*{X{FR_AR?B1hT9}Xyph=NV33= zJ+WtP+=){Mip{e)x z{_ef+?LJ|r4D)o(z4zR6?m6e)^SgInU-SK>?0b34Pvk>GPb?gg1W6)-5R%o9V!SfH zYuo7gnU(WL=BJhyrWTK+th3(zrF{Hk-b}>$`X#BCbl)Q=86h#)O`6WE%uFwxTRyum zQzSD_Ew7w^FhnM(WHO!1le3GYJ29F{5w~<-Utc#VPF;Y+XUr<8-MvkLL^7ququF>k zACG-%6f+vSzZlC6KYRH9x15NEtOyDTMF+#_WAWUfyh#FybdEGtt?VVCOg4TZX^!R& z#h?)Sq?(f?86FC$+ON>JG(EL&Q3wXbvH`Qf!<~_6Hn7&xjYs+LP9a4DUczmOcG{xgn*K<^;%RGPL4B$G8W zC&DQ(N{}(>@JO6;8p(_$(=l_5GAhZ0v*DC!4(BMVkZ39%&K`^Bk5aZIGf7HH#ALQc zhA1Zzmqp;AE{b*;nxgp#r3`8cC3IMq&QnTbLS|&BkL&M)dC3^>Lr^i zTD{fSxYtLBwZHLz_j&7hGgr3+0y@hkd2)7;F9(=VN>@A$Bn3HvDySJMOHbbfB&*((A4%&Rr>Pc^*hzZOyW^oJcs+gyJzQSpU;m>4c z_1n(KwfzoN_uCG|4E&12t<{e$&zcc7O<@S8FqJ)pamPS&ytKCMG}SV;z*frS3*%;l zasE(c@cK>9F9x_3u(B}Of!veNv2}PR!58S0DLgO8o$Yx zb^Yeua|56EAOIeg7E4r^QOKc67yGUPykPh@SBhu-+bUy=tho?EW61Bv4qowZ z#dp!)L#5i$#c{5_dL%!%@bzI7U%u* z*bX;6-?B&F@gtLOm?y9$->{p^6GfR^UwdL6>)+TkJ`caRn{MSQb8wj5H0Q79B-YQ2 zf=BHx&SHyk8|)b03AN0v-|CoOZTFfdeBK|f{;qfR@~u@$um1jAVSsL26Tx+a-ow$y zX=ZkLhm$K2dyR;D_*R!$8Z6&$cg^DD48xIGGr^K>wZrjgVd9!2KH-N$o$Q{Q@5CX* z(<$5H2}lwO$wV%mAI+eUL6E4qh{t5tzn{}>2^`dgpb8()eYx~s0)%^Yx+0>A)=;3ESb)YX5)5+6*X10R$F%O z(-gx|$LbTSxP2$$*<|7r1Z9nmDro{HfWeV)E}lr9%n(sEWD=)k9G0nsLIE2Fh^nX% z(8=^M3{!%#dv&5>&P1UL|GH;sU=-w?Vm%@M2Dm(ux5`> zRIH!w-BB+}LeTngY;RpKs9H^}yM2ac1zNkdiM6?ckQi<4+Cwo(I&Ztf&}CNeX=x|A z9<*L*-7yL?xm}rTawMERHAZy6lZkK!D~m~B5Vk4g^-D)DGOX{OPKJaMstuGWSM z8bdYCP(d{a@M4xof(n@9mQrMriYM~u;XtS=B5fQe7?yYY!IE307~C+I7!=(~#h{?M zG$D%tfy{Id64Ef(+#p;wBY8zYyjt2C6dJmDIJp!tN7J!A#e+3!o)dK~$mTKADa20KTq-nOuztC{y`&+(t8;7cQ;iX8 zp#?aWNCZeY&bG0r23=CB4T|aZRDpAyt*QcgnyDBXWsxM)nNix0m1V;DL57Nv5aAm1 z#dbnutLhaCr~X|fNyp(;RV8VzC`bUrRTUDDbd^EoxERBwTtpt%h5{Ce?gK&5zI+4)n=pbp;g=l)eq)0SBnsWdb~A#+ zn}wP&J$kU_Jsrk4R_d<3qDz9+w-b5HeM>Y^<7a>h&%pYsuWb8OES;SZDh{>J=vUx0 z)=zWpGx}vHV*N7Ci(3B~9KhT`5>k;LLWpo}K(${)05fJ1cgrlcB(7i%O`Yk`a0f*5 zgUMVfnU3?Bt)m@Jw&4mGpe*x6FVS?}`m2toz0Fp5*U@@4oEeBia35*^7H=hb{=YJ4pe>58q0S(TN=F0I*>(C#3@S9#(@Xz}v@s0HSFTMkT#12S^u-0X6FJ!I-F4Mui2X5f|{(%7G z|LefFy<3rl86uFdfI3)y`{1c&bnguHvNe@sp?y^7vHnMzFe{FbZmRy>{>$F>$%j0i zdVUXL5a}&o`%P(U@!^i}ivxFj08MXl*!=>y7Z+mdZ=D}#J>D=_WPLXnrhWdMy7?b{ zXJgZC&mRq2?>tQQ%>VF_p^wWQBd?`~|Mnfv#nkY3Pc7X2_}0&oYYk_gD{ngTokp+3 z3$`KYDA@b_3K`ANr;1FJ9+o*o8K+chynT{_h4DD8%c6`klVX;5HlInxqbL9}HpE0O zlS)<_1c78TDY{9b6g!C$wgVavHlPo%I9oW4`6z;FYQ4V%LSRKZjCUPTfCLCL>c|Kh zPLI)u%?43~TpYIEM07B3;!VLomQSRkW;zORfC96@R2?eZhUv&w+pZD})8(37DiDF& z02Pp@rcuRd?4C%$yT}F}GdUhpB-v2{9g2uU(neu2u$paOpY@HzwjM0QcC!o!XpCDM9j)h9j+yJC$8h{*-tfLTnLo`sS?6?`2)gf`-IcF5= za&-&Rs_fc%I*hj^boe}*JT}OHtw55Cc<8%8#F7Tcn4Q6M-}DS%Dnpg_X{|w>Gfb0Q z1w{iwiOnp`T!4g%Gp1??JqT@es;*Z_WP;O*Ty#jBtRPD?AyxNjL1C{wMxiK==d5D5 z^eBjJRjJ~}8Z@r89Y!_k(l38DZqIR?|%RB3DvK7-^+dr22uppo7Uo$%)Ft?S4M=0Sd$I;eO6;PW=biPf`KS_KbWP?CMB_ zv;R5r(B|fJGQ}$5q4aLAZVjd5o%U&%AjUnytwnR!mKOffb9G?#r1gDM*g4tSvMF7B zr)_cF^U>`07Vo?J(ZBpnTP1BhoavNXSS9jr9b^v^5$9R3ja{z&ErYmS%kW3_9x3aZ z_2IaGACd8X?wnD$2#*Zg%aL%;q!(A~lgvmFfB>gBvUMYvlaU`hY;rX%B&5JSX)WOz zVMiB7KZW!X5}G4=3E2mYcp|s{{kU<6mS=3f4OO4s?lzzn5i+!bTiNVyAwK_>J;dX) zCpQJ?f^@*WnU+qDLayZ6d>D0o^i4LZoI3Fk1q08Fg*g9*W4}lF!l`HQ{qd+w!4)A-%rOFS8$&*N<+-q|ek^1xa@d+W+sljBDz=x~)t+&VTCJJgA{$9Lj2{O`s| zusPsDq1AIAkMvGnV^iMiWR97|LUg8j8e70ymS`UBcK$ya1OIr&du zM+;x%y+0^~z}|Oy2WJDPe*w08>H=rqnED#n&>6zn$uoZnmP{Yx?ELgN*uR|aVr=Hba~kg)Ik(%ovb5WJ z>D&wrRrLg5tGv2c{&b`D=ZjBbhW@2)KEu=!-Ldkr9rNPyqqRMGd$~|!gvZ;rq)0#{ zc!wE{_gd!TeH~EAFB!m9(QGo4H?urRUVHrQEtod<>{DFJ*B{$e{?}(u(!>crm*j0n zztB;B^Ertw_D9cuK=COaBsOF!QnGTf(<_z#;o_GXeUel@^Bdow!<)YH(XSX@f9ZMj zf9cXNzTdkf!JQ44&r*@4-~0&Q(JP1Xy?W($@ReVFiO`b=_h6bX?0ts)s)R*K_9Dyw z_;Q#^@433lZT{fuwYYO+1@J>yK7T5T2Noc}JWskr415kh%4IX*t)1O8+$ zKh_^xNA_q+Z!ZZn@#a9v3{&AuuRWsk)lfTsCE^kaplan>Local>medley3.5>my-medley>library>TFBRAVO.;4 74716 +(FILECREATED "14-Jul-2022 17:00:58"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;1 72340 - :CHANGES-TO (FNS TEDITFROMBRAVO) - - :PREVIOUS-DATE "13-Jun-2021 09:46:34" -{DSK}kaplan>Local>medley3.5>my-medley>library>TFBRAVO.;3) + :PREVIOUS-DATE "14-Jul-2022 11:25:23" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-TFBRAVO.;2) -(* ; " -Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS) -(PRETTYCOMPRINT TFBRAVOCOMS) - -(RPAQQ TFBRAVOCOMS - [(FILES TEDITDCL) +(RPAQQ TEDIT-TFBRAVOCOMS + [(FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) [DECLARE%: EVAL@COMPILE DONTCOPY (COMS (* ; "Compile-time needs") (RECORDS FONT PARA RUN TFBRAVOPAGEFRAMES) @@ -54,7 +49,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. TEDITFROMBRAVO)) (\NAMEDTAB.INIT]) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -66,7 +61,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -115,22 +110,20 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (\TFBRAVO.FIND.LAST.TRAILER - (LAMBDA (FILE) (* jds "27-Dec-84 19:13") - - (* scans backwards from the end of the file trying to find the beginning of the - last Bravo trailer. Returns NIL if not found, otherwise T) + [LAMBDA (FILE) (* jds "27-Dec-84 19:13") + + (* scans backwards from the end of the file trying to find the beginning of the + last Bravo trailer. Returns NIL if not found, otherwise T) (PROG ((STREAM (GETSTREAM FILE))) (SETFILEPTR STREAM -1) (RETURN (COND - ((IGREATERP (GETFILEPTR STREAM) + [(IGREATERP (GETFILEPTR STREAM) 0) (COND ((NEQ (\BACKBIN STREAM) - (CHARCODE CR)) - - (* last character of a trailer must be a carriage return) - + (CHARCODE CR)) (* last character of a trailer must be + a carriage return) NIL) (T (while (AND (IGREATERP (GETFILEPTR STREAM) 0) @@ -140,27 +133,27 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. ((EQ (\PEEKBIN STREAM) (CHARCODE ^Z)) (* this is a potentially legal trailer) T) - (T NIL))))) + (T NIL] (T (* empty files are not Bravo files.  It says here!) - NIL)))))) + NIL]) (\TFBRAVO.HANDLE.HEADING - [LAMBDA (INPUT TEXTOBJ) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (INPUT TEXTOBJ) (* ; "Edited 31-May-91 15:26 by jds") (* Called from - \tfbravo.parse.profile.para) + \tfbravo.parse.profile.para) (DECLARE%: USEDFREE NEXTPARAPTR) (PROG ((AFTERHEADINGPTR) PARALOOKS HEADINGDESC) (SETFILEPTR IN NEXTPARAPTR) (* skip over the trailer of the - profile para) + profile para) (SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.PARALOOKS IN)) (SETQ AFTERHEADINGPTR (GETFILEPTR IN)) (SETQ PARALOOKS (fetch PARALOOKS of HEADINGPARA)) (replace (FMTSPEC FMTPARATYPE) of PARALOOKS with 'PAGEHEADING) (* This is where the vertical tab info is placed for the heading, remove the - special x and y and use them as the position for the descriptor) + special x and y and use them as the position for the descriptor) (SETQ HEADINGDESC (LIST (GENSYM 'PageHeading) (OR (fetch (FMTSPEC FMTSPECIALX) of PARALOOKS) @@ -177,36 +170,35 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (RETURN HEADINGDESC]) (\TFBRAVO.INIT.CHARLOOKS - [LAMBDA NIL (* ; "Edited 31-May-91 15:25 by jds") + [LAMBDA NIL (* ; "Edited 31-May-91 15:25 by jds") (* * Creates the charlooks instance which is used as the template for the rest) (PROG ((LOOKS (create CHARLOOKS))) (replace (CHARLOOKS CLSIZE) of LOOKS with (\TFBRAVO.GET.FONTSIZE 0)) (replace (CHARLOOKS CLNAME) of LOOKS (\TFBRAVO.GET.FONTSTYLE 0)) - (* (FONTCREATE ( - \TFBRAVO.GET.FONTSTYLE) - (fetch (CHARLOOKS CLSIZE) of LOOKS))) + (* (FONTCREATE (\TFBRAVO.GET.FONTSTYLE) + (fetch (CHARLOOKS CLSIZE) of LOOKS))) (replace (CHARLOOKS CLOFFSET) of LOOKS with 0) (RETURN LOOKS]) (\TFBRAVO.INIT.PAGEFORMAT - (LAMBDA (TEXTOBJ) (* gbn "31-May-85 17:13") - - (* * installs the default values of the page formatting nonsense as textprops) + [LAMBDA (TEXTOBJ) (* gbn "31-May-85 17:13") + + (* * installs the default values of the page formatting nonsense as textprops) (TEXTPROP TEXTOBJ 'PAGENUMBERS T) (TEXTPROP TEXTOBJ 'PAGENUMBERX 307) (TEXTPROP TEXTOBJ 'PAGENUMBERY 756) (TEXTPROP TEXTOBJ 'TOPMARGIN 72) (TEXTPROP TEXTOBJ 'BOTTOMMARGIN 72) - (TEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T))) + (TEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T]) (\TFBRAVO.INSTALL.PAGEFORMAT - [LAMBDA (TEXTOBJ) (* ; "Edited 13-Jun-90 01:00 by mitani") + [LAMBDA (TEXTOBJ) (* ; "Edited 13-Jun-90 01:00 by mitani") - (* * using the information from the profile paragraphs, this function installs - the pageframes) + (* * using the information from the profile paragraphs, this function installs + the pageframes) (PROG (PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS BETWEENCOLUMNS ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC HEADING.NOTONFIRSTPAGE @@ -214,75 +206,68 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. PAGEFRAMES) (for VAR in '(PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS - BETWEENCOLUMNS ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC - HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE - EVENHEADING.NOTONFIRSTPAGE ODDHEADING.NOTONFIRSTPAGE) - do (SET VAR (TEXTPROP TEXTOBJ VAR))) - (SETQ PAGEFRAMES (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (create - - TFBRAVOPAGEFRAMES - ))) + BETWEENCOLUMNS ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC + HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE EVENHEADING.NOTONFIRSTPAGE + ODDHEADING.NOTONFIRSTPAGE) do (SET VAR (TEXTPROP TEXTOBJ VAR))) + (SETQ PAGEFRAMES (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (create TFBRAVOPAGEFRAMES + ))) - (* this assumes that TEdit does not build a default page spec. - If it ever does, then this logic must change.) + (* this assumes that TEdit does not build a default page spec. + If it ever does, then this logic must change.) - (* * the default page frame is always built. - It is sometimes built as the only page frame when there is no headings - specified. However, if heading is specified with the not-on-first-page - specified, then we must build the default page frame simply for that reason) + (* * the default page frame is always built. + It is sometimes built as the only page frame when there is no headings specified. + However, if heading is specified with the not-on-first-page specified, then we + must build the default page frame simply for that reason) (replace (TFBRAVOPAGEFRAMES TFBRAVODEFAULT) of PAGEFRAMES with (TEDIT.SINGLE.PAGEFORMAT (AND PAGENUMBERS (NOT PAGENUMBER.NOTONFIRSTPAGE)) - PAGENUMBERX PAGENUMBERY NIL NIL 0 0 TOPMARGIN BOTTOMMARGIN - NUMBEROFCOLUMNS NIL BETWEENCOLUMNS [COND - (HEADINGDESC - (if HEADING.NOTONFIRSTPAGE - then NIL - else (LIST HEADINGDESC))) - (ODDHEADINGDESC - (if ODDHEADING.NOTONFIRSTPAGE - then NIL - else (LIST HEADINGDESC))) - (EVENHEADINGDESC - (if - EVENHEADING.NOTONFIRSTPAGE - then NIL - else (LIST EVENHEADINGDESC] - 'POINTS)) + PAGENUMBERX PAGENUMBERY NIL NIL 0 0 TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS + NIL BETWEENCOLUMNS [COND + (HEADINGDESC (if HEADING.NOTONFIRSTPAGE + then NIL + else (LIST HEADINGDESC))) + (ODDHEADINGDESC (if ODDHEADING.NOTONFIRSTPAGE + then NIL + else (LIST HEADINGDESC))) + (EVENHEADINGDESC (if EVENHEADING.NOTONFIRSTPAGE + then NIL + else (LIST EVENHEADINGDESC] + 'POINTS)) [COND ((OR ODDHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE) (replace TFBRAVOODD of PAGEFRAMES with (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL 0 0 - TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL BETWEENCOLUMNS - (COND - (ODDHEADINGDESC (LIST ODDHEADINGDESC)) - (HEADINGDESC (LIST HEADINGDESC)) - (T NIL)) - 'POINTS] + TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL BETWEENCOLUMNS + (COND + (ODDHEADINGDESC (LIST ODDHEADINGDESC)) + (HEADINGDESC (LIST HEADINGDESC)) + (T NIL)) + 'POINTS] [COND ((OR EVENHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE) (replace TFBRAVOEVEN of PAGEFRAMES with (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL 0 0 - TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL BETWEENCOLUMNS - (COND - (EVENHEADINGDESC (LIST EVENHEADINGDESC)) - (HEADINGDESC (LIST HEADINGDESC)) - (T NIL)) - 'POINTS] + TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL BETWEENCOLUMNS + (COND + (EVENHEADINGDESC (LIST EVENHEADINGDESC)) + (HEADINGDESC (LIST HEADINGDESC)) + (T NIL)) + 'POINTS] (RETURN]) (\TFBRAVO.PARSE.PROFILE.PARA - (LAMBDA (IN PARA TEXTOBJ) (* gbn " 3-Jun-85 17:23") - - (* * Parse a Bravo profile paragraph, and set up the corresponding TEdit page - looks, headings, page numbers, Much of the state for building the pageframe - must be stuffed on the textstream, so that after this fn has been called for - the last time, the pageframe can be built) + [LAMBDA (IN PARA TEXTOBJ) (* gbn " 3-Jun-85 17:23") + + (* * Parse a Bravo profile paragraph, and set up the corresponding TEdit page + looks, headings, page numbers, Much of the state for building the pageframe must + be stuffed on the textstream, so that after this fn has been called for the last + time, the pageframe can be built) (DECLARE%: USEDFREE NEXTPARAPTR) (PROG (TOKEN TOKENS (PARAEND NEXTPARAPTR)) - - (* * check that the positioning takes into account binding and edgemargin etc.) + + (* * check that the positioning takes into account binding and edgemargin etc.) (while (ILESSP (GETFILEPTR IN) PARAEND) @@ -295,10 +280,10 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (NO (TEXTPROP TEXTOBJ 'PAGENUMBERS 'NIL)) (YES (* this is default)) (FIRST (\TFBRAVO.ASSERT 'PAGE (pop TOKENS)) - - (* If a first page is specified, we can't handle that yet, but at least number - the first page, since the only way to number the first page in Bravo is to - specify the number for the first page. Not-on-first-page is assumed) + + (* If a first page is specified, we can't handle that yet, but at least number + the first page, since the only way to number the first page in Bravo is to + specify the number for the first page. Not-on-first-page is assumed) (TEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE 'NIL) @@ -314,10 +299,8 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. TOKENS))) (ROMAN (* tough, I don't do Roman Numerals) NIL) - (PROGN - - (* otherwise, just presume we've hit the end of the page number stuff) - + (PROGN (* otherwise, just presume we've hit + the end of the page number stuff) NIL)))) (COLUMNS (* parse the columns numbers stuff) (TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS (pop TOKENS)) @@ -342,10 +325,8 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (BINDING (TEXTPROP TEXTOBJ 'BINDING (  \TFBRAVO.PARSE.PROFILE.VALUE TOKENS))) - (PROGN - - (* otherwise, just presume we've hit the end of the page number stuff) - + (PROGN (* otherwise, just presume we've hit + the end of the page number stuff) NIL)))) (ODD (\TFBRAVO.ASSERT (pop TOKENS) 'HEADING) @@ -374,64 +355,61 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (PRIVATE (* private data stamp bull, ignore) NIL) (PROGN (* do nothing with this line,) - NIL))) - - (* The left margin is 0 for all bravo relative measurements) - + NIL))) (* The left margin is 0 for all bravo + relative measurements) (COND ((TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS) - - (* if this is to be printed multicolumn then determine the column width from - the numberofcolumns and the space between them) - (TEXTPROP TEXTOBJ 'COLUMNWIDTH (IQUOTIENT (IDIFFERENCE - (IDIFFERENCE (CONSTANT (TIMES 8.5 PTSPERINCH + (* if this is to be printed multicolumn then determine the column width from the + numberofcolumns and the space between them) + + (TEXTPROP TEXTOBJ 'COLUMNWIDTH (IQUOTIENT [IDIFFERENCE + [IDIFFERENCE (CONSTANT (TIMES 8.5 PTSPERINCH )) (ITIMES 2 (TEXTPROP TEXTOBJ - 'EDGEMARGIN))) - (ITIMES (SUB1 (TEXTPROP TEXTOBJ ' - NUMBEROFCOLUMNS)) - (TEXTPROP TEXTOBJ 'BETWEENCOLUMNS))) - (TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS)))))))) + 'EDGEMARGIN] + (ITIMES (SUB1 (TEXTPROP TEXTOBJ + 'NUMBEROFCOLUMNS)) + (TEXTPROP TEXTOBJ 'BETWEENCOLUMNS] + (TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS]) (\TFBRAVO.PARSE.PROFILE.VALUE - (LAMBDA (TOKENLIST) (* gbn "15-Nov-84 13:48") - - (* * returns a value always specified in pts, regardless of whether it was that - way in the token list (NB since RPLNODE is being used, there must always be a - token after the value and/or inches sign)) + [LAMBDA (TOKENLIST) (* gbn "15-Nov-84 13:48") - (PROG ((VALUE (PROG1 (CAR TOKENLIST) - (RPLNODE2 TOKENLIST (CDR TOKENLIST)))) + (* * returns a value always specified in pts, regardless of whether it was that + way in the token list (NB since RPLNODE is being used, there must always be a + token after the value and/or inches sign)) + + (PROG ([VALUE (PROG1 (CAR TOKENLIST) + (RPLNODE2 TOKENLIST (CDR TOKENLIST)))] (POINTSPERINCH 72.27) (INCHES '%")) (if (EQ (CAR TOKENLIST) INCHES) then (SETQ VALUE (TIMES VALUE POINTSPERINCH)) (RPLNODE2 TOKENLIST (CDR TOKENLIST))) - (RETURN (FIX VALUE))))) + (RETURN (FIX VALUE]) (\TFBRAVO.GET.FONTSIZE - (LAMBDA (FONT) (* gbn "19-Sep-84 01:47") - - (* ADD CL:DECLARATION TO ADMIT THAT YOU ARE USING L FREE, BEST TO REPLACE WITH - AN ARRAY IN FACT) + [LAMBDA (FONT) (* gbn "19-Sep-84 01:47") - (CADDR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST))))) + (* ADD CL:DECLARATION TO ADMIT THAT YOU ARE USING L FREE, BEST TO REPLACE WITH AN + ARRAY IN FACT) + + (CADDR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST]) (\TFBRAVO.GET.FONTSTYLE - (LAMBDA (FONT) (* gbn "19-Sep-84 01:46") - - (* ADD CL:DECLARATION TO ADMIT THAT YOU ARE USING USER.CM.ALIST FREE, BEST TO - REPLACE WITH AN ARRAY IN FACT) + [LAMBDA (FONT) (* gbn "19-Sep-84 01:46") - (CADR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST))))) + (* ADD CL:DECLARATION TO ADMIT THAT YOU ARE USING USER.CM.ALIST FREE, BEST TO + REPLACE WITH AN ARRAY IN FACT) + + (CADR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST]) (\TFBRAVO.WRITE.RUN - [LAMBDA (RUN IN PARALOOKS TEXTOBJ) (* ; "Edited 13-Jun-2021 09:44 by rmk:") + [LAMBDA (RUN IN PARALOOKS TEXTOBJ) (* ; "Edited 13-Jun-2021 09:44 by rmk:") (PROG (START END NAMEDTABNUMBER (LOOKS (fetch (RUN RUNLOOKS) of RUN))) - (SETQ NAMEDTABNUMBER (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) - of RUN))) + (SETQ NAMEDTABNUMBER (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of RUN))) (COND ((ILEQ (fetch (RUN RUNLENGTH) of RUN) 0) @@ -439,9 +417,9 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. ([AND NAMEDTABNUMBER (EQUAL (PEEKC) (CHARACTER (CHARCODE ^I] - (* only treat the run like a tab if it has charcode 9, even if it has a tab - number. Color is overloaded onto tab numbers in BRAVO. - Jerks! Jerks!) + (* only treat the run like a tab if it has charcode 9, even if it has a tab + number. Color is overloaded onto tab numbers in BRAVO. + Jerks! Jerks!) (\TFBRAVO.ADD.NAMEDTAB TEXTOBJ NAMEDTABNUMBER PARALOOKS)) (T (SETQ END (IPLUS (SETQ START (GETFILEPTR IN)) @@ -450,13 +428,13 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (TEDIT.LOOKS TEXTOBJ LOOKS]) (\TFBRAVO.ASSERT - (LAMBDA (X Y) (* gbn "19-Sep-84 21:39") + [LAMBDA (X Y) (* gbn "19-Sep-84 21:39") (if (NEQ X Y) then (HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y - " was found."))))) + " was found."]) (\SHIFT.DOCUMENT - [LAMBDA (PCTB DELTAX) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (PCTB DELTAX) (* ; "Edited 31-May-91 15:26 by jds") (* ;; "shifts all tabs, left and right margins by deltax. DOES NOT VERIFY that this produces reasonable values") (* ; "a change for DFNFLG") @@ -464,55 +442,55 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. TSPEC LASTPARALOOKS PARALOOKS) (while PC do (COND - [(NEQ (fetch (PIECE PPARALOOKS) of PC) - LASTPARALOOKS) (* ; - "This is a new set of looks -- go ahead and change it.") - (COND - ((SETQ TAB.OBJECT (fetch (PIECE POBJ) of PC)) + [(NEQ (fetch (PIECE PPARALOOKS) of PC) + LASTPARALOOKS) (* ; + "This is a new set of looks -- go ahead and change it.") + (COND + ((SETQ TAB.OBJECT (fetch (PIECE POBJ) of PC)) (* ; "shift the tabspec by deltax") - (IMAGEOBJPROP TAB.OBJECT 'OBJECTDATUM (IPLUS (fetch OBJECTDATUM - of TAB.OBJECT) - DELTAX))) - ((SETQ PARALOOKS (fetch (PIECE PPARALOOKS) of PC)) - (SETQ PARALOOKS (replace (PIECE PPARALOOKS) of PC - with (create FMTSPEC using PARALOOKS))) - (replace (FMTSPEC 1STLEFTMAR) of PARALOOKS - with (IPLUS (fetch (FMTSPEC 1STLEFTMAR) of PARALOOKS) - DELTAX)) - (replace (FMTSPEC LEFTMAR) of PARALOOKS - with (IPLUS (fetch (FMTSPEC LEFTMAR) of PARALOOKS) - DELTAX)) - (replace (FMTSPEC RIGHTMAR) of PARALOOKS - with (IPLUS (fetch (FMTSPEC RIGHTMAR) of PARALOOKS) - DELTAX)) - (SETQ TSPEC (fetch (FMTSPEC TABSPEC) of PARALOOKS)) + (IMAGEOBJPROP TAB.OBJECT 'OBJECTDATUM (IPLUS (fetch OBJECTDATUM of TAB.OBJECT + ) + DELTAX))) + ((SETQ PARALOOKS (fetch (PIECE PPARALOOKS) of PC)) + (SETQ PARALOOKS (replace (PIECE PPARALOOKS) of PC + with (create FMTSPEC using PARALOOKS))) + (replace (FMTSPEC 1STLEFTMAR) of PARALOOKS with (IPLUS (fetch (FMTSPEC + 1STLEFTMAR + ) + of PARALOOKS) + DELTAX)) + (replace (FMTSPEC LEFTMAR) of PARALOOKS with (IPLUS (fetch (FMTSPEC LEFTMAR) + of PARALOOKS) + DELTAX)) + (replace (FMTSPEC RIGHTMAR) of PARALOOKS with (IPLUS (fetch (FMTSPEC RIGHTMAR + ) + of PARALOOKS) + DELTAX)) + (SETQ TSPEC (fetch (FMTSPEC TABSPEC) of PARALOOKS)) - (* ;; "only subtract the deltax from the absolute positions, not from the relative tabstop (the car of the tabspec)") + (* ;; "only subtract the deltax from the absolute positions, not from the relative tabstop (the car of the tabspec)") (* ; - "this has too much leeway. I think tabspecs are fixed format. Check!") - [replace (FMTSPEC TABSPEC) of PARALOOKS - with (CONS (CAR TSPEC) - (for ELEMENT in (CDR TSPEC) - collect (SELECTQ (TYPENAME ELEMENT) - (FIXP (IPLUS DELTAX ELEMENT)) - (LISTP (CONS (IPLUS DELTAX - (CAR ELEMENT)) - (CDR ELEMENT))) - (NILL] - (replace (PIECE PPARALOOKS) of PC with ( - \TEDIT.UNIQUIFY.PARALOOKS - PARALOOKS TEXTOBJ] - (T (replace (PIECE PPARALOOKS) of PC with LASTPARALOOKS))) - (SETQ LASTPARALOOKS (fetch (PIECE PPARALOOKS) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) + "this has too much leeway. I think tabspecs are fixed format. Check!") + [replace (FMTSPEC TABSPEC) of PARALOOKS + with (CONS (CAR TSPEC) + (for ELEMENT in (CDR TSPEC) + collect (SELECTQ (TYPENAME ELEMENT) + (FIXP (IPLUS DELTAX ELEMENT)) + (LISTP (CONS (IPLUS DELTAX (CAR ELEMENT)) + (CDR ELEMENT))) + (NILL] + (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS + TEXTOBJ] + (T (replace (PIECE PPARALOOKS) of PC with LASTPARALOOKS))) + (SETQ LASTPARALOOKS (fetch (PIECE PPARALOOKS) of PC)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) (\TEDIT.BRAVOFILE? - (LAMBDA (FILE A B C) (* gbn " 3-Jun-85 21:06") - - (* Test a file to see if it is a BRAVO file, asking if it is to be converted) - - (* Returns the name of the user.cm file to be used in the conversion of this - file) + [LAMBDA (FILE A B C) (* gbn " 3-Jun-85 21:06") + + (* Test a file to see if it is a BRAVO file, asking if it is to be converted) + + (* Returns the name of the user.cm file to be used in the conversion of this file) (PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR FILE)) NAME DIRS) (* first look for a ^z, @@ -523,21 +501,21 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (RETURN NIL))) (* BIN past the ^z) (BIN FILE) (SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS FILE)) - - (* if the next symbol is a slash then check if the character looks are valid) - (SETQ ENDCONDITION (COND + (* if the next symbol is a slash then check if the character looks are valid) + + [SETQ ENDCONDITION (COND ((EQ (CAR PLOOKS) '\) - (repeatuntil (\TEST.CHARACTER.LOOKS FILE))))) + (repeatuntil (\TEST.CHARACTER.LOOKS FILE] (COND ((EQ ENDCONDITION 'BADLOOKS) (SETFILEPTR FILE ORIGINAL.FILE.POSITION) (RETURN NIL)) (T (SETFILEPTR FILE ORIGINAL.FILE.POSITION) - - (* look for user.cm files in the following order, the directory the file came - from, the connected directory, the login dir, {dsk} device) + + (* look for user.cm files in the following order, the directory the file came + from, the connected directory, the login dir, {dsk} device) (SETQ NAME (FULLNAME FILE)) (SETQ DIRS '(T NIL {DSK})) @@ -545,30 +523,29 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. then (push DIRS (PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY NAME))) (RETURN (MKATOM (TEDIT.GETINPUT TEXTOBJ "USER.CM file:(NIL to suppress BRAVO conversion) " - (FINDFILE 'USER.CM T DIRS))))))))) + (FINDFILE 'USER.CM T DIRS]) (\TEST.CHARACTER.LOOKS - (LAMBDA (FILE) (* gbn " 6-Feb-84 19:11") - - (* returns nil until done when it returns BADLOOKS or T) - + [LAMBDA (FILE) (* gbn " 6-Feb-84 19:11") + (* returns nil until done when it + returns BADLOOKS or T) (PROG (PROPERTY VALFLAG TEM (VALUE 0) CHAR) - LP (while (NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE)))) do (SETQ VALUE CHAR) - (SETQ VALFLAG T)) + LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE CHAR) + (SETQ VALFLAG T)) (COND (PROPERTY (COND ((NULL VALFLAG) (RETURN 'BADLOOKS)) (T NIL)) (SETQ PROPERTY NIL)) - (VALFLAG (SETFILEPTR FILE (IDIFFERENCE (GETFILEPTR FILE) + (VALFLAG [SETFILEPTR FILE (IDIFFERENCE (GETFILEPTR FILE) (COND - ((EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL)))) + ([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] 2) - (T 1)))) + (T 1] (RETURN NIL))) - (COND + [COND ((SETQ TEM (SELECTQ CHAR ((s u b i g v S U B I G V) T) @@ -580,25 +557,24 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. T) NIL)) T) - ((EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL)))) + ([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] (RETURN T)) ((NEQ CHAR '% ) - (RETURN 'BADLOOKS))) + (RETURN 'BADLOOKS] (SETQ VALUE 0) (SETQ VALFLAG NIL) - (GO LP)))) + (GO LP]) (\TEST.PARAGRAPH.LOOKS - (LAMBDA (FILE) (* gbn " 6-Feb-84 18:30") - - (* test if the sequence form valid paragraph looks, do not allow empty - paragraph looks) - + [LAMBDA (FILE) (* gbn " 6-Feb-84 18:30") + (* test if the sequence form valid + paragraph looks, do not allow empty + paragraph looks) (PROG ((VALUE 0) CHAR PROPERTY (TABS) NONEMPTY) - LP (while (NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE)))) do (SETQ VALUE CHAR)) - (COND + LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE CHAR)) + [COND ((SELECTQ PROPERTY ((l d z x e y k j c q) (SETQ NONEMPTY T)) @@ -617,78 +593,72 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (%, (SETQ NONEMPTY T)) ((%) (SETQ NONEMPTY T))) (* not a legal paragraph look) - (RETURN NIL)))) + (RETURN NIL] (COND - ((AND (NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL)))) + ((AND [NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] (NEQ CHAR '\)) (SETQ PROPERTY CHAR) (SETQ VALUE 0) (GO LP))) (if NONEMPTY then (RETURN CHAR) - else (RETURN))))) + else (RETURN]) ) (DEFINEQ (\TFBRAVO.COPY.NAMEDTAB - (LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58") - - (* just creates a named tab stop with the same value as the original) - - (* Note that the USING phrase will create a new TEDITOBJ as well as a - TEDITUSEROBJ) + [LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58") + (* just creates a named tab stop with + the same value as the original) - (COPY OBJ))) + (* Note that the USING phrase will create a new TEDITOBJ as well as a + TEDITUSEROBJ) + + (COPY OBJ]) (\TFBRAVO.PUT.NAMEDTAB - (LAMBDA (OBJ CHARSTREAM FMTSTREAM) (* jds " 8-Feb-84 19:59") - - (* just writes the position of the tab so that a new one can be created on read) + [LAMBDA (OBJ CHARSTREAM FMTSTREAM) (* jds " 8-Feb-84 19:59") + + (* just writes the position of the tab so that a new one can be created on read) (PRINT (IMAGEOBJPROP OBJ 'OBJECTDATUM) - CHARSTREAM))) + CHARSTREAM]) (\TFBRAVO.GET.NAMEDTAB - (LAMBDA (CHARSTREAM TEXTSTREAM) (* jds " 8-Feb-84 19:59") - - (* should read the position, create an obj and return it) - + [LAMBDA (CHARSTREAM TEXTSTREAM) (* jds " 8-Feb-84 19:59") + (* should read the position, create an + obj and return it) (IMAGEOBJCREATE (RATOM CHARSTREAM) - \NAMEDTAB.IMAGEFNS))) + \NAMEDTAB.IMAGEFNS]) (\TFBRAVO.ADD.NAMEDTAB - [LAMBDA (TEXTOBJ TABNO PARALOOKS) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (TEXTOBJ TABNO PARALOOKS) (* ; "Edited 31-May-91 15:26 by jds") [COND ((NEQ TABNO 0) (BIN) (* Advance the input stream past the - tab character) - (TEDIT.INSERT.OBJECT (IMAGEOBJCREATE (LISTGET (fetch (FMTSPEC FMTUSERINFO) of - PARALOOKS - ) + tab character) + (TEDIT.INSERT.OBJECT (IMAGEOBJCREATE (LISTGET (fetch (FMTSPEC FMTUSERINFO) of PARALOOKS) (SUB1 TABNO)) \NAMEDTAB.IMAGEFNS) TEXTOBJ (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - (* one is subtracted from the tabno because BRAVO seems to specify there - numbers differently in the run from the paragraph looks) + (* one is subtracted from the tabno because BRAVO seems to specify there numbers + differently in the run from the paragraph looks) ]) (\NAMEDTABNYET - (LAMBDA NIL (* gbn "30-Dec-83 17:23") - (PROMPTPRINT "Can't do that to a named tab!"))) + [LAMBDA NIL (* gbn "30-Dec-83 17:23") + (PROMPTPRINT "Can't do that to a named tab!"]) (\NAMEDTABSIZE - (LAMBDA (TABOBJECT IMAGESTREAM CURRENTX RIGHTMARGIN MODE) (* gbn "19-May-84 22:52") - (PROG ((PTSIZE (IMAGEOBJPROP TABOBJECT 'OBJECTDATUM)) + [LAMBDA (TABOBJECT IMAGESTREAM CURRENTX RIGHTMARGIN MODE) (* gbn "19-May-84 22:52") + (PROG [(PTSIZE (IMAGEOBJPROP TABOBJECT 'OBJECTDATUM)) (MODE (if (STKPOS '\FORMATLINE) then 'DISPLAY - else 'HARDCOPY))) - - (* hack until I get called with the right mode. - SHit!) - + else 'HARDCOPY] (* hack until I get called with the + right mode. SHit!) (RETURN (create IMAGEBOX XSIZE _ (IMAX 1 (IDIFFERENCE (COND ((EQ MODE 'DISPLAY) @@ -697,30 +667,29 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. CURRENTX)) YSIZE _ 1 YDESC _ 0 - XKERN _ 0))))) + XKERN _ 0]) (\NAMEDTAB.INIT - (LAMBDA NIL (* jds "22-Aug-84 14:49") - (SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE 'NILL '\NAMEDTABSIZE '\TFBRAVO.PUT.NAMEDTAB ' - \TFBRAVO.GET.NAMEDTAB '\TFBRAVO.COPY.NAMEDTAB 'NILL 'NILL + [LAMBDA NIL (* jds "22-Aug-84 14:49") + (SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE 'NILL '\NAMEDTABSIZE '\TFBRAVO.PUT.NAMEDTAB + '\TFBRAVO.GET.NAMEDTAB '\TFBRAVO.COPY.NAMEDTAB 'NILL 'NILL 'MOVE.NAMED.TAB 'NILL 'NILL 'NILL 'NILL - 'NIL)))) + 'NIL]) ) (DEFINEQ (\TFBRAVO.APPLY.PARALOOKS - [LAMBDA (PARALOOKS LENGTH TEXTOBJ MARGIN.CANDIDATE) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (PARALOOKS LENGTH TEXTOBJ MARGIN.CANDIDATE) (* ; "Edited 31-May-91 15:26 by jds") (* Returns the smaller of%: the left margin so far, the smallest left margin in - this para) + this para) (PROG (TABPHRASE (SMALLEST.MARGIN MARGIN.CANDIDATE)) - (TEDIT.PARALOOKS TEXTOBJ PARALOOKS (ADD1 (IDIFFERENCE (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) + (TEDIT.PARALOOKS TEXTOBJ PARALOOKS (ADD1 (IDIFFERENCE (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) LENGTH)) LENGTH) (TEDIT.SETSEL TEXTOBJ (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) @@ -773,17 +742,16 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (RETURN NEWSTREAM]) (\TFBRAVO.WRITE.PARAGRAPH - [LAMBDA (PARA INFILE TEXTOBJ MARGIN.CANDIDATE) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (PARA INFILE TEXTOBJ MARGIN.CANDIDATE) (* ; "Edited 31-May-91 15:26 by jds") (* outputs the character runs, writes an EOL, then apply paragraph looks. - Returns the smallest left margin seen to date) + Returns the smallest left margin seen to date) (* * this is not a guaranteed free field. - Perhaps later the profile bit will have to be elsewhere.) + Perhaps later the profile bit will have to be elsewhere.) (SELECTQ (fetch (FMTSPEC FMTPARATYPE) of (fetch PARALOOKS of PARA)) - (PROFILE (replace (FMTSPEC FMTPARATYPE) of (fetch PARALOOKS of PARA) - with NIL) + (PROFILE (replace (FMTSPEC FMTPARATYPE) of (fetch PARALOOKS of PARA) with NIL) (\TFBRAVO.PARSE.PROFILE.PARA INFILE PARA TEXTOBJ) MARGIN.CANDIDATE) (PROG (LENGTH) @@ -793,46 +761,44 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. LENGTH TEXTOBJ MARGIN.CANDIDATE]) (\TFBRAVO.WRITE.RUNS - [LAMBDA (PARA INFILE TEXTOBJ) (* ; "Edited 13-Jun-2021 09:45 by rmk:") + [LAMBDA (PARA INFILE TEXTOBJ) (* ; "Edited 13-Jun-2021 09:45 by rmk:") (DECLARE (USEDFREE UNDERLINE SUPERSCRIPT)) (PROG ((RUNS (fetch (PARA RUNS) of PARA)) (PARALOOKS (fetch (PARA PARALOOKS) of PARA)) (LENGTH 0)) - (for RUN in old RUNS do (\TFBRAVO.WRITE.RUN RUN INFILE PARALOOKS - TEXTOBJ) - (SETQ LENGTH (IPLUS (fetch (RUN RUNLENGTH) - of RUN) - LENGTH))) + (for RUN in old RUNS do (\TFBRAVO.WRITE.RUN RUN INFILE PARALOOKS TEXTOBJ) + (SETQ LENGTH (IPLUS (fetch (RUN RUNLENGTH) of RUN) + LENGTH))) (RETURN LENGTH]) (\TFBRAVO.SPREAD.LOOKS - (LAMBDA (RUN LOOKS) (* jds "22-Aug-84 14:53") + [LAMBDA (RUN LOOKS) (* jds "22-Aug-84 14:53") (DECLARE (USEDFREE STYLE SLANT THICKNESS SIZE OVERSTRIKE UNDERLINE SUPERSCRIPT)) (for INSTR in (fetch RUNLOOKS of RUN) do (SELECTQ (CAR INSTR) - (Bold (LISTPUT LOOKS 'WEIGHT (COND + (Bold [LISTPUT LOOKS 'WEIGHT (COND ((CDR INSTR) 'BOLD) - (T 'MEDIUM)))) + (T 'MEDIUM]) (Font (LISTPUT LOOKS 'SIZE (\TFBRAVO.GET.FONTSIZE (CDR INSTR))) (LISTPUT LOOKS 'FAMILY (\TFBRAVO.GET.FONTSTYLE (CDR INSTR)))) - (Italic (LISTPUT LOOKS 'SLOPE (COND + (Italic [LISTPUT LOOKS 'SLOPE (COND ((CDR INSTR) 'ITALIC) - (T 'REGULAR)))) + (T 'REGULAR]) (Overstrike (add OVERSTRIKE 1)) - (Underline (LISTPUT LOOKS 'UNDERLINE + (Underline [LISTPUT LOOKS 'UNDERLINE (COND ((CDR INSTR) 'ON) - (T 'OFF)))) + (T 'OFF]) (Superscript (COND ((IGREATERP (CDR INSTR) 127) - - (* turn off subscripting and set superscripting, though possibly to zero) - + (* turn off subscripting and set + superscripting, though possibly to + zero) (LISTPUT LOOKS 'SUBSCRIPT (IDIFFERENCE 256 (CDR INSTR))) @@ -841,15 +807,15 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (CDR INSTR)) (LISTPUT LOOKS 'SUBSCRIPT NIL)))) NIL)) - LOOKS)) + LOOKS]) (\TFBRAVO.PARSE.PARA - [LAMBDA (OLDPLOOKS FILE) (* ; "Edited 13-Jun-2021 09:46 by rmk:") + [LAMBDA (OLDPLOOKS FILE) (* ; "Edited 13-Jun-2021 09:46 by rmk:") - (* PLOOKS are the paragraph looks, and RUNi are the character runs in the form - returned by READCHARACTERLOOKS, except that the character count for the last - run has been filled in correctly. Leaves the input file pointer at the end of - the trailer, after the EOL.) + (* PLOOKS are the paragraph looks, and RUNi are the character runs in the form + returned by READCHARACTERLOOKS, except that the character count for the last run + has been filled in correctly. Leaves the input file pointer at the end of the + trailer, after the EOL.) (PROG (LEN PLOOKS RUNS ORIGPTR) (SETQ ORIGPTR (GETFILEPTR FILE)) @@ -861,7 +827,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. PARALOOKS _ DefaultParagraphLooks RUNS _ NIL] (SETQ LEN (IDIFFERENCE LEN ORIGPTR)) - (BIN FILE) (* BIN past the ^z) + (BIN FILE) (* BIN past the ^z) (SETQ PLOOKS (\TFBRAVO.READ.PARALOOKS OLDPLOOKS FILE)) [COND ((NEQ [CAR (PROG1 PLOOKS @@ -873,8 +839,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. RUNLENGTH _ LEN RUNLOOKS _ (\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS] - CLP [while [fetch (RUN RUNLENGTH) of (CAR (push RUNS (\TFBRAVO.READ.CHARLOOKS - FILE] + CLP [while [fetch (RUN RUNLENGTH) of (CAR (push RUNS (\TFBRAVO.READ.CHARLOOKS FILE] do (SETQ LEN (IDIFFERENCE LEN (fetch (RUN RUNLENGTH) of (CAR RUNS] (replace (RUN RUNLENGTH) of (CAR RUNS) with LEN) (RETURN (create PARA @@ -882,7 +847,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. RUNS _ (DREVERSE RUNS]) (\TFBRAVO.INIT.PARALOOKS - [LAMBDA (USER.CM.LOOKS) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (USER.CM.LOOKS) (* ; "Edited 31-May-91 15:26 by jds") (* * creates the first paragraph looks from the USER.CM) @@ -898,31 +863,30 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. [(SETQ 1LM (CDR (ASSOC 'FirstLineLeftMargin DefaultParagraphLooks] (T (SETQ 1LM LM))) (replace (FMTSPEC LEFTMAR) of INITPARALOOKS with (IQUOTIENT LM MICASPERPOINT)) - (replace (FMTSPEC 1STLEFTMAR) of INITPARALOOKS with (IQUOTIENT 1LM - MICASPERPOINT)) + (replace (FMTSPEC 1STLEFTMAR) of INITPARALOOKS with (IQUOTIENT 1LM MICASPERPOINT)) (replace (FMTSPEC LINELEAD) of INITPARALOOKS with (COND - ((SETQ VALUE - (ASSOC 'LineLeading + ((SETQ VALUE (ASSOC 'LineLeading DefaultParagraphLooks - )) - (CDR VALUE)) - (T 1))) + )) + (CDR VALUE)) + (T 1))) (replace (FMTSPEC LEADBEFORE) of INITPARALOOKS with (COND - ((SETQ VALUE - (ASSOC - ' + ((SETQ VALUE (ASSOC + ' ParagraphLeading - + DefaultParagraphLooks - )) - (CDR VALUE)) - (T 1))) - (replace (FMTSPEC RIGHTMAR) of INITPARALOOKS - with (IQUOTIENT (COND - ((SETQ VALUE (ASSOC 'RightMargin DefaultParagraphLooks)) - (CDR VALUE)) - (T DefaultRightMargin)) - MICASPERPOINT)) + )) + (CDR VALUE)) + (T 1))) + (replace (FMTSPEC RIGHTMAR) of INITPARALOOKS with (IQUOTIENT (COND + ((SETQ VALUE + (ASSOC 'RightMargin + DefaultParagraphLooks + )) + (CDR VALUE)) + (T DefaultRightMargin)) + MICASPERPOINT)) (replace (FMTSPEC LEADAFTER) of INITPARALOOKS with 0) (replace (FMTSPEC TABSPEC) of INITPARALOOKS with (LIST NIL)) (replace (FMTSPEC FMTSPECIALX) of INITPARALOOKS with 0) @@ -930,41 +894,31 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (RETURN INITPARALOOKS]) (\TFBRAVO.READ.PARALOOKS - [LAMBDA (OLDLOOKS FILE) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (OLDLOOKS FILE) (* ; "Edited 31-May-91 15:26 by jds") (PROG ((TEDITPARALOOKS (create FMTSPEC using USER.CM.PARALOOKS)) LMFLAG FLLMFLAG PROPERTY CHAR TABINDEX TEM (VALUE 0) (MICASPERPOINT 35)) - (replace (FMTSPEC TABSPEC) of TEDITPARALOOKS with (COPY (fetch (FMTSPEC - TABSPEC) - of OLDLOOKS))) - (replace (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS with - (COPY (fetch (FMTSPEC - FMTUSERINFO - ) - of OLDLOOKS))) - LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] - do (SETQ VALUE (IPLUS (ITIMES VALUE 10) - CHAR))) + (replace (FMTSPEC TABSPEC) of TEDITPARALOOKS with (COPY (fetch (FMTSPEC TABSPEC) + of OLDLOOKS))) + (replace (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS with (COPY (fetch (FMTSPEC FMTUSERINFO) + of OLDLOOKS))) + LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE (IPLUS (ITIMES VALUE 10) + CHAR))) [COND ((SELECTQ PROPERTY (l (SETQQ LMFLAG LeftMargin) - (replace (FMTSPEC LEFTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE - MICASPERPOINT - ))) + (replace (FMTSPEC LEFTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE MICASPERPOINT + ))) (d (SETQQ FLLMFLAG FirstLineLeftMargin) - (replace (FMTSPEC 1STLEFTMAR) of TEDITPARALOOKS with (IQUOTIENT - VALUE - MICASPERPOINT) - )) - (z (replace (FMTSPEC RIGHTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE - - MICASPERPOINT - ))) + (replace (FMTSPEC 1STLEFTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE + MICASPERPOINT))) + (z (replace (FMTSPEC RIGHTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE + MICASPERPOINT))) (x (replace (FMTSPEC LINELEAD) of TEDITPARALOOKS with VALUE)) (e (replace (FMTSPEC LEADAFTER) of TEDITPARALOOKS with 0) (replace (FMTSPEC LEADBEFORE) of TEDITPARALOOKS with VALUE)) (y (* (COND ((IEQP VALUE 65535) - (SETQ VALUE NIL)))) + (SETQ VALUE NIL)))) (* vertical tabs are supported) (replace (FMTSPEC FMTSPECIALX) of TEDITPARALOOKS with 0) (replace (FMTSPEC FMTSPECIALY) of TEDITPARALOOKS with VALUE)) @@ -973,17 +927,14 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (w 'HardcopyMode) NIL)) ((SETQ TEM (SELECTQ PROPERTY - (j (replace (FMTSPEC QUAD) of TEDITPARALOOKS with - 'JUSTIFIED)) - (c (replace (FMTSPEC QUAD) of TEDITPARALOOKS with - 'CENTERED)) + (j (replace (FMTSPEC QUAD) of TEDITPARALOOKS with 'JUSTIFIED)) + (c (replace (FMTSPEC QUAD) of TEDITPARALOOKS with 'CENTERED)) (q (* not a legal value for FMTPARATYPE But it signals that this is a profile - paragraph) + paragraph) - (replace (FMTSPEC FMTPARATYPE) of TEDITPARALOOKS - with 'PROFILE)) + (replace (FMTSPEC FMTPARATYPE) of TEDITPARALOOKS with 'PROFILE)) NIL))) (T (SELECTQ PROPERTY (%( (SELECTQ CHAR @@ -995,25 +946,23 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (SETQ TABINDEX VALUE)) (HELP CHAR '" is not legal after ("))) (%, [COND - ((NOT (IEQP VALUE 65535)) (* this is not a delete tab, record - it) + ((NOT (IEQP VALUE 65535)) (* this is not a delete tab, record it) (SETQ VALUE (IQUOTIENT VALUE MICASPERPOINT)) (* * returning to adding a normal tab as well, since there are docs, e.b. - refreminder.bravo which do not have named tab looks on the tab chars - (* I no longer gratuitously add a normal tab at the position of each named tab. - Turns out that, in some cases, that will change the meaning of an already - present unnamed tab. (RPLACD (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS) - (CONS (CONS VALUE (QUOTE LEFT)) (CDR (fetch - (FMTSPEC TABSPEC) of TEDITPARALOOKS)))))) + refreminder.bravo which do not have named tab looks on the tab chars + (* I no longer gratuitously add a normal tab at the position of each named tab. + Turns out that, in some cases, that will change the meaning of an already present + unnamed tab. (RPLACD (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS) + (CONS (CONS VALUE (QUOTE LEFT)) (CDR (fetch + (FMTSPEC TABSPEC) of TEDITPARALOOKS)))))) [RPLACD (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS) (CONS (CONS VALUE 'LEFT) (CDR (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS] (replace (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS with (NCONC (LIST TABINDEX VALUE) - (fetch (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS - ]) + (fetch (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS]) ((%) NIL)) (HELP CHAR '" is not a legal paragraph look"] (COND @@ -1024,165 +973,151 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (GO LP))) [COND ((AND LMFLAG (NOT FLLMFLAG)) (* If there was a Left margin but no - firstline left then default it) - (replace (FMTSPEC 1STLEFTMAR) of TEDITPARALOOKS with (fetch - (FMTSPEC LEFTMAR) - of - TEDITPARALOOKS - ] - (RETURN (CONS CHAR TEDITPARALOOKS)) (* return the looks together with - the indication of how the looks - ended) + firstline left then default it) + (replace (FMTSPEC 1STLEFTMAR) of TEDITPARALOOKS with (fetch (FMTSPEC LEFTMAR) + of TEDITPARALOOKS] + (RETURN (CONS CHAR TEDITPARALOOKS)) (* return the looks together with the + indication of how the looks ended) ]) (\TFBRAVO.READ.CHARLOOKS - [LAMBDA (FILE) (* ; "Edited 31-May-91 15:25 by jds") + [LAMBDA (FILE) (* ; "Edited 31-May-91 15:25 by jds") (* this function reads the character looks trailer building a TEDIT charlooks - record. Most fields are immediately valid, however, the tabcolor is stored in - the cluserinfo field of the looks, and the font is still in numeric form) + record. Most fields are immediately valid, however, the tabcolor is stored in the + cluserinfo field of the looks, and the font is still in numeric form) (PROG ((TEDITCHARLOOKS (create CHARLOOKS using USER.CM.CHARLOOKS)) PROPERTY VALFLAG TEM (VALUE 0) CHAR) - (RETURN (while T - do (* Keep going until we run out of - things to read) - (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] - do (* If we're looking at digits, read - them as a number) + (RETURN (while T do (* Keep going until we run out of + things to read) + (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] + do (* If we're looking at digits, read + them as a number) (SETQ VALUE (IPLUS (ITIMES VALUE 10) CHAR)) (SETQ VALFLAG T)) - [COND - (PROPERTY [COND - ((NULL VALFLAG) - (HELP PROPERTY '"- no value for character look")) - (T (SELECTQ PROPERTY - (TabColor + [COND + (PROPERTY [COND + ((NULL VALFLAG) + (HELP PROPERTY '"- no value for character look")) + (T (SELECTQ PROPERTY + (TabColor - (* Hide the named tab in the user field of the looks where writerun can look - for it) + (* Hide the named tab in the user field of the looks where writerun can look for + it) - (replace (CHARLOOKS CLUSERINFO) - of TEDITCHARLOOKS with VALUE)) - (Font (replace (CHARLOOKS CLSIZE) of + (replace (CHARLOOKS CLUSERINFO) + of TEDITCHARLOOKS with VALUE)) + (Font (replace (CHARLOOKS CLSIZE) of TEDITCHARLOOKS - with (\TFBRAVO.GET.FONTSIZE VALUE) - ) - (replace (CHARLOOKS CLNAME) of + with (\TFBRAVO.GET.FONTSIZE VALUE)) + (replace (CHARLOOKS CLNAME) of TEDITCHARLOOKS - with (\TFBRAVO.GET.FONTSTYLE - VALUE)) + with (\TFBRAVO.GET.FONTSTYLE VALUE)) (* (* a hack so that font is - cumulative. Change the - "default charlooks" to reflect this - font each time) (replace - (CHARLOOKS CLSIZE) of - USER.CM.CHARLOOKS with - (fetch (CHARLOOKS CLSIZE) of - TEDITCHARLOOKS)) (replace - (CHARLOOKS CLNAME) of - USER.CM.CHARLOOKS with - (fetch (CHARLOOKS CLNAME) of - TEDITCHARLOOKS))) - ) - (Superscript (replace (CHARLOOKS CLOFFSET) - of TEDITCHARLOOKS - with (COND - ((IGREATERP VALUE 127) + cumulative. Change the + "default charlooks" to reflect this + font each time) (replace + (CHARLOOKS CLSIZE) of + USER.CM.CHARLOOKS with + (fetch (CHARLOOKS CLSIZE) of + TEDITCHARLOOKS)) (replace + (CHARLOOKS CLNAME) of + USER.CM.CHARLOOKS with + (fetch (CHARLOOKS CLNAME) of + TEDITCHARLOOKS))) + ) + (Superscript (replace (CHARLOOKS CLOFFSET) + of TEDITCHARLOOKS + with (COND + ((IGREATERP VALUE 127) (* is a negative numero) - (IDIFFERENCE VALUE 256 - )) - (T VALUE)))) - (HELP PROPERTY + (IDIFFERENCE VALUE 256) + ) + (T VALUE)))) + (HELP PROPERTY " is unknown property in \TFBRAVO.READ.CHARLOOKS" - ] - (SETQ PROPERTY NIL)) - (VALFLAG [SETFILEPTR FILE (IDIFFERENCE - (GETFILEPTR FILE) - (COND - ([EQ CHAR (CONSTANT (CHARACTER - (CHARCODE EOL] - 2) - (T 1] - (RETURN (CONS VALUE (\TFBRAVO.FONT.FROM.CHARLOOKS - TEDITCHARLOOKS] - (COND - ((SELECTQ CHAR - (s (replace (CHARLOOKS CLSTRIKE) of TEDITCHARLOOKS - with T)) - (S (replace (CHARLOOKS CLSTRIKE) of TEDITCHARLOOKS - with NIL) - T) - (u (replace (CHARLOOKS CLULINE) of TEDITCHARLOOKS - with T)) - (U (replace (CHARLOOKS CLULINE) of TEDITCHARLOOKS - with NIL) - T) - (b (replace (CHARLOOKS CLBOLD) of TEDITCHARLOOKS - with T)) - (B (replace (CHARLOOKS CLBOLD) of TEDITCHARLOOKS - with NIL) - T) - (i (replace (CHARLOOKS CLITAL) of TEDITCHARLOOKS - with T)) - (I (replace (CHARLOOKS CLITAL) of TEDITCHARLOOKS - with NIL) - T) - (g '(Graphic . T)) - (G '(Graphic)) - (v (replace (CHARLOOKS CLINVISIBLE) of TEDITCHARLOOKS - with NIL) - T) - (V (replace (CHARLOOKS CLINVISIBLE) of TEDITCHARLOOKS - with T)) - NIL) - (SETQ PROPERTY NIL)) - ((SETQ TEM (SELECTQ CHAR - (t 'TabColor) - (f 'Font) - (o 'Superscript) - NIL)) - (SETQ PROPERTY TEM)) - [[EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] - (RETURN (CONS NIL (\TFBRAVO.FONT.FROM.CHARLOOKS TEDITCHARLOOKS] - ((NEQ CHAR '% ) - (HELP CHAR " is not a legal character look"))) - (SETQ VALUE 0) - (SETQ VALFLAG NIL]) + ] + (SETQ PROPERTY NIL)) + (VALFLAG [SETFILEPTR FILE + (IDIFFERENCE (GETFILEPTR FILE) + (COND + ([EQ CHAR (CONSTANT (CHARACTER + (CHARCODE EOL] + 2) + (T 1] + (RETURN (CONS VALUE (\TFBRAVO.FONT.FROM.CHARLOOKS + TEDITCHARLOOKS] + (COND + ((SELECTQ CHAR + (s (replace (CHARLOOKS CLSTRIKE) of TEDITCHARLOOKS with T)) + (S (replace (CHARLOOKS CLSTRIKE) of TEDITCHARLOOKS with NIL) + T) + (u (replace (CHARLOOKS CLULINE) of TEDITCHARLOOKS with T)) + (U (replace (CHARLOOKS CLULINE) of TEDITCHARLOOKS with NIL) + T) + (b (replace (CHARLOOKS CLBOLD) of TEDITCHARLOOKS with T)) + (B (replace (CHARLOOKS CLBOLD) of TEDITCHARLOOKS with NIL) + T) + (i (replace (CHARLOOKS CLITAL) of TEDITCHARLOOKS with T)) + (I (replace (CHARLOOKS CLITAL) of TEDITCHARLOOKS with NIL) + T) + (g '(Graphic . T)) + (G '(Graphic)) + (v (replace (CHARLOOKS CLINVISIBLE) of TEDITCHARLOOKS + with NIL) + T) + (V (replace (CHARLOOKS CLINVISIBLE) of TEDITCHARLOOKS + with T)) + NIL) + (SETQ PROPERTY NIL)) + ((SETQ TEM (SELECTQ CHAR + (t 'TabColor) + (f 'Font) + (o 'Superscript) + NIL)) + (SETQ PROPERTY TEM)) + [[EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] + (RETURN (CONS NIL (\TFBRAVO.FONT.FROM.CHARLOOKS TEDITCHARLOOKS] + ((NEQ CHAR '% ) + (HELP CHAR " is not a legal character look"))) + (SETQ VALUE 0) + (SETQ VALFLAG NIL]) (\TFBRAVO.READ.USER.CM - (LAMBDA (FILE) (* gbn "17-Sep-84 18:53") - - (* digests a user.cm file returning an alist of contents. - Returns ((Font)) if no bravo section of user.cm file) + [LAMBDA (FILE) (* gbn "17-Sep-84 18:53") + + (* digests a user.cm file returning an alist of contents. + Returns ((Font)) if no bravo section of user.cm file) (PROG ((RDTBL USER.CM.RDTBL) - (ALIST (LIST (LIST 'Font))) - LINE) - - (* (ERRORTYPELST (CONS (QUOTE (16 (RETFROM - (QUOTE RATOM) (QUOTE END.OF.FILE)))) ERRORTYPELST)) The errortypelist inclusion - guarantees that eof's will return from RATOM as - (CHARCODE 13)) + [ALIST (LIST (LIST 'Font] + LINE) (* (ERRORTYPELST (CONS + (QUOTE (16 (RETFROM (QUOTE RATOM) + (QUOTE END.OF.FILE)))) ERRORTYPELST)) + The errortypelist inclusion guarantees + that eof's will return from RATOM as + (CHARCODE 13)) (* (DECLARE (SPECVARS ERRORTYPELST))) - (SETBRK (CHARCODE (%, %: = EOL)) + (SETBRK (CHARCODE (%, %: = EOL)) NIL RDTBL) - (SETSEPR '(% ) NIL RDTBL) - (OR (OPENP FILE) - (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD))) + (SETSEPR '(% ) + NIL RDTBL) + [OR (OPENP FILE) + (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD] (COND - ((NOT (FILEPOS (CONCAT '"[BRAVO]" (CONSTANT (CHARACTER (CHARCODE EOL)))) + ((NOT (FILEPOS [CONCAT '"[BRAVO]" (CONSTANT (CHARACTER (CHARCODE EOL] FILE NIL NIL NIL T)) (RETURN ALIST))) - - (* Read lines of the user.cm file until getting the empty line caused by eof - (and the errortypelst entry) or until a line starts with "[" %.) + + (* Read lines of the user.cm file until getting the empty line caused by eof + (and the errortypelst entry) or until a line starts with "[" %.) LLP (COND - ((NOT (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL))) - FILE RDTBL)))) + ([NOT (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL))) + FILE RDTBL] (RETURN ALIST))) (* If the "[BRAVO]" section is the  last one) (COND @@ -1194,42 +1129,42 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. ((EQ (NTHCHAR (CAR LINE) 1) '%[) - - (* if "[" is the first character of the line, return the alist so far, because - this is the beginning of the next section of the user.cm) + + (* if "[" is the first character of the line, return the alist so far, because + this is the beginning of the next section of the user.cm) (RETURN ALIST)) ((NEQ (CADR LINE) '%:) (GO LLP))) (SELECTQ (PROG1 (CAR LINE) - (SETQ LINE (CDDR LINE))) - (FONT (COND + (SETQ LINE (CDDR LINE))) + (FONT [COND ((NUMBERP (CAR LINE)) (NCONC1 (FASSOC 'Font ALIST) (LIST (CAR LINE) (CADR LINE) - (CADDR LINE)))))) - (TABS (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((Tabs standard tab width))) + (CADDR LINE]) + (TABS (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((Tabs standard tab width] ALIST))) - (MARGINS (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((LeftMargin left margin) - (RightMargin right margin))) + (MARGINS (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((LeftMargin left margin) + (RightMargin right margin] ALIST))) - (LEAD (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((ParagraphLeading paragraph leading + (LEAD (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((ParagraphLeading paragraph leading ) - (LineLeading line leading))) + (LineLeading line leading] ALIST))) NIL) - (GO LLP)))) + (GO LLP]) (\TFBRAVO.GETPARAMS - (LAMBDA (LIS NAMES) (* jds "27-Aug-84 09:37") + [LAMBDA (LIS NAMES) (* jds "27-Aug-84 09:37") (PROG ((L LIS) ALIST TEST REST) - (MAP L (FUNCTION (LAMBDA (WORDL) + [MAP L (FUNCTION (LAMBDA (WORDL) (COND ((LITATOM (CAR WORDL)) - (FRPLACA WORDL (\TFBRAVO.LCASER (CAR WORDL)))))))) + (FRPLACA WORDL (\TFBRAVO.LCASER (CAR WORDL] LP (COND ((NULL L) (RETURN ALIST))) @@ -1242,22 +1177,22 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. ((SETQ TEST (CDR TEST)) (GO NLP))) (SETQ L (CDR (FMEMB '%, L))) - (GO LP)))) + (GO LP]) (\TFBRAVO.PARAMNAMEP - (LAMBDA (LIS NAME) (* lpd "16-JUL-77 19:55") + [LAMBDA (LIS NAME) (* lpd "16-JUL-77 19:55") (PROG ((L LIS)) - (RETURN (AND (EVERY NAME (FUNCTION (LAMBDA (WORD) + (RETURN (AND [EVERY NAME (FUNCTION (LAMBDA (WORD) (PROG1 (EQ WORD (CAR L)) - (SETQ L (CDR L)))))) + (SETQ L (CDR L)))] (EQ (CAR L) '=) - (CDR L)))))) + (CDR L]) (\TFBRAVO.EOLS - [LAMBDA (N TEXTOBJ) (* ; "Edited 13-Jun-90 01:00 by mitani") + [LAMBDA (N TEXTOBJ) (* ; "Edited 13-Jun-90 01:00 by mitani") - (* ;; "Insert N carriage-returns into the document named by TEXTOBJ at the current location.") + (* ;; "Insert N carriage-returns into the document named by TEXTOBJ at the current location.") (for I FROM 1 to N do (TEDIT.INSERT TEXTOBJ (CHARCODE EOL))) (TEDIT.SETSEL TEXTOBJ (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) @@ -1265,41 +1200,36 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. 'RIGHT]) (\TFBRAVO.LCASER - (LAMBDA (WORD) (* lpd "23-SEP-77 14:40") + [LAMBDA (WORD) (* lpd "23-SEP-77 14:40") (PROG ((LST (CHCON WORD)) Z) - (MAP LST (FUNCTION (LAMBDA (L) + [MAP LST (FUNCTION (LAMBDA (L) (COND ((AND (IGREATERP (SETQ Z (CAR L)) 64) (ILESSP Z 91)) (* Z is an uppercase character) - (FRPLACA L (IPLUS Z 32))))))) - (RETURN (PACKC LST))))) + (FRPLACA L (IPLUS Z 32] + (RETURN (PACKC LST]) (\TFBRAVO.FONT.FROM.CHARLOOKS - [LAMBDA (CHARLOOKS) (* ; "Edited 31-May-91 15:26 by jds") + [LAMBDA (CHARLOOKS) (* ; "Edited 31-May-91 15:26 by jds") (* Takes a CHARLOOKS with fields filled in - (CLNAME = family name) and creates the font to fill it.) + (CLNAME = family name) and creates the font to fill it.) - [replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE - (fetch (CHARLOOKS CLNAME) - of CHARLOOKS) - (fetch (CHARLOOKS CLSIZE) - of CHARLOOKS) - (LIST (COND - ((fetch (CHARLOOKS CLBOLD - ) - of CHARLOOKS) - 'BOLD) - (T 'MEDIUM)) - (COND - ((fetch (CHARLOOKS CLITAL - ) - of CHARLOOKS) - 'ITALIC) - (T 'REGULAR)) - 'REGULAR] + [replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE (fetch (CHARLOOKS CLNAME) of CHARLOOKS) + (fetch (CHARLOOKS CLSIZE) of CHARLOOKS) + (LIST (COND + ((fetch (CHARLOOKS CLBOLD) + of CHARLOOKS) + 'BOLD) + (T 'MEDIUM)) + (COND + ((fetch (CHARLOOKS CLITAL) + of CHARLOOKS) + 'ITALIC) + (T 'REGULAR)) + 'REGULAR] CHARLOOKS]) ) @@ -1325,21 +1255,20 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation. (\NAMEDTAB.INIT) ) -(PUTPROPS TFBRAVO COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990 1991 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4213 34115 (\TFBRAVO.FIND.LAST.TRAILER 4223 . 5716) (\TFBRAVO.HANDLE.HEADING 5718 . -7596) (\TFBRAVO.INIT.CHARLOOKS 7598 . 8414) (\TFBRAVO.INIT.PAGEFORMAT 8416 . 8894) ( -\TFBRAVO.INSTALL.PAGEFORMAT 8896 . 13533) (\TFBRAVO.PARSE.PROFILE.PARA 13535 . 22048) ( -\TFBRAVO.PARSE.PROFILE.VALUE 22050 . 22817) (\TFBRAVO.GET.FONTSIZE 22819 . 23135) ( -\TFBRAVO.GET.FONTSTYLE 23137 . 23465) (\TFBRAVO.WRITE.RUN 23467 . 24600) (\TFBRAVO.ASSERT 24602 . -24914) (\SHIFT.DOCUMENT 24916 . 28792) (\TEDIT.BRAVOFILE? 28794 . 30841) (\TEST.CHARACTER.LOOKS 30843 - . 32483) (\TEST.PARAGRAPH.LOOKS 32485 . 34113)) (34116 37663 (\TFBRAVO.COPY.NAMEDTAB 34126 . 34485) ( -\TFBRAVO.PUT.NAMEDTAB 34487 . 34783) (\TFBRAVO.GET.NAMEDTAB 34785 . 35062) (\TFBRAVO.ADD.NAMEDTAB -35064 . 36041) (\NAMEDTABNYET 36043 . 36208) (\NAMEDTABSIZE 36210 . 37095) (\NAMEDTAB.INIT 37097 . -37661)) (37664 74114 (\TFBRAVO.APPLY.PARALOOKS 37674 . 38705) (TEDITFROMBRAVO 38707 . 41275) ( -\TFBRAVO.WRITE.PARAGRAPH 41277 . 42299) (\TFBRAVO.WRITE.RUNS 42301 . 43070) (\TFBRAVO.SPREAD.LOOKS -43072 . 46044) (\TFBRAVO.PARSE.PARA 46046 . 48043) (\TFBRAVO.INIT.PARALOOKS 48045 . 51369) ( -\TFBRAVO.READ.PARALOOKS 51371 . 58547) (\TFBRAVO.READ.CHARLOOKS 58549 . 66682) (\TFBRAVO.READ.USER.CM -66684 . 70014) (\TFBRAVO.GETPARAMS 70016 . 70845) (\TFBRAVO.PARAMNAMEP 70847 . 71295) (\TFBRAVO.EOLS -71297 . 71710) (\TFBRAVO.LCASER 71712 . 72264) (\TFBRAVO.FONT.FROM.CHARLOOKS 72266 . 74112))))) + (FILEMAP (NIL (4139 33719 (\TFBRAVO.FIND.LAST.TRAILER 4149 . 5677) (\TFBRAVO.HANDLE.HEADING 5679 . +7567) (\TFBRAVO.INIT.CHARLOOKS 7569 . 8327) (\TFBRAVO.INIT.PAGEFORMAT 8329 . 8791) ( +\TFBRAVO.INSTALL.PAGEFORMAT 8793 . 12804) (\TFBRAVO.PARSE.PROFILE.PARA 12806 . 21423) ( +\TFBRAVO.PARSE.PROFILE.VALUE 21425 . 22169) (\TFBRAVO.GET.FONTSIZE 22171 . 22468) ( +\TFBRAVO.GET.FONTSTYLE 22470 . 22779) (\TFBRAVO.WRITE.RUN 22781 . 23847) (\TFBRAVO.ASSERT 23849 . +24154) (\SHIFT.DOCUMENT 24156 . 28249) (\TEDIT.BRAVOFILE? 28251 . 30223) (\TEST.CHARACTER.LOOKS 30225 + . 31947) (\TEST.PARAGRAPH.LOOKS 31949 . 33717)) (33720 37329 (\TFBRAVO.COPY.NAMEDTAB 33730 . 34178) ( +\TFBRAVO.PUT.NAMEDTAB 34180 . 34460) (\TFBRAVO.GET.NAMEDTAB 34462 . 34839) (\TFBRAVO.ADD.NAMEDTAB +34841 . 35671) (\NAMEDTABNYET 35673 . 35833) (\NAMEDTABSIZE 35835 . 36767) (\NAMEDTAB.INIT 36769 . +37327)) (37330 71837 (\TFBRAVO.APPLY.PARALOOKS 37340 . 38310) (TEDITFROMBRAVO 38312 . 40880) ( +\TFBRAVO.WRITE.PARAGRAPH 40882 . 41892) (\TFBRAVO.WRITE.RUNS 41894 . 42507) (\TFBRAVO.SPREAD.LOOKS +42509 . 45642) (\TFBRAVO.PARSE.PARA 45644 . 47575) (\TFBRAVO.INIT.PARALOOKS 47577 . 50971) ( +\TFBRAVO.READ.PARALOOKS 50973 . 56789) (\TFBRAVO.READ.CHARLOOKS 56791 . 64630) (\TFBRAVO.READ.USER.CM +64632 . 68217) (\TFBRAVO.GETPARAMS 68219 . 69035) (\TFBRAVO.PARAMNAMEP 69037 . 69472) (\TFBRAVO.EOLS +69474 . 69891) (\TFBRAVO.LCASER 69893 . 70432) (\TFBRAVO.FONT.FROM.CHARLOOKS 70434 . 71835))))) STOP diff --git a/library/tedit/TEDIT-TFBRAVO.LCOM b/library/tedit/TEDIT-TFBRAVO.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..3237631c98210c6c07aed579e896f790aea43b66 GIT binary patch literal 25307 zcmcJ2dvIIVc_#qUvQ1kIDAA0eE$Lo`AX&C01scGL z)_7p_C>uJuxcu=Y@GeQ}}o&=X6Q z+S1dZk;p?&t#7O@uRVTTlsr^her#i52z{U&3)Ct>}Eghf4DYtIb8V^RsgQ0)Y^lM8`bv)SMaL*Za$^e(ik!+$=9w`?S zxbq?#pB(KODzE@6m2v+$W+O?^FwDGv?e%!P@jE^E*XQ-5pSaOO$uuumxqh+hH@Cgt z5xLs_y;rJ!RrBh$_p2h!n^qpDZhOyed;g`I+;o#wH~EO0EV{{QH~CRFX}QV!-Q@e- zq~A^6rjwqZxyc{9$^YRduer(p;wJxtn|#epe#=e1>Ly=slfUOCKP!{FPpQP3N-U|w z8I>rhL`EeNDluAF+1m|OR`+&CDmCBU?og%HwYPh;QtRH^JzS~XwzoS_sqNeQ(@O33 zy>C`(ckF$=QoD2S*~ao`8`WpG-+n~i*x=s9u4TVxC>#s0Glf)YX2Q<1XoMxxiDDuN z+QFizm;gDUits3#PL&BR3gsdTMco?E2&2Y|vXa{_LRA8;fPA5`QFexfM#tDOhMxdi zXQ7zI&SAJ9+hU zA_&MRTVYlx##WgXjIyVhWkuK$sA8CXij9TXr`c$bRT$P;!xjuoN+Mo+SumL@C0T)4tbpUpI?hZ9xd2N{;bdhKI!PNX%BhoOXClKf&(0TS%WR5;7!G}k zg;^ezGz2xCVi7ew6(JvGv!zsVB$*r0(+o4u7rVMWzI8%6fx7`;smxLLM2Y___LO+V z$yx7wWgoTU7}|fB|L`iC7r%MvQrC)14kB3{92`6)@)>Xc5s|9)A5w`yInQhSQ#glaVMZEIhuHURtPtgR$@!ZgM)M zt{YG)N5UL{ABzAk79I^n0f}KYgln0cDyCBA{S6z?W9RMi2%(w)4NZi37FQSr>GeEH z$MFs(C@pCBgTFA6^c$F zTPpK>fSL8ggk)>*q1EmtJ|sYMs?Y1SFM$Vn{!#3n1Mf0Gw14X0L6>W_wD$HJt=GJv zcWUqXp4r~_lXqU z{ad_7=C*Ha@$8!KC$eKi!0fBUC^AP`lEj%A`np>WVm0|9lp<(3D>#&mgbG~%W~ zR~2=$fN?qvXj5r)Rmq4;3nQu!z!i!FIPT?Va}%lJNic`7k)H>Hzz|L$mncqyXodn2 zHsO@ZPEHmCLB$CkMfZ`sQ+D!Gb`iTHIXM^;h%IWtH^2gK(HcBatu`2rx@mC1=1DDg zhs16#2vU}mB3VWBd|!> zz7>T_Wr*3J&#hPt_I@H!B=i+mFjY+CQpDLnWu3`MNgZ3y7}Y_RI+4oXyx!bzhwcHz z_uA{m%#kJ69aYU`K4vUV7Dd@asyvrU<&#c!HkYS8M3?{qXUZ)LH(zT3jM=@u0t*^P zJI|?_d(d=ns@v!I{nX9>qi`a{gBi9f;0F` z^^1=Gcbx+l?{W@3Q~jKCpgPF$eSa^J4Yc_qr~hltz|N3!*q1g(>b)K#juc5WZ7@)PvowlXMls=^FRCGw7=VF**(_ye-lP!mu*fIfp*_nZ8#$lZ& zC6pHvsr)3#=KMm0I4gu-Dc5r8wON|QZ5c}#DNdFrvcv55dvEi3x?J&fw(o;J!Oqh^ zzYZnRJHbUD$sIW`e~5HZ&*wx%pSNp9v(E19rJBe|u6M5H>(KxE*E$rgb}H=H@&}yF zR|VT$^Zjb(5X}7L+J3(M_z9lp=~Lc}@AACV521Yjb%Spx(k({I+CO`zG2kOU!5b^!{h7Eu zStL!ngt^SqnHsO!c(z1sL?EcGAu`1rqqrHbtWpq|NG`o)j% zA5Q+N)}@Z{OO5US^Y{4g$1tgk23&p2ibY(N17cN7YhlO)UA@1>Ze_(F25F-}Yh^U1 z6)}iZk+3^v6l#`IHmr!D^C5GK0VB{XZ#r89Rv>pws1&+oq69NnnXGjocL`zWfx3AZ z8i`U(t#H6Ffwb-^G#YaUZmW#A0*pnfZ`%?=un+2qLgwK$OI0Tl*;#m3f-raLF*>)1 z7$-?4Og(xKYT!HceaHE&n4wl$Pz&|w7UsS6=oYN7@6aOPs_a$(7F9iZ0KjtVz5!U7 zZrNhYFb#~sf~y-#Xc&WxujU(r30c>7I_5F+E;}|b^y)EeOOGaJ8-=-9%{FSZjg7fy z8Ur5aew`+XMc?66VjiWnyv zF|a*6<^oX|<*I!cb{xH5c}|3TYV43{hA@ecY)f{d+2cuaLk3|UDkfmHfe8i(N+w3( zg$Tl`p~edW!qnWskZbJ-8rBxeSS#81ReQ^5ZyD{4<^};Ztt4Zn3A)9)Jj$s-9*8~~ zxT%rCBDlDT?E`i0jRRTTgNAVk773?(+{wei3wzaZQcB^yfECx&CgIKqH5WwTXwln_ zj=J|{MPXT&eL>IR`?!TBX%Up%vOZ`|;~JC5wG!&I@(7fDV?eI^f(lt33Ju$u6)`U( z0@Twx2!krnfM5(U)5g=H`l1@-;ij4~s*Rhs!mgD7HLzWDxPvgfQSNwRBjnL)D>M0L z2#2q)B?Jbo_YuM@=n5+u+)i+}agP#MN65$+#yvQyj5`g&7vc5+a5PydtRM|(+CweN zpsSVz(A0|}tBGg}HyAt~uBpqif-PBN1s1rF9wPu39s0q#5*=m21PgOa0I=3#Ah80l z-n5q){5N2b*)h1`lv!>JW>eXbjlpc1nw(BaWA7OFXH(Wa@-YMHN3lrRV-y2Z4>k&7 z(Q4CyKc_>PJLae{W^4>(OBxenO;+W37K7Mhnv`Pjb*dAK!C#}(FlD1P*pJ)#B#Q#F zn(_uz5k{-tQSdml#<9AsTTvlunPa!rLZDQmMSxs7jT3K2g9zrn`AiY=ktsWS-eD1V zbDQ#HwwJEYh#^geaUnM!l@ML^3P;^j3`;XN3&U#2r(t231Lt9#4ud|r1HuA6YF-BA z-C;uD@@jbUJ7C>}oXR^8lBWm5qtyl&CRPT~w*|I?23-jPn_6K_m`Q~zI0(o$z&L1% zSwL6;W^?vr8Lra~D*5C=?UF+D;od|tTap|B=jw;M$e-wqSA0TO z=C($zxAk@T;@-^O%W37~C9w9tt57cZstF(S*GhWFB!t38-e|>kz(dn|vfXq=9f* z1wc@+13YxJObm{TaNyYOj{EwouDDN_Y##t~X}2e_*ZZ&=Up%q5dxV2qoc}e# zB>4LM0;w0aBAz7XPsN=u@JR@)mq>=>s z&}1b_JONx8MpIMn@!#eG)_gEL@EY1{GoA;t}{bn}gmFRIxJv zU?VyQ6jnv&!1Us#0rt8a5UFLmArpTbSJW=fMAdx7E5PjH zU7}#;XVp^@4tKvRn>R$&6;65Hn5l%~dpq~?Zq>HGGy6G|W(VJxb-CkmmV-L~!&d}i zWkG$*&5+_wT9zcWpsga1%?ji0pwIA)K@|ZlNzPD)10X<%qIh{4a+eV}i0i=(AWBu+ z0VFl&Mg*!L62xQ2WCeiG=nrL7Q}p(bS00u~t3Xg4QF8#B45I^~g3jekBIE)FmlLUC ziLR7{9xybxJt;Q^EFtuPx-gNL6gLgfJ%f=z*FbsISVVBghk$o%Yn^RgIDdX)X>*ft zkYbDLYfmC>dU<_q7~~r0GE^oEWjv;uyJ|b_Uef0<=RO<;%c&d(K?pii*~GMfKHxH} zr4)}4K)42(A-QCL4I`N9eV|+3mA;2>i?c^6wHw!;=QmmZU~TOBi-L02daix37RX)y zdaf3@_FJOtturD2rT5q%vcH@86Amr@*Oo8Wzg>MjD*$h|q7tW7qNozKO2kznrV=A6 zaZDu+tHeQ>_+$BtaMja0!^^L)yjH!uePc4S^V{(XU%RY-w&wed)oW4=xYZ!LjjTkC zXO@M_7QRfeClRb*01|1>hNJ+ELPI3(n`~1W27(AHMPO?XH0D?jk4RldMCusgTZ1s_ zZGn5Ez6a!R6rrsYgE|dTNa3s&EOQgUo)AJ<2^OI)LyLbBuoy+iD*@s%gGJ{t22=6{ z1~Ge+LBQ7Yk`2yTTS`_JHWFLwPfRRqE>T=WYndWz9dJj3Ro=;`as>`KVC#tqqH_@7 zTzC?4PiMf||NjSA^8l;`;pg1jEvZCCB@!wzsuCYoiThRJ11ixk6W>%((_d*UpLwnx zdu{v16S8V2sT?VP&{%$>E<#@SUQE||uRl}uFTe4xq=)X}giP#4RN_JV@(M<}R}Ibw z_<;of?`A5TQ10z~r&0fp*^6B^5yuvA0f9sqGM)oaP%;@U&v2eePyw6F10p~f;mRO} z6s`;kL*dGxp$Jz7pSJu4KrU1RSaED#nN zWkUe^hoSCD04ST`B1xw(?+V3Iwgvx7%|Xo~9_C~xc}j6tA~#_9U|+;VB-g@ukmg#L zm*T9U%OK9MZG6Gp)tdwXc*YY2G5kRc-z5|#j`#`wSDbtSY9L%j0WFCT90LoQq!Eb~ z@(l{9Yed^g(^2Z0Fs~Rh69JGh?aXrk3y{$%k0R;O^GEcwLZSjw=jLrph$Wp-vy5;t zX)0f8UP!{!LgazBYEq<)Ih?X9REY5!fbYi$$nCq^U?r*tljKuaH^+#ZxdC+-86oKQq4C z=Xg>$yZa9KB&m2N{ke4Q-tSLbyS$pY{z~RIR##UlaIy~$0x}^4mC7>(hm4~7XeDR@ z(cRmQqmEnyGR$p4*MRbzb55iLLX8kck*SGmA%=9;Oj}?Q z)N)%BGMWNi6SY7GwFG|aFgIa}7HldMvZgvD`5o6u3+W=cpGZ_Hh82z|p4N&1G4o{ENW!o&5tnG_OI%yMn&7}bp;3?@HZKz) zo^N)`U*F|Q=K3>@jLdqjRA!K!sU)xeeiFCA4R}0i67OqL(Cf(LLV0%$Jwq{9KZ1Wl z=|>Q)RT3UCjuKGt^qxpl7seZYhJ4g1U?Ue>6M+CkVSRihdwl!>*e8ybK$A#cK1yhLH5A&3KclbQZahMs39D5h@1Mmo8A34Dk{OZ%CIQ z4I27!k@|THL`7|^!mU7j7|+w=3IXQLSEO$T2T4~TPJ?sHMb7P&Fj^$Zr6G{DV44|L|xw)rZ_!lX=y zS`QoH7E!eA1SBMrx}ZTONJt`*a(BjKfwG#o>z#45RqzPX+Hy9)W+JbASHE$odH=;?LVA| z3#)X}-{<$l6C$&E_2jAutc!co6G=`qK(k?p)+du_;Ygs*x-R8p;j=Odv^gHGDuZ)M z3SmT01ZY(KgC zzyM*@hc&?-j zgc#x#rKli2Oj`g_FbE$csM|9zdw72C^?H2qZO`=z9$9$OUTFc?IowEaCY<)Yz<;+r z|5^V2nQC&sZo+YtOU=zi+nz6}#)G=%c|K14Q{v~7vcU_DhgZM1=&PT*X@_aiL5Q1s zI}fFOwO_x!b66~M4QuyZGnY^wP#Z8yMW}Y;AWX^#jlZ!!L6Rqo5jv6vGNn$##-Y+? zY#a$-?%P4IIMoP_eGRR;k$6TJM9fHOb^^y@lhD(s((By3+q6SUS zhQ%6KHvxu2a`;?|bO|MV5)$|!KzSIpzN?*K7u%at9!C!<=nZEyD;J3Y&Rdk|`hKb`S<(U2Ep22XjtyFbo&(}xESX9}(jv-f92LNPZ6g8=K*}Epp@f*JZTPt8TGVlio1+W3 z+0{f@dSRpT)WXKn+;U~Bifg%o_blE=!S+4;4;Kh(_x1(5*HT-HcgGid_$AB^_)dLo z?asdwA^OOjc_s6P@P=jVAN0#7zF8#YOJLdS^rc5u`+JO+q_YF3FHNuFDKO_+x|Ow- zSwUy@aJc^tQ4gWFzgHwz`VXnZVA}7if7e&P;;VlHW-KUGu3v}(4m6Kx^5q!iKpx!& z#)0DUQJg3J>^I4GgF%2|Jle!ooJS z3^E`(ol|o{o6auj9H|7PEaB@ZiP=q`0152RHJ`$%mCfd)p&s;9B|&LgV9?TFN~#$a>mmkeohG?ZAPIi2pj0;=X1?e4 zgYj{|n;Ybyw*uJv+TG%&rFz-RQ5|l_rqTgXI?zb4vj+@U!ToR*yu?Rz4!~DXzo!;( z4qX2RGJ$KqEz95fM9BYTyVmpl{MGsTpXC&@J1icUToLownID|(hwIhp-}dYXO0@HS z{wo2W8VtZ)>kJ?qUk`GRTqe~Xf}7SkRNoZ6UzX$c_cZMKS>0h!c3A1ZLv_WIdb|EH zIp_OCH^9HH9z^vKHNf*?)&E*F7cYG95bZsxen<7=4dA5Zzx9vE;omEUZ>~I&6SWub zF>B@dob|)aUDv};H1hHQ|BYPWo4wflp>2;`(#|2f0t5C-TtyM8seQJ$Ud!`>`dPV< zX?yL)jcc$DmeKolF)v2qwSy|_8+@Of#Obxc4P^NMAGUv>{$9E8Z{=PR!;AUyVvawR zzkihf_R9SB&;QfR&Omnepcq4rb(Nl|bCg~U+`JCg_mvVBN@liHwx?`rjMvg>*t@& ztyf^H#iH<86_DbYrKR(DG9QHpfxfAt`UNq)PUAYB<{@sn1dLp#At1rSWSk5|vwaG} zo-qPO{xlB*P`xM$pc7@LkkbmJIhTYZ=GG+E79`3Vmszoe*One%s8Jk^kib|CBG^$zVaU3XXtHo_YiR>t$pQpZ zoKDLCFj2F6$wsY|uNFy3G7|yw;2RXcr{xvNF*qzK*KQk!aHTF1SU8860#i~vL05w( zIJYCtOz?zW!4vw5`{L{q29bCD!Fk~i&R_p}Ui*XdZ#@$7e}(9K?&|BySL%PBfoJ&l zX8vtP5S#_&B6~>_)Smjok_vrL&;emS0r_sq`sxp;zB>b|ssaV*OVE6-_3!%~gTz%Y zYYG{aO;`WY=h^n&J+t#arEgdgE5kS3u*CMSJlYf{>F0sGpg;&?!cbCWlUgUzR z`VZwuD}T8!fNtVp|K5(|H>*^-y0TZ@`%?8(eO`5XL2{=Lh?#{0;|q!#-OfwTT)Ia! zf4Nar=XI*yFZ%quoN)^)uUD^Z|NPJ4A%JiusJZ#ZtCQ3pG~WhwYydINFiHjS(7+Y? zdE6482vPs8`k)n29uG!OtH?1d>KJsp;y5rGjTJWtb z_=}A)Qh|kg8UYMA8>0$a+l1OH4o?h=mwrtLM2>2=2YpS;$Px3SW20~ex0oKP=+lEM zr}_Os5m6Bfh>YBjbUTa@ho(0W0J*#fj*U1Am183evB4I23LoUc z+UnZ+Q)?7B35&$m)AY?j4N%Rr`)ChEW*j{ZhQXd(s9jh>eC7sgnYoqnOS1gS@~BYQ z7>sxH1qGzYo&y^Rsi}r7m3u^>j~?;CPQbk&9G#0LZa7-JqdF*6QHW*$Zt)t6Y>F}E zZ-ANqSWmOI&5uHEMp+S~>;WAQcU-)%EFPCnRJg}MEUU#g5pFfVgA2ku)b5#}a6{~l zRCnbjfYFa{y(8ySr!v|$0eOdRwN!*lefah+k9SUdT&W7{2%Nl}_*KQnl>~uS8R00{ zy+_b%e!Bc@AM=QIyo58{I6mgGOc6644@CV}Z9jdX!SfYqk3rFujCYl{6eJfV2x{@k z`ki&Wa)*mh)a~4lC)FYUjtES(2k3n@)qBb1Top=R{bRE6mm88tGg>g3i z=eGIZ`9`0=OGpd;!DYVtxdVfJUHgQywN`45GSrje!nALx;&3l+b<1#9v}iU=+84aDoPx3Gpz< zu=vQ}IBbvL9;dm$iU|1;XNpIDGH4ydQ{ef4Arbo*{u*?}7+4gfZNva3v*W2^(J6u! zxo|HLXc!@7Xfo7hE-^$?VI>)6L#EAy8%S%iY8Zqa_&hXZm_ur?jIbxTaRyyYQ_TjM zZB!K&03m#62n2hRZEh{BRiI!{=mmR<8@h(+BZ)^(b4T$bpos`$A3DZ}q_QFCWY{{` zixn~hi`@IxR=PQ-IGN>`4@V+BDfPmb;CDao}`M*WXv^ z^LA&w6yy40w&LZMj6>WU{=@Vuwm)$hHcs*S=p!u4&Z|9bHL6UREqb_qJ6qi2Bd%0~emSSN9T!dn5GhF%+N z3)&fhkW=oAFy$ziRNb~sf}2n%xxmJOW(aPya(O<9_$nSB$FEm?gc+q2h*m5l9)1|N ziHkOCfcr#yOR{D%iH|i6>2Gb~A#NfYr*X;SI7vID*rg%d2z=M{O|GFcr6h!kWE#Fj z))Nf_`sIK_Sto%|r(9v!82jA~4qh?z0Q(4n!^Fp_k8dqMvBcJvmMWV^F+xu~5= z1c@eeBsUC`N;tg=6rZp|Q)8h8deS0Zk%<>w*r)Ks7-SP#On_#PHJywbvWaYAQdVm$ z5TV}6SI}WxRb_S?!s`K|d842}m>mOfa;rY(%sneOkcVd-d}4a22FuE)VVPNiHD?uZ zql>UP!9WF573^4>5cMyx*&b*M6VNPdXd%0E`GzTr_9CRJ%LT7*>__iqoF;H+= zwPToiY?%MU<-u{Rd3Sr5y=&`e`O1dw!(BBl;5L`@%MsrYH7eTTAlzASyA(2GIKYkrE~PE0xH#sny(z9#2hQ<$Or7ISP@Uspgsn?y4PWTtv_gl8xd+o4mZ8_D57B_2 zCJ(=EDQ}K2*WE{pk54z|vL>CQ&`_JpI{=y~n;OHra)};+2F(fPugf^!)j7%NbiM=E z!8!KO((w&VV5zdq3H=20r!Y_JffosZFlcH*viLY25vis|)QX30m*(^IBsS3lS)blO_Zssf80u;$a^b z?KH&Fakqdx(Kzux3_!>LCKK$Cn4VyeAJ>-E&iAKUwVznqE%tOg!FPLsoqONp0^3)E X?fg^jujd_({+&<0r}gCdYuEn=LW|~? literal 0 HcmV?d00001 diff --git a/library/TEDITWINDOW b/library/tedit/TEDIT-WINDOW similarity index 68% rename from library/TEDITWINDOW rename to library/tedit/TEDIT-WINDOW index dab2bf16..5fb985f9 100644 --- a/library/TEDITWINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,25 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Feb-2022 14:54:02"  -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;33 187007 +(FILECREATED "14-Jul-2022 16:55:53"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-WINDOW.;1 180402 - :CHANGES-TO (FNS \TEDIT.SCROLLFN) - - :PREVIOUS-DATE "21-Jan-2022 23:14:36" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;32) + :PREVIOUS-DATE "14-Jul-2022 11:08:01" +{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-WINDOW.;2) -(* ; " -Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporation. -") +(PRETTYCOMPRINT TEDIT-WINDOWCOMS) -(PRETTYCOMPRINT TEDITWINDOWCOMS) - -(RPAQQ TEDITWINDOWCOMS - [(FILES TEDITDCL) +(RPAQQ TEDIT-WINDOWCOMS + [(FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) - TEDITDCL)) + TEDIT-DCL)) (FILES ATTACHEDWINDOW) (FNS TEDIT.CREATEW \TEDIT.CREATEW.FROM.REGION TEDIT.CURSORMOVEDFN TEDIT.CURSOROUTFN TEDIT.WINDOW.SETUP TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.ACTIVE.WINDOWP \TEDIT.BUTTONEVENTFN @@ -99,7 +93,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat  "Changed by yabu.fx, for SUNLOADUP without DWIM.") ]) -(FILESLOAD TEDITDCL) +(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -111,18 +105,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (FILESLOAD (LOADCOMP) - TEDITDCL) + TEDIT-DCL) ) (FILESLOAD ATTACHEDWINDOW) (DEFINEQ (TEDIT.CREATEW - [LAMBDA (PROMPT FILE PROPS) (* ; "Edited 1-Jan-2022 23:54 by rmk") - (* ; "Edited 30-Dec-2021 23:00 by rmk") - (* ; "Edited 29-Dec-2021 16:35 by rmk") - (* ; "Edited 24-Dec-2021 19:21 by rmk") - (* ; "Edited 27-Oct-2021 12:25 by rmk:") + [LAMBDA (PROMPT FILE PROPS) (* ; "Edited 1-Jan-2022 23:54 by rmk") + (* ; "Edited 30-Dec-2021 23:00 by rmk") + (* ; "Edited 29-Dec-2021 16:35 by rmk") + (* ; "Edited 24-Dec-2021 19:21 by rmk") + (* ; "Edited 27-Oct-2021 12:25 by rmk:") (* ;; "RMK: PROPS are passed to CREATEW and \TEDIT.ORIGINAL.WINDOW.TITLE. .") @@ -167,7 +161,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat WINDOW]) (\TEDIT.CREATEW.FROM.REGION - [LAMBDA (REGION FILE PROPS) (* gbn "15-Nov-84 18:04") + [LAMBDA (REGION FILE PROPS) (* gbn "15-Nov-84 18:04") (PROG ((PROMPT (LISTGET PROPS 'PROMPTWINDOW)) (PHEIGHT 0) PWINDOW) @@ -185,10 +179,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat TEDIT.DEFAULT.WINDOW]) (TEDIT.CURSORMOVEDFN - [LAMBDA (W) (* ; "Edited 12-Oct-2021 13:14 by rmk:") + [LAMBDA (W) (* ; "Edited 12-Oct-2021 13:14 by rmk:") - (* Watch the mouse and change the cursor to reflect the region of the window - it's in (line select, window split eventually?)) + (* Watch the mouse and change the cursor to reflect the region of the window it's + in (line select, window split eventually?)) (PROG ((X (LASTMOUSEX W)) (Y (LASTMOUSEY W)) @@ -198,22 +192,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (COND ((INSIDE? CURSORREG X Y) (* Do nothing) NIL) - (T (SETQ LINE (\TEDIT.FIND.OVERLAPPING.LINE (for LINES - inside (fetch (TEXTOBJ LINES) - of TEXTOBJ) + (T (SETQ LINE (\TEDIT.FIND.OVERLAPPING.LINE (for LINES inside (fetch (TEXTOBJ LINES) + of TEXTOBJ) as WINDOW inside (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ) + of TEXTOBJ) when (EQ W WINDOW) do (RETURN LINES)) Y)) [COND - (LINE (replace BOTTOM of CURSORREG with (fetch (LINEDESCRIPTOR - YBOT) of - LINE)) - (replace HEIGHT of CURSORREG with (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE] + (LINE (replace BOTTOM of CURSORREG with (fetch (LINEDESCRIPTOR YBOT) of LINE)) + (replace HEIGHT of CURSORREG with (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE] (SELECTQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ) (TEXT [COND ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) @@ -231,29 +221,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ([ILESSP X (SETQ LEFT (OR [AND LINE (COND ((fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) - (FIXR (FQUOTIENT (fetch ( - LINEDESCRIPTOR - LEFTMARGIN) + of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LINE)) + (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR + LEFTMARGIN) of LINE) 35.27778))) (T (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE] (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - 8] (* In left margin; - switch to the line-select cursor) + 8] (* In left margin; switch to the + line-select cursor) (CURSOR TEDIT.LINECURSOR) (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'LINE) (replace LEFT of CURSORREG with 0) (replace WIDTH of CURSORREG with LEFT)) (T (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with - (IDIFFERENCE (fetch - (TEXTOBJ WRIGHT) - of TEXTOBJ) - (IPLUS LEFT 8]) + (replace WIDTH of CURSORREG with (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) + of TEXTOBJ) + (IPLUS LEFT 8]) (LINE (COND ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) @@ -266,29 +252,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH)) [[IGEQ X (SETQ LEFT (OR [AND LINE (COND ((fetch (FMTSPEC FMTHARDCOPY) - of (fetch ( - LINEDESCRIPTOR - LFMTSPEC) - of LINE)) + of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of LINE)) (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR - LEFTMARGIN) + LEFTMARGIN) of LINE) 35.27778))) - (T (fetch (LINEDESCRIPTOR - LEFTMARGIN) + (T (fetch (LINEDESCRIPTOR + LEFTMARGIN) of LINE] - (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ - ) + (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ) 8] (CURSOR T) (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'TEXT) (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with (IDIFFERENCE - (fetch (TEXTOBJ - WRIGHT) + (replace WIDTH of CURSORREG with (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IPLUS LEFT 8] + (IPLUS LEFT 8] (T (replace LEFT of CURSORREG with 0) (replace WIDTH of CURSORREG with LEFT)))) (WINDOW (COND @@ -297,19 +279,16 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat \TEDIT.OP.WIDTH))) (IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) \TEDIT.OP.BOTTOM))) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with - 'WINDOW) + (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'WINDOW) (replace LEFT of CURSORREG with LEFT) (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH)) ([IGEQ X (SETQ LEFT (OR [AND LINE (COND ((fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) - (FIXR (FQUOTIENT (fetch ( - LINEDESCRIPTOR - LEFTMARGIN) + of (fetch (LINEDESCRIPTOR LFMTSPEC) + of LINE)) + (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR + LEFTMARGIN) of LINE) 35.27778))) (T (fetch (LINEDESCRIPTOR LEFTMARGIN) @@ -317,30 +296,27 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ) 8] (CURSOR T) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with - 'TEXT) + (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'TEXT) (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with - (IDIFFERENCE (fetch - (TEXTOBJ WRIGHT) - of TEXTOBJ) - LEFT))) + (replace WIDTH of CURSORREG with (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) + of TEXTOBJ) + LEFT))) (T (CURSOR TEDIT.LINECURSOR) (replace LEFT of CURSORREG with 0) (replace WIDTH of CURSORREG with LEFT)))) NIL]) (TEDIT.CURSOROUTFN - [LAMBDA (W) (* ; "Edited 30-May-91 23:32 by jds") + [LAMBDA (W) (* ; "Edited 30-May-91 23:32 by jds") (* Cursor leaves edit window; - make sure we think we're in the text - region.) + make sure we think we're in the text + region.) (PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ] (CURSOR T) (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'TEXT]) (TEDIT.WINDOW.SETUP - [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 30-May-91 23:32 by jds") + [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 30-May-91 23:32 by jds") (* ;; "Set up the window and TEXTOBJ so they correspond, and the window is a TEDIT window.") @@ -351,24 +327,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (OR WINDOW (\ILLEGAL.ARG WINDOW)) (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) (* ; - "Set the window up with the right mouse interfaces for TEDIT.") + "Set the window up with the right mouse interfaces for TEDIT.") (WINDOWPROP WINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) (WINDOWPROP WINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) (* ; - "Hook into the system standard hardcopy interface") + "Hook into the system standard hardcopy interface") (SETQ PROP (LISTGET PROPS 'MENU)) (* ; - "The Command menu, or list of items for it") + "The Command menu, or list of items for it") (COND - ((type? MENU PROP) (* ; "It's a menu. just use it.") + ((type? MENU PROP) (* ; "It's a menu. just use it.") (WINDOWPROP WINDOW 'TEDIT.MENU PROP)) (PROP (* ; - "It's a list of menu items. Force a new menu on next middle button.") + "It's a list of menu items. Force a new menu on next middle button.") (WINDOWPROP WINDOW 'TEDIT.MENU.COMMANDS PROP) (WINDOWPROP WINDOW 'TEDIT.MENU NIL))) (TEDIT.MINIMAL.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW]) (TEDIT.MINIMAL.WINDOW.SETUP - [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 30-May-91 23:33 by jds") (* ;; "Do the absolute minimum setup so that TEXTOBJ and WINDOW know about each other. Does NOT include mouse interface or scrolling.") @@ -378,95 +354,89 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat TEDITPROMPTWINDOW DS PROP TWIDTH THEIGHT LINES OLDWINDOWS) (OR WINDOW (\ILLEGAL.ARG WINDOW)) (replace (TEDITCARET TCCARETDS) of (COND - [(LISTP (fetch (TEXTOBJ CARET) - of TEXTOBJ)) - (CAR (FLAST (fetch (TEXTOBJ CARET) - of TEXTOBJ] - (T (fetch (TEXTOBJ CARET) of TEXTOBJ) - )) with (WINDOWPROP WINDOW - 'DSP)) - (* ; - "The displaystream for flashing the caret") + [(LISTP (fetch (TEXTOBJ CARET) of TEXTOBJ)) + (CAR (FLAST (fetch (TEXTOBJ CARET) of TEXTOBJ] + (T (fetch (TEXTOBJ CARET) of TEXTOBJ))) + with (WINDOWPROP WINDOW 'DSP)) (* ; + "The displaystream for flashing the caret") (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with WINDOW) (WINDOWPROP WINDOW 'PROCESS NIL) (* ; - "For the moment, this window has no process") + "For the moment, this window has no process") (WINDOWPROP WINDOW 'TEDIT.PROPS PROPS) (* ; - "Put the props on the window for others ... **this should go**") + "Put the props on the window for others ... **this should go**") (WINDOWPROP WINDOW 'TEXTSTREAM TEXTSTREAM) (* ; - "Save the text stream for the user to get at via the window.") + "Save the text stream for the user to get at via the window.") (WINDOWPROP WINDOW 'TEXTOBJ TEXTOBJ) (* ; - "Give a handle on the TEXTOBJ for the text being edited.") + "Give a handle on the TEXTOBJ for the text being edited.") (WINDOWPROP WINDOW 'TEDIT.CURSORREGION (LIST 0 0 0 0)) (* ; "Used by CursorMovedFn") (WINDOWPROP WINDOW 'CURSORMOVEDFN (FUNCTION TEDIT.CURSORMOVEDFN)) (WINDOWPROP WINDOW 'CURSOROUTFN (FUNCTION TEDIT.CURSOROUTFN)) (SETQ DS (WINDOWPROP WINDOW 'DSP)) (DSPRIGHTMARGIN 32767 DS) (* ; - "So we don't get spurious RETURNs printed out by the system") + "So we don't get spurious RETURNs printed out by the system") (SETQ OLDWINDOWS (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) [replace (TEXTOBJ \WINDOW) of TEXTOBJ with (COND - [(LISTP OLDWINDOWS) (* ; - "There are windows already. Add this to the list.") - (COND - (AFTERWINDOW (* ; - "We know which window to put it after. Put it there") - [RPLACD (FMEMB AFTERWINDOW OLDWINDOWS) - (CONS WINDOW (CDR (FMEMB AFTERWINDOW OLDWINDOWS] - OLDWINDOWS) - (T (* ; - "Otherwise, just add it at the end of the list") - (NCONC1 OLDWINDOWS WINDOW] - (WINDOW (LIST WINDOW] - (replace (TEXTOBJ DISPLAYCACHE) of TEXTOBJ with (CAR (\TEDIT.CREATE.LINECACHE - 1))) + [(LISTP OLDWINDOWS) (* ; + "There are windows already. Add this to the list.") + (COND + (AFTERWINDOW (* ; + "We know which window to put it after. Put it there") + [RPLACD (FMEMB AFTERWINDOW OLDWINDOWS) + (CONS WINDOW (CDR (FMEMB AFTERWINDOW OLDWINDOWS] + OLDWINDOWS) + (T (* ; + "Otherwise, just add it at the end of the list") + (NCONC1 OLDWINDOWS WINDOW] + (WINDOW (LIST WINDOW] + (replace (TEXTOBJ DISPLAYCACHE) of TEXTOBJ with (CAR (\TEDIT.CREATE.LINECACHE 1))) (* ; - "and a CACHE for creating line images for display") - [replace (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ - with (DSPCREATE (fetch LCBITMAP of (fetch (TEXTOBJ DISPLAYCACHE) - of TEXTOBJ] + "and a CACHE for creating line images for display") + [replace (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ with (DSPCREATE (fetch LCBITMAP + of (fetch (TEXTOBJ + DISPLAYCACHE + ) + of TEXTOBJ] (* ; - "A displaystream for changeing the image caches") + "A displaystream for changeing the image caches") (DSPOPERATION 'PAINT (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) (DSPCLIPPINGREGION (create REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ 100 HEIGHT _ 15) - (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) - (* ; "Remember its size, too.") + (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ))(* ; "Remember its size, too.") [COND ((SETQ PROP (LISTGET PROPS 'REGION)) (* ; - "The caller wants to set a region. Use his") + "The caller wants to set a region. Use his") (replace (TEXTOBJ WTOP) of TEXTOBJ with (fetch PTOP of PROP)) (replace (TEXTOBJ WRIGHT) of TEXTOBJ with (fetch RIGHT of PROP)) (replace (TEXTOBJ WBOTTOM) of TEXTOBJ with (fetch BOTTOM of PROP)) (replace (TEXTOBJ WLEFT) of TEXTOBJ with (fetch LEFT of PROP))) (T (* ; - "Otherwise, default to the whole window") + "Otherwise, default to the whole window") (replace (TEXTOBJ WLEFT) of TEXTOBJ with 0) (replace (TEXTOBJ WBOTTOM) of TEXTOBJ with 0) - (replace (TEXTOBJ WTOP) of TEXTOBJ with (fetch HEIGHT - of (DSPCLIPPINGREGION - NIL DS))) - (replace (TEXTOBJ WRIGHT) of TEXTOBJ with (fetch WIDTH - of (DSPCLIPPINGREGION - NIL DS] + (replace (TEXTOBJ WTOP) of TEXTOBJ with (fetch HEIGHT of (DSPCLIPPINGREGION NIL DS))) + (replace (TEXTOBJ WRIGHT) of TEXTOBJ with (fetch WIDTH of (DSPCLIPPINGREGION NIL DS] (SETQ LINES (\SHOWTEXT TEXTOBJ NIL WINDOW)) (WINDOWPROP WINDOW 'LINES LINES) (* ; - "Display the text in the window, for later use.") - [replace (TEXTOBJ LINES) of TEXTOBJ - with (COND - [AFTERWINDOW (for LINE in (fetch (TEXTOBJ LINES) of TEXTOBJ) - as WINDOW in OLDWINDOWS - join (COND - ((EQ WINDOW AFTERWINDOW) - (LIST LINE LINES)) - (T (LIST LINE] - ((LISTP (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (NCONC1 (fetch (TEXTOBJ LINES) of TEXTOBJ) - LINES)) - (LINES (LIST LINES] + "Display the text in the window, for later use.") + [replace (TEXTOBJ LINES) of TEXTOBJ with (COND + [AFTERWINDOW (for LINE + in (fetch (TEXTOBJ LINES) + of TEXTOBJ) as WINDOW + in OLDWINDOWS + join (COND + ((EQ WINDOW AFTERWINDOW + ) + (LIST LINE LINES)) + (T (LIST LINE] + ((LISTP (fetch (TEXTOBJ LINES) of TEXTOBJ)) + (NCONC1 (fetch (TEXTOBJ LINES) of TEXTOBJ) + LINES)) + (LINES (LIST LINES] (\FIXSEL SEL TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ SEL) (\SHOWSEL SEL NIL T) @@ -474,25 +444,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\COPYSEL SEL TEDIT.SELECTION]) (\TEDIT.ACTIVE.WINDOWP - [LAMBDA (W) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (W) (* ; "Edited 30-May-91 23:33 by jds") (* Decides whether a TEdit window is really in use. - The function TEDIT will set the TEXTOBJ prop of the window to T pro tem, to - reserve a window. Once the TEdit has really started, the TEXTOBJ property will - be a real textobj.) + The function TEDIT will set the TEXTOBJ prop of the window to T pro tem, to + reserve a window. Once the TEdit has really started, the TEXTOBJ property will be + a real textobj.) (PROG [(TEXTOBJ (OR (WINDOWPROP W 'TEXTOBJ) (AND (WINDOWPROP W 'TEXTSTREAM) (TEXTOBJ (WINDOWPROP W 'TEXTSTREAM] (RETURN (COND ((EQ TEXTOBJ T) (* Can have a TEXTOBJ of T as a - placeholder during creation...) + placeholder during creation...) T) (TEXTOBJ (AND (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) (PROCESSP (WINDOWPROP W 'PROCESS]) (\TEDIT.BUTTONEVENTFN - [LAMBDA (W STREAM) (* ; "Edited 19-Sep-2021 22:58 by rmk:") + [LAMBDA (W STREAM) (* ; "Edited 19-Sep-2021 22:58 by rmk:") (* ;; "Handle button events for a TEdit window. If no button is down, we got control on button-up transition, so ignore it.") @@ -523,7 +493,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat SELFINALFN PROC NOSEL) (replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0) (* ; - "Mark the user-visible scratch selection fresh, so changes can be detected...") + "Mark the user-visible scratch selection fresh, so changes can be detected...") (COND [[OR (NOT TEXTOBJ) (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) @@ -536,22 +506,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.") (COND ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right button gets the window command menu") + "Right button gets the window command menu") (DOWINDOWCOM W)) ((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY)) (NOT (TEXTPROP TEXTOBJ 'SELECTONLY)) [NOT (PROCESSP (WINDOWPROP W 'PROCESS] (\TEDIT.MOUSESTATE MIDDLE)) (* ; - "Middle button on a dead window gives a menu for re-starting TEDIT") + "Middle button on a dead window gives a menu for re-starting TEDIT") (COND ((EQ (MENU TEDIT.RESTART.MENU) 'NewEditProcess) (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) (TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) W] - [(IGREATERP Y (fetch TOP of CLIPREGION)) - (* ; - "It's not inside the window's REAL region, so call on a menu.") + [(IGREATERP Y (fetch TOP of CLIPREGION)) (* ; + "It's not inside the window's REAL region, so call on a menu.") (* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.") @@ -566,39 +535,38 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (ADD.PROCESS (LIST USERFN (KWOTE W] ((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ) 'WINDOW)) (* ; - "We're in the window-ops region of the window. Do a window split or something") + "We're in the window-ops region of the window. Do a window split or something") (\TEDIT.WINDOW.OPS TEXTOBJ W)) ((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ))) (* ; - "Usual case -- he's really selecting something. And there's nothing else going on now.") + "Usual case -- he's really selecting something. And there's nothing else going on now.") (\CARET.DOWN) (* ; - "Make sure the caret isn't being displayed.") + "Make sure the caret isn't being displayed.") (RESETLST (RESETSAVE TEDIT.SELPENDING TEXTOBJ) (* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.") (RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (replace TCCARET of CARET with (\CARET.CREATE - BXHICARET))) + do (replace TCCARET of CARET with (\CARET.CREATE BXHICARET))) (LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ))) (* ; - "Then make the caret be the special, tall one so he can see it.") + "Then make the caret be the special, tall one so he can see it.") (COND ((KEYDOWNP 'COPY) (* ; - "In a read-only document, you can only copy.") + "In a read-only document, you can only copy.") (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION) (SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) (SETQ SELOPERATION 'COPY)) ((AND (KEYDOWNP 'MOVE) (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) (* ; - "The MOVE key is down, so set MOVE mode.") + "The MOVE key is down, so set MOVE mode.") (SETQ GLOBALSEL TEDIT.MOVESELECTION) (SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) (SETQ SELOPERATION 'MOVE)) [(SHIFTDOWNP 'SHIFT) (* ; - "the SHIFT key is down; mark this selection for COPY or MOVE.") + "the SHIFT key is down; mark this selection for COPY or MOVE.") (COND ((AND (SHIFTDOWNP 'CTRL) (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) @@ -610,29 +578,27 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) (SETQ SELOPERATION 'COPY] ((SHIFTDOWNP 'META) (* ; - "He's holding the meta key down , do a copylooks selection") + "He's holding the meta key down , do a copylooks selection") (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION) (SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) (SETQ SELOPERATION 'COPYLOOKS)) ((AND (SHIFTDOWNP 'CTRL) (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) (* ; - "He's holding the control key down; note the fact.") + "He's holding the control key down; note the fact.") (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL NIL) (SETQ GLOBALSEL TEDIT.DELETESELECTION) [COND - ((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL) - of TEXTOBJ)) + ((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) (* ; - "There's a pending delete selection. Use it, and turn off the existing normal selection.") + "There's a pending delete selection. Use it, and turn off the existing normal selection.") ) (T (* ; - "No existing delete selection. Use the normal selection as a starting point.") + "No existing delete selection. Use the normal selection as a starting point.") (\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) (fetch (TEXTOBJ DELETESEL) of TEXTOBJ] - (replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ - ) with NIL) + (replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ) with NIL) (* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.") @@ -647,183 +613,171 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\COPYSEL OSEL GLOBALSEL) (bind (OSELOP _ SELOPERATION) while [OR (SHIFTDOWNP 'SHIFT) - (SHIFTDOWNP 'CTRL) - (SHIFTDOWNP 'META) - (KEYDOWNP 'MOVE) - (KEYDOWNP 'COPY) - (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7] - do (* ; - "Poll the selection & display its current state") - [COND - ((ZEROP (LOGAND LASTMOUSEBUTTONS 7)) + (SHIFTDOWNP 'CTRL) + (SHIFTDOWNP 'META) + (KEYDOWNP 'MOVE) + (KEYDOWNP 'COPY) + (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7] + do (* ; + "Poll the selection & display its current state") + [COND + ((ZEROP (LOGAND LASTMOUSEBUTTONS 7)) (* ; - "No mouse buttons are down; don't try anything.") - (SETQ OLDX -32000) (* ; - "However, remember that pushing a mouse button is a change of status that we should notice.") - ) - ((KEYDOWNP 'MOVE) (* ; - "the MOVE key is down; mark this selection for MOVE.") - (SETQ SELOPERATION 'MOVE)) - [(OR (SHIFTDOWNP 'SHIFT) - (KEYDOWNP 'COPY)) (* ; - "the SHIFT key is down; mark this selection for COPY or MOVE.") - (COND - ((SHIFTDOWNP 'CTRL) (* ; - "He's holding down both ctrl and shift -- do a move.") - (SETQ SELOPERATION 'MOVE)) - (T (* ; - "Just the SHIFT key. It's a COPY") - (SETQ SELOPERATION 'COPY] - ((SHIFTDOWNP 'META) (* ; - "He's holding the meta key down; note the fact.") - (SETQ SELOPERATION 'COPYLOOKS)) - ((SHIFTDOWNP 'CTRL) (* ; - "He's holding only the CTRL key -- mark the selection for deletion.") - (SETQ SELOPERATION 'DELETE)) - (T (* ; - "No key being held down; revert to normal selection.") - (SETQ SELOPERATION 'NORMAL] - (COND - [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS] - [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS] - (NEQ OSELOP SELOPERATION)) - (INSIDEP CLIPREGION X Y)) + "No mouse buttons are down; don't try anything.") + (SETQ OLDX -32000) (* ; + "However, remember that pushing a mouse button is a change of status that we should notice.") + ) + ((KEYDOWNP 'MOVE) (* ; + "the MOVE key is down; mark this selection for MOVE.") + (SETQ SELOPERATION 'MOVE)) + [(OR (SHIFTDOWNP 'SHIFT) + (KEYDOWNP 'COPY)) (* ; + "the SHIFT key is down; mark this selection for COPY or MOVE.") + (COND + ((SHIFTDOWNP 'CTRL) (* ; + "He's holding down both ctrl and shift -- do a move.") + (SETQ SELOPERATION 'MOVE)) + (T (* ; "Just the SHIFT key. It's a COPY") + (SETQ SELOPERATION 'COPY] + ((SHIFTDOWNP 'META) (* ; + "He's holding the meta key down; note the fact.") + (SETQ SELOPERATION 'COPYLOOKS)) + ((SHIFTDOWNP 'CTRL) (* ; + "He's holding only the CTRL key -- mark the selection for deletion.") + (SETQ SELOPERATION 'DELETE)) + (T (* ; + "No key being held down; revert to normal selection.") + (SETQ SELOPERATION 'NORMAL] + (COND + [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS] + [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS] + (NEQ OSELOP SELOPERATION)) + (INSIDEP CLIPREGION X Y)) - (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed") + (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed") - (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)") + (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)") - (SETQ OLDX X) - (SETQ OLDY Y) - [COND - ((\TEDIT.MOUSESTATE LEFT) - (* ; - "Left button is character selection") - (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ - MOUSEREGION - ) - of TEXTOBJ) - NIL SELOPERATION W)) - (SETQ EXTENDFLG NIL)) - ((\TEDIT.MOUSESTATE MIDDLE) + (SETQ OLDX X) + (SETQ OLDY Y) + [COND + ((\TEDIT.MOUSESTATE LEFT) (* ; + "Left button is character selection") + (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ MOUSEREGION) + of TEXTOBJ) + NIL SELOPERATION W)) + (SETQ EXTENDFLG NIL)) + ((\TEDIT.MOUSESTATE MIDDLE) (* ; "Middle button is word selection") - (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ - MOUSEREGION - ) - of TEXTOBJ) - T SELOPERATION W)) - (SETQ EXTENDFLG NIL)) - [(\TEDIT.MOUSESTATE RIGHT) - (* ; "RIght button extends selections") - (COND - ((NEQ SELOPERATION OSELOP) + (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ MOUSEREGION) + of TEXTOBJ) + T SELOPERATION W)) + (SETQ EXTENDFLG NIL)) + [(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections") + (COND + ((NEQ SELOPERATION OSELOP) (* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.") - (\COPYSEL OSEL GLOBALSEL))) - (COND - ((fetch (SELECTION SET) of GLOBALSEL) - (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION - 'NORMAL) - (SETQ SELOPERATION 'PENDINGDEL) - (replace (TEXTOBJ BLUEPENDINGDELETE) of - TEXTOBJ - with T)) + (\COPYSEL OSEL GLOBALSEL))) + (COND + ((fetch (SELECTION SET) of GLOBALSEL) + (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION + 'NORMAL) + (SETQ SELOPERATION 'PENDINGDEL) + (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ + with T)) (* ; + "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.") + (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ + SELOPERATION W)) + (SETQ EXTENDFLG T] + (T (* ; + "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection") + (\COPYSEL OSEL GLOBALSEL) (* ; - "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.") - (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ - SELOPERATION W)) - (SETQ EXTENDFLG T] - (T (* ; - "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection") - (\COPYSEL OSEL GLOBALSEL) + "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below") + (AND SEL (replace (SELECTION SET) of SEL with NIL] + [COND + ((AND SEL (fetch (SELECTION SET) of SEL) + SELFN) (* ; + "The selection was set, but there's a SELFN that has veto authority") + (COND + ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE) + 'DON'T) (* ; + "The selfn vetoed this selection, so mark it un-set.") + (replace (SELECTION SET) of SEL with NIL] + (COND + ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION) (* ; - "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below") - (AND SEL (replace (SELECTION SET) of SEL - with NIL] - [COND - ((AND SEL (fetch (SELECTION SET) of SEL) - SELFN) (* ; - "The selection was set, but there's a SELFN that has veto authority") - (COND - ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE) - 'DON'T) (* ; - "The selfn vetoed this selection, so mark it un-set.") - (replace (SELECTION SET) of SEL with NIL] - (COND - ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION) + "Something interesting about the selection changed. We have to re-display its image.") + (COND + ((OR (EQ SELOPERATION 'NORMAL) + (EQ SELOPERATION 'PENDINGDEL)) (* ; - "Something interesting about the selection changed. We have to re-display its image.") - (COND - ((OR (EQ SELOPERATION 'NORMAL) - (EQ SELOPERATION 'PENDINGDEL)) - (* ; - "For a normal selection, set the 'window last selected in' for the TEXTOBJ") - (replace (TEXTOBJ SELWINDOW) of TEXTOBJ - with W))) - (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP - SELOPERATION EXTENDFLG)) - (SETQ OSELOP SELOPERATION)) - ([AND OSEL (fetch (SELECTION SET) of OSEL) - (EQ (fetch (SELECTION SELKIND) of OSEL) - 'VOLATILE) - (OR (NOT SEL) - (NOT (fetch (SELECTION SET) of SEL] + "For a normal selection, set the 'window last selected in' for the TEXTOBJ") + (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with W))) + (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP + SELOPERATION EXTENDFLG)) + (SETQ OSELOP SELOPERATION)) + ([AND OSEL (fetch (SELECTION SET) of OSEL) + (EQ (fetch (SELECTION SELKIND) of OSEL) + 'VOLATILE) + (OR (NOT SEL) + (NOT (fetch (SELECTION SET) of SEL] (* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.") - (\SHOWSEL OSEL NIL NIL) - (replace (SELECTION SET) of OSEL with NIL] - ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY) + (\SHOWSEL OSEL NIL NIL) + (replace (SELECTION SET) of OSEL with NIL] + ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY) (* ; - "If he moves to the scroll bar, let him scroll without trouble") - (SCROLL.HANDLER W))) - (BLOCK) (* ; "Give other processes a chance") - (GETMOUSESTATE) (* ; "And get the new mouse info") - (TEDIT.CURSORMOVEDFN W)) + "If he moves to the scroll bar, let him scroll without trouble") + (SCROLL.HANDLER W))) + (BLOCK) (* ; "Give other processes a chance") + (GETMOUSESTATE) (* ; "And get the new mouse info") + (TEDIT.CURSORMOVEDFN W)) (\COPYSEL OSEL GLOBALSEL) (COND - ((fetch (SELECTION SET) of OSEL) - (* ; - "Only if a selection REALLY got made should we do this....") + ((fetch (SELECTION SET) of OSEL) (* ; + "Only if a selection REALLY got made should we do this....") (SELECTQ SELOPERATION (COPY (* ; - "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window") + "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window") (SETQ TEDIT.COPY.PENDING T) (replace (SELECTION SET) of OSEL with NIL) (* ; - "And turn off OSEL, to avoid spurious highlighting") + "And turn off OSEL, to avoid spurious highlighting") (\TEDIT.FOREIGN.COPY? GLOBALSEL) (* ; - "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.") + "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.") ) (COPYLOOKS (* ; "A COPYLOOKS selection") (SETQ TEDIT.COPYLOOKS.PENDING T) (* ; - "And turn off OSEL, to avoid spurious highlighting") + "And turn off OSEL, to avoid spurious highlighting") (replace (SELECTION SET) of OSEL with NIL)) (MOVE (* ; - "A MOVE selection -- set the flag to signal the TEdit command loop,") + "A MOVE selection -- set the flag to signal the TEdit command loop,") (SETQ TEDIT.MOVE.PENDING T) (* ; - "And turn off OSEL, to avoid spurious highlighting") + "And turn off OSEL, to avoid spurious highlighting") (replace (SELECTION SET) of OSEL with NIL)) (DELETE (SETQ TEDIT.DEL.PENDING T) (replace (SELECTION SET) of OSEL with NIL) (* ; - "And turn off OSEL, to avoid spurious highlighting") + "And turn off OSEL, to avoid spurious highlighting") ) (NORMAL (* ; - "This is a normal selection; set the caret looks") + "This is a normal selection; set the caret looks") (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL))) NIL))) (AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL)) (* ; - "Give a user exit routine control, perhaps for logging of selections.") + "Give a user exit routine control, perhaps for logging of selections.") (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) do (OR (fetch TCUP of CARET) - (\EDIT.FLIPCARET CARET T)))) + (\EDIT.FLIPCARET CARET T)))) (AND OSEL (fetch (SELECTION SET) of OSEL) (fetch (SELECTION SELOBJ) of OSEL) (SETQ SELFINALFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of OSEL) @@ -833,7 +787,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat 'SELECTED OSEL (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])]) (\TEDIT.WINDOW.OPS - [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 12-Oct-2021 15:01 by rmk:") + [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 12-Oct-2021 15:01 by rmk:") (* ;;; "Do window operations for TEdit, e.g., splitting a window, moving the split location, or unsplitting.") @@ -842,37 +796,29 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat \TEDIT.OP.WIDTH) BOTTOM _ \TEDIT.OP.BOTTOM WIDTH _ \TEDIT.OP.WIDTH - HEIGHT _ (fetch (REGION HEIGHT) of (WINDOWPROP - WINDOWTOSPLIT - 'REGION] + HEIGHT _ (fetch (REGION HEIGHT) of (WINDOWPROP WINDOWTOSPLIT + 'REGION] Y OPERATION) [while [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) - (SETQ Y (LASTMOUSEY WINDOWTOSPLIT] do + (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) + (SETQ Y (LASTMOUSEY WINDOWTOSPLIT] do (* ;; - "Wait until he lets up on a button, and signal which button was last pushed.") + "Wait until he lets up on a button, and signal which button was last pushed.") - (BLOCK) - (COND - ((MOUSESTATE MIDDLE) - (CURSOR - \TEDIT.MAKESPLITCURSOR - ) - (SETQ OPERATION - 'SPLIT)) - ((MOUSESTATE LEFT) - (CURSOR - \TEDIT.MOVESPLITCURSOR - ) - (SETQ OPERATION - 'MOVE)) - ((MOUSESTATE RIGHT) - (CURSOR - \TEDIT.UNSPLITCURSOR - ) - (SETQ OPERATION - 'UNSPLIT] + (BLOCK) + (COND + ((MOUSESTATE MIDDLE) + (CURSOR \TEDIT.MAKESPLITCURSOR + ) + (SETQ OPERATION 'SPLIT)) + ((MOUSESTATE LEFT) + (CURSOR \TEDIT.MOVESPLITCURSOR + ) + (SETQ OPERATION 'MOVE)) + ((MOUSESTATE RIGHT) + (CURSOR \TEDIT.UNSPLITCURSOR) + (SETQ OPERATION 'UNSPLIT] (COND ((INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) (SETQ Y (LASTMOUSEY WINDOWTOSPLIT))) @@ -883,26 +829,22 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (UNSPLIT (* ; "Rejoining two panes") (\TEDIT.UNSPLITW WINDOWTOSPLIT)) (MOVE (* ; - "Moving the divider between two panes.") + "Moving the divider between two panes.") (TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T)) (SHOULDNT))) (T (CURSOR T]) (\TEDIT.EXPANDFN - [LAMBDA (W) (* jds " 7-May-85 15:56") - - (* steals back the tty for us when the TEdit window is expanded.) - + [LAMBDA (W) (* jds " 7-May-85 15:56") + (* steals back the tty for us when the + TEdit window is expanded.) (COND - ((WINDOWPROP W 'PROCESS) - - (* There's a process to go with this edit window. - Give it the TTY.) - + ((WINDOWPROP W 'PROCESS) (* There's a process to go with this + edit window. Give it the TTY.) (TTY.PROCESS (WINDOWPROP W 'PROCESS]) (\TEDIT.MAINW - [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:33 by jds") (* ;; "Get the MAIN edit window for this edit session (i.e., the one with the title, and all the props & stuff)") @@ -911,10 +853,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (SETQ WINDOWS (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))) (COND (WINDOWS (* ; - "This question only makes sense if there ARE windows for this editor.") + "This question only makes sense if there ARE windows for this editor.") (SETQ WINDOW (COND ((LISTP WINDOWS) (* ; - "how do we know we can just take the first window as the main one?") + "how do we know we can just take the first window as the main one?") (CAR WINDOWS)) (T WINDOWS))) (COND @@ -927,18 +869,17 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (T WINDOW]) (\TEDIT.PRIMARYW - [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:33 by jds") (* Given an edit session with possibly several PANES on the same document, give - me the PRINCIPAL one of them--i.e., the original edit window that has all the - back pointers, props &c on it.) + me the PRINCIPAL one of them--i.e., the original edit window that has all the + back pointers, props &c on it.) (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) WINDOWS WINDOW) (SETQ WINDOWS (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))) - (* The edit window - (s) associated with this edit - session) + (* The edit window (s) associated with + this edit session) (SETQ WINDOW (COND ((LISTP WINDOWS) @@ -946,43 +887,39 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (CAR WINDOWS)) (T (* If there's only the one window, - that's the guy.) + that's the guy.) WINDOWS))) (RETURN WINDOW]) (\TEDIT.COPYINSERTFN - [LAMBDA (INSERTIONS WW) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (INSERTIONS WW) (* ; "Edited 30-May-91 23:33 by jds") - (* Given a string, an imageobj, or a list of any of them, insert it in the - tedit window WW.) + (* Given a string, an imageobj, or a list of any of them, insert it in the tedit + window WW.) (PROG [[TEXTSTREAM (TEXTSTREAM (WINDOWPROP WW 'MAINWINDOW] (SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ (WINDOWPROP WW 'MAINWINDOW] (for INSERTION inside INSERTIONS do (COND - ((STRINGP INSERTION) - (TEDIT.INSERT TEXTSTREAM INSERTION SEL) - ) - ((IMAGEOBJP INSERTION) - (TEDIT.INSERT.OBJECT INSERTION - TEXTSTREAM SEL]) + ((STRINGP INSERTION) + (TEDIT.INSERT TEXTSTREAM INSERTION SEL)) + ((IMAGEOBJP INSERTION) + (TEDIT.INSERT.OBJECT INSERTION TEXTSTREAM SEL]) (\TEDIT.NEWREGIONFN - [LAMBDA (FIXEDPOINT MOVINGPOINT WINDOW) (* jds "24-FEB-83 17:43") - - (* This function is called whenever a new region for the window is needed. - It constrains the size of the window so that the menu and/or titles will fit) + [LAMBDA (FIXEDPOINT MOVINGPOINT WINDOW) (* jds "24-FEB-83 17:43") + + (* This function is called whenever a new region for the window is needed. + It constrains the size of the window so that the menu and/or titles will fit) (COND - ((NULL MOVINGPOINT) - - (* This is true only the first time the function is called) - + ((NULL MOVINGPOINT) (* This is true only the first time + the function is called) FIXEDPOINT) (T (PROG (%#OFMENUITEMS MENUWIDTH XDELTA YDELTA) - - (* The NEWREGIONFNARG can be either a window or a list consisting of the number - of items in the menu and the minimum width of the window neede to hold the menu - an titles) + + (* The NEWREGIONFNARG can be either a window or a list consisting of the number + of items in the menu and the minimum width of the window neede to hold the menu + an titles) (SETQ XDELTA (IDIFFERENCE (fetch (POSITION XCOORD) of MOVINGPOINT) (fetch (POSITION XCOORD) of FIXEDPOINT))) @@ -1007,152 +944,147 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (RETURN MOVINGPOINT]) (\TEDIT.SET.WINDOW.EXTENT - [LAMBDA (TEXTOBJ WINDOWS) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (TEXTOBJ WINDOWS) (* ; "Edited 30-May-91 23:33 by jds") (* Set the window's EXTENT property - according to 1st and last char on - screen.) + according to 1st and last char on + screen.) (for WINDOW inside WINDOWS do (PROG* ((REGION (DSPCLIPPINGREGION NIL WINDOW)) - (WHEIGHT (fetch HEIGHT of REGION)) - (LINES (WINDOWPROP WINDOW 'LINES)) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - TOPCHAR BOTCHAR PREVLINE EXTHEIGHT EXTBOT YBOT) - (COND - ((TEXTPROP TEXTOBJ 'NOEXTENT) (* If he doesn't want the extent - set, don't bother him.) - (RETURN))) - (OR WINDOW (RETURN)) (* Do nothing if there's no window - to do it in.) - (while (AND LINES (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - WHEIGHT)) do - (* Run thru the lines looking for - the first one on the screen.) - (SETQ LINES (fetch ( - LINEDESCRIPTOR - NEXTLINE) - of LINES))) - (COND - (LINES + (WHEIGHT (fetch HEIGHT of REGION)) + (LINES (WINDOWPROP WINDOW 'LINES)) + (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + TOPCHAR BOTCHAR PREVLINE EXTHEIGHT EXTBOT YBOT) + (COND + ((TEXTPROP TEXTOBJ 'NOEXTENT) (* If he doesn't want the extent set, + don't bother him.) + (RETURN))) + (OR WINDOW (RETURN)) (* Do nothing if there's no window to + do it in.) + (while (AND LINES (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) + WHEIGHT)) do (* Run thru the lines looking for the + first one on the screen.) + (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) + of LINES))) + (COND + (LINES (* IF there are lines on the screen, then get the CH# of the start of the first - line -- notionally, the CH at the top of the screen.) + line -- notionally, the CH at the top of the screen.) - (SETQ TOPCHAR (fetch (LINEDESCRIPTOR CHAR1) of LINES))) - (T (* Otherwise, everything is scrolled - off the top, so we're at the end.) - (SETQ TOPCHAR TEXTLEN))) - (while (AND LINES (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do (* Then go looking for the last line - on the screen) - (SETQ PREVLINE LINES) - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES))) - (COND - (PREVLINE + (SETQ TOPCHAR (fetch (LINEDESCRIPTOR CHAR1) of LINES))) + (T (* Otherwise, everything is scrolled + off the top, so we're at the end.) + (SETQ TOPCHAR TEXTLEN))) + (while (AND LINES (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) + (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + do (* Then go looking for the last line + on the screen) + (SETQ PREVLINE LINES) + (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES))) + (COND + (PREVLINE (* There IS a last line on the screen. Grab its last character as the bottom - character on the screen, and set the lowest-Y position to the bottom of that - line) + character on the screen, and set the lowest-Y position to the bottom of that line) - (SETQ BOTCHAR (IMIN TEXTLEN (fetch (LINEDESCRIPTOR CHARLIM) - of PREVLINE))) - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of PREVLINE))) - (T + (SETQ BOTCHAR (IMIN TEXTLEN (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE))) + (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of PREVLINE))) + (T (* Everything is off the top of the screen. - Bottom character is also the last char in the document, and the lowest Y we - encountered is the top of the edit window.) + Bottom character is also the last char in the document, and the lowest Y we + encountered is the top of the edit window.) - (SETQ BOTCHAR TEXTLEN) - (SETQ YBOT WHEIGHT))) - [COND - ((AND (IEQP BOTCHAR TEXTLEN) - (IEQP TOPCHAR TEXTLEN)) (* If we're really at the bottom of - the document) - (SETQ EXTBOT (SUB1 YBOT)) (* Set up the extent bottom and - height fields to account for that.) - (SETQ EXTHEIGHT WHEIGHT)) - (T + (SETQ BOTCHAR TEXTLEN) + (SETQ YBOT WHEIGHT))) + [COND + ((AND (IEQP BOTCHAR TEXTLEN) + (IEQP TOPCHAR TEXTLEN)) (* If we're really at the bottom of + the document) + (SETQ EXTBOT (SUB1 YBOT)) (* Set up the extent bottom and height + fields to account for that.) + (SETQ EXTHEIGHT WHEIGHT)) + (T (* Otherwise, set the bottom in proportion to what is left below the bottom of - the screen, and the extent height in proportion to how much text appears in the - window) + the screen, and the extent height in proportion to how much text appears in the + window) - [SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE WHEIGHT YBOT) - TEXTLEN) - (IMAX (IDIFFERENCE BOTCHAR TOPCHAR) - 1] - (SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE - WHEIGHT YBOT) - (IDIFFERENCE - TEXTLEN - BOTCHAR)) - (IMAX (IDIFFERENCE BOTCHAR - TOPCHAR) - 1] - (WINDOWPROP WINDOW 'EXTENT (create REGION - BOTTOM _ EXTBOT - HEIGHT _ (IMAX 1 EXTHEIGHT) - WIDTH _ (fetch WIDTH of REGION) - LEFT _ 0]) + [SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE WHEIGHT YBOT) + TEXTLEN) + (IMAX (IDIFFERENCE BOTCHAR TOPCHAR) + 1] + (SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE WHEIGHT + YBOT) + (IDIFFERENCE TEXTLEN + BOTCHAR)) + (IMAX (IDIFFERENCE BOTCHAR TOPCHAR + ) + 1] + (WINDOWPROP WINDOW 'EXTENT (create REGION + BOTTOM _ EXTBOT + HEIGHT _ (IMAX 1 EXTHEIGHT) + WIDTH _ (fetch WIDTH of REGION) + LEFT _ 0]) (\TEDIT.SHRINK.ICONCREATE - [LAMBDA (W ICON ICON-POSITION) (* ; "Edited 25-Apr-88 23:53 by jds") - (* ;; "Create the icon that represents this window.") + [LAMBDA (W ICON ICON-POSITION) (* ; "Edited 25-Apr-88 23:53 by jds") + + (* ;; "Create the icon that represents this window.") [PROG [(ICON (WINDOWPROP W 'ICON)) (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE)) (SHRINKFN (WINDOWPROP W 'SHRINKFN] (COND ((NOT (WINDOWPROP W 'TEXTOBJ)) (* ; - "This isn't really a TEdit window any more. Don't do anything") + "This isn't really a TEdit window any more. Don't do anything") NIL) ((WINDOWPROP W 'TEDITMENU) (* ; - "This is a text menu, and shrinks without trace.") + "This is a text menu, and shrinks without trace.") NIL) ((OR (IGREATERP (FLENGTH SHRINKFN) 3) (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN)) (IGREATERP (FLENGTH SHRINKFN) 2))) (* ; - "There are other functions that expect to handle this. Don't bother.") + "There are other functions that expect to handle this. Don't bother.") NIL) ((OR [AND ICONTITLE (EQUAL ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM W] (AND (NOT ICONTITLE) ICON)) - (* ;; - "we built this and the title is the same, or he has already put an icon on this. Do nothing") + + (* ;; + "we built this and the title is the same, or he has already put an icon on this. Do nothing") NIL) (ICON - (* ;; "There's an existing icon window; change the title in it") + (* ;; "There's an existing icon window; change the title in it") [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM - W] + W] (ICONTITLE ICONTITLE NIL NIL ICON)) (T (* ; "install a new icon") - [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM - W] - (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT + [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM W] + (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT ICON-POSITION T NIL 'FILE] (WINDOWPROP W 'ICON]) (\TEDIT.SHRINKFN - [LAMBDA (W ICON ICONW) (* jds "14-Dec-84 08:56") + [LAMBDA (W ICON ICONW) (* jds "14-Dec-84 08:56") (* hands off the tty to the exec  process) (COND ((AND (EQ (WINDOWPROP W 'PROCESS) (TTY.PROCESS))) (TTY.PROCESS T) - - (* per bvm, this means "Hand the TTY to some other process" %. - It tries EXEC first; if that's not found, it hands it to MOUSE.) + + (* per bvm, this means "Hand the TTY to some other process" %. + It tries EXEC first; if that's not found, it hands it to MOUSE.) ]) (\TEDIT.SPLITW - [LAMBDA (WINDOW Y) (* ; "Edited 30-May-91 23:38 by jds") + [LAMBDA (WINDOW Y) (* ; "Edited 30-May-91 23:38 by jds") (* ;; "SPLIT WINDOW W AT W-RELATIVE Y into 2 %"panes%" that can scroll independently.") @@ -1164,16 +1096,14 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (SETQ Y (OR Y (LASTMOUSEY WINDOW))) (* ; "Get the Y-position where we're to make the split--it's either supplied or we use the mouse's Y position.") (COND (SUBWINDOW (* ; - "If there's already a pane below this one, detach it for the moment.") + "If there's already a pane below this one, detach it for the moment.") (DETACHWINDOW SUBWINDOW))) - (SHAPEW WINDOW (create REGION using WREG BOTTOM _ (IPLUS (fetch BOTTOM - of WREG) - Y) - HEIGHT _ (IDIFFERENCE (fetch HEIGHT - of WREG) - Y))) + (SHAPEW WINDOW (create REGION using WREG BOTTOM _ (IPLUS (fetch BOTTOM of WREG) + Y) + HEIGHT _ (IDIFFERENCE (fetch HEIGHT of WREG) + Y))) (* ; - "Reshape the original window to form the upper %"pane%".") + "Reshape the original window to form the upper %"pane%".") (* ;; "Attach the new window, without disturbing the pre-existing attached windows") @@ -1190,10 +1120,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (* ;; "[end of attached-window hackery to prevent disturbance]") (WINDOWPROP NEWW 'TEDITCREATED T) - (DSPFONT (fetch (CHARLOOKS CLFONT) of (fetch (TEXTOBJ CARETLOOKS) of - TEXTOBJ)) + (DSPFONT (fetch (CHARLOOKS CLFONT) of (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) NEWW) (* ; - "Set the font on the display stream to be the current one from CARETLOOKS") + "Set the font on the display stream to be the current one from CARETLOOKS") (SETQ OLDW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) (SETQ OTITLE (\TEDIT.WINDOW.TITLE TEXTOBJ)) (SETQ OLDCARET (fetch (TEXTOBJ CARET) of TEXTOBJ)) @@ -1201,45 +1130,41 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat TCCARETDS _ (WINDOWPROP NEWW 'DSP) TCFORCEUP _ T)) [replace (TEXTOBJ CARET) of TEXTOBJ with (COND - ((LISTP OLDCARET) - (NCONC1 OLDCARET NEWCARET)) - (T (LIST OLDCARET NEWCARET] + ((LISTP OLDCARET) + (NCONC1 OLDCARET NEWCARET)) + (T (LIST OLDCARET NEWCARET] (for SEL in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - do (replace (SELECTION L1) of SEL with (NCONC1 (fetch (SELECTION - L1) - of SEL) - NIL)) - (replace (SELECTION LN) of SEL with (NCONC1 (fetch (SELECTION - LN) - of SEL) - NIL))) + (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) + (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) + (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) + (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) + do (replace (SELECTION L1) of SEL with (NCONC1 (fetch (SELECTION L1) of SEL) + NIL)) + (replace (SELECTION LN) of SEL with (NCONC1 (fetch (SELECTION LN) of SEL) + NIL))) (SETQ OLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) (\TEDIT.WINDOW.SETUP NEWW TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) (APPEND '(NOTITLE T PROMPTWINDOW DON'T) (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ)) WINDOW) [for CARET in (fetch (TEXTOBJ CARET) of TEXTOBJ) as WINDOW - in (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (replace TCCARETDS of CARET with (WINDOWPROP WINDOW 'DSP] + in (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) do (replace TCCARETDS of CARET + with (WINDOWPROP WINDOW 'DSP] (replace (TEXTOBJ WINDOWTITLE) of TEXTOBJ with OTITLE) (WINDOWPROP NEWW 'PROCESS (WINDOWPROP WINDOW 'PROCESS)) (WINDOWPROP WINDOW 'TEDIT-NEXT-PANE-DOWN NEWW) (* ; - "Tell the main window about its new lower pane.") + "Tell the main window about its new lower pane.") (COND (SUBWINDOW (* ; - "There was already a pane below this one. Attach it to the new lower pane.") + "There was already a pane below this one. Attach it to the new lower pane.") (ATTACHWINDOW SUBWINDOW NEWW 'BOTTOM 'JUSTIFY 'MAIN) (WINDOWPROP NEWW 'TEDIT-NEXT-PANE-DOWN SUBWINDOW) (* ; - "Tell the lower pane about its lower, lower pane..") + "Tell the lower pane about its lower, lower pane..") ]) (\TEDIT.UNSPLITW - [LAMBDA (WINDOW Y) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (WINDOW Y) (* ; "Edited 30-May-91 23:34 by jds") (* ;;; "Re-attach two panes of a split editing window, to make a single larger pane.") @@ -1259,49 +1184,37 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (TEDIT.PROMPTPRINT TEXTOBJ "Can't UNSPLIT the main window." T) (RETURN))) (\TEDIT.SHOWSELS TEXTOBJ NIL NIL) (* ; - "Turn off selections during the unsplit.") + "Turn off selections during the unsplit.") (DETACHWINDOW WINDOW) (* ; "Detach the pane") (COND (SUBWINDOW (* ; "The pane that's going away had a yet lower pane attached to it. Detach it from here, so we can reattach it to the unsplit part later.") (DETACHWINDOW SUBWINDOW) (WINDOWPROP WINDOW 'TEDIT-NEXT-PANE-DOWN NIL))) (WINDOWPROP MAINW 'TEDIT-NEXT-PANE-DOWN NIL) - (for CARET in (SETQ CARETS (fetch (TEXTOBJ CARET) of TEXTOBJ)) - as LINE in (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) as - OLDW - in WINDOWS when (EQ WINDOW OLDW) do - (* ; - "Remove the caret from our list, and the starting line") - (replace (TEXTOBJ CARET) - of TEXTOBJ - with (DREMOVE CARET CARETS)) - (replace (TEXTOBJ LINES) - of TEXTOBJ - with (DREMOVE LINE LINES))) - (* ; "Close the pane") + (for CARET in (SETQ CARETS (fetch (TEXTOBJ CARET) of TEXTOBJ)) as LINE + in (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) as OLDW in WINDOWS + when (EQ WINDOW OLDW) do (* ; + "Remove the caret from our list, and the starting line") + (replace (TEXTOBJ CARET) of TEXTOBJ with (DREMOVE CARET CARETS + )) + (replace (TEXTOBJ LINES) of TEXTOBJ with (DREMOVE LINE LINES)) + ) (* ; "Close the pane") (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with MAINW) (* ; - "Forget that we ever selected in the alternate window") - (replace (TEXTOBJ \WINDOW) of TEXTOBJ with (SETQ WINDOWS (DREMOVE WINDOW - WINDOWS))) + "Forget that we ever selected in the alternate window") + (replace (TEXTOBJ \WINDOW) of TEXTOBJ with (SETQ WINDOWS (DREMOVE WINDOW WINDOWS))) (* ; - "Have TEdit forget the window as well") - (replace (SELECTION L1) of SEL with (CDR (fetch (SELECTION L1) - of SEL))) - (replace (SELECTION LN) of SEL with (CDR (fetch (SELECTION LN) - of SEL))) - (replace (SELECTION L1) of SCRATCHSEL with (CDR (fetch (SELECTION L1) - of SCRATCHSEL))) - (replace (SELECTION LN) of SCRATCHSEL with (CDR (fetch (SELECTION LN) - of SCRATCHSEL))) - (for REMAININGWINDOW inside WINDOWS do - (* ; - "Run thru the remaining panes for this edit, fixing things up in the selections") - (\FIXSEL (fetch (TEXTOBJ SEL) - of TEXTOBJ) - TEXTOBJ REMAININGWINDOW)) - (TEDIT.DEACTIVATE.WINDOW WINDOW T T) (* ; - "Disable all the TEdit-related stuff on the window") + "Have TEdit forget the window as well") + (replace (SELECTION L1) of SEL with (CDR (fetch (SELECTION L1) of SEL))) + (replace (SELECTION LN) of SEL with (CDR (fetch (SELECTION LN) of SEL))) + (replace (SELECTION L1) of SCRATCHSEL with (CDR (fetch (SELECTION L1) of SCRATCHSEL))) + (replace (SELECTION LN) of SCRATCHSEL with (CDR (fetch (SELECTION LN) of SCRATCHSEL))) + (for REMAININGWINDOW inside WINDOWS do (* ; + "Run thru the remaining panes for this edit, fixing things up in the selections") + (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + TEXTOBJ REMAININGWINDOW)) + (TEDIT.DEACTIVATE.WINDOW WINDOW T T) (* ; + "Disable all the TEdit-related stuff on the window") (CLOSEW WINDOW) (* ;; "Reshape the window, without affecting the placement of attached windows") @@ -1319,21 +1232,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\TEDIT.SHOWSELS TEXTOBJ NIL T]) (\TEDIT.WINDOW.SETUP - [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 11-Jun-99 15:48 by rmk:") - (* ; "Edited 11-Jun-99 15:44 by rmk:") - (* ; "Edited 11-Jun-99 15:31 by rmk:") - (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 11-Jun-99 15:48 by rmk:") + (* ; "Edited 11-Jun-99 15:44 by rmk:") + (* ; "Edited 11-Jun-99 15:31 by rmk:") + (* ; "Edited 30-May-91 23:34 by jds") - (* ;; "Set up the window and TEXTOBJ so they correspond, and the window is a TEDIT window.") + (* ;; "Set up the window and TEXTOBJ so they correspond, and the window is a TEDIT window.") (PROG ((ICONFN (WINDOWPROP WINDOW 'ICONFN)) TEDITPROMPTWINDOW) (OR WINDOW (\ILLEGAL.ARG WINDOW)) (TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) - (* ;; "Do the general-purpose window setting up--the kind that every user will want.") + (* ;; "Do the general-purpose window setting up--the kind that every user will want.") - (* ;; "Then do the stuff that a TEdit session needs as well.") + (* ;; "Then do the stuff that a TEdit session needs as well.") (WINDOWADDPROP WINDOW 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) (WINDOWADDPROP WINDOW 'NEWREGIONFN (FUNCTION \TEDIT.NEWREGIONFN)) @@ -1343,63 +1256,63 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat [OR (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN) (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN (OR (LISTGET PROPS 'TITLEMENUFN) (FUNCTION TEDIT.DEFAULT.MENUFN] - (* ; - "Only put our menu function on the window if the originator didn't supply one.") + (* ; + "Only put our menu function on the window if the originator didn't supply one.") (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW) - T) (* ; - "To clean up when the window is closed") + T) (* ; + "To clean up when the window is closed") (WINDOWPROP WINDOW 'WINDOWENTRYFN (FUNCTION \TEDIT.PROCIDLEFN)) - (* ; - "For grabbing the TTY when the mouse clicks in the window") + (* ; + "For grabbing the TTY when the mouse clicks in the window") (OR ICONFN (WINDOWPROP WINDOW 'ICONFN (FUNCTION \TEDIT.SHRINK.ICONCREATE))) - (* ; - "Only set up to create a shrink icon if nobody else has.") + (* ; + "Only set up to create a shrink icon if nobody else has.") (WINDOWADDPROP WINDOW 'SHRINKFN (FUNCTION \TEDIT.SHRINKFN)) - (* ; - "But always give up control of the keyboard on shrinking.") + (* ; + "But always give up control of the keyboard on shrinking.") (WINDOWADDPROP WINDOW 'EXPANDFN (FUNCTION \TEDIT.EXPANDFN)) - (* ; "And grab it back on expansion") + (* ; "And grab it back on expansion") (WINDOWPROP WINDOW 'TEDIT.CURSORREGION (LIST 0 0 0 0)) [WINDOWPROP WINDOW 'HARDCOPYFILEFN (FUNCTION (LAMBDA (W EXT) (LET [(STRM (FETCH (TEXTOBJ TXTFILE) - OF (SETQ W (TEXTOBJ - W] + OF (SETQ W (TEXTOBJ W] (CL:WHEN STRM (PACKFILENAME 'VERSION NIL 'EXTENSION (OR EXT 'IMAGEFILE) 'BODY (FULLNAME STRM)))] - (* ; "Used by CursorMovedFn") + (* ; "Used by CursorMovedFn") (COND - ((NOT AFTERWINDOW) (* ; - "Only set the window's title if we aren't splitting windows.") - (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE WINDOW - (fetch (TEXTOBJ \DIRTY) of TEXTOBJ))) + ((NOT AFTERWINDOW) (* ; + "Only set the window's title if we aren't splitting windows.") + (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE WINDOW (fetch (TEXTOBJ + \DIRTY) + of TEXTOBJ))) (COND - ((EQ 'DON'T (LISTGET PROPS 'PROMPTWINDOW)) (* ; - "He said not to provide a feedback region, so don't.") + ((EQ 'DON'T (LISTGET PROPS 'PROMPTWINDOW)) (* ; + "He said not to provide a feedback region, so don't.") ) ((AND (NOT (LISTGET PROPS 'READONLY)) - [NOT (replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ - with (LISTGET PROPS 'PROMPTWINDOW] + [NOT (replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ with (LISTGET PROPS + 'PROMPTWINDOW] (NOT (fetch (TEXTOBJ MENUFLG) of TEXTOBJ))) - (* ; - "The window is read-write, so give it a feedback region") + (* ; + "The window is read-write, so give it a feedback region") (SETQ TEDITPROMPTWINDOW (GETPROMPTWINDOW WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) TEDIT.PROMPTWINDOW.HEIGHT 1) TEDIT.PROMPT.FONT)) (replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ with TEDITPROMPTWINDOW) (WINDOWPROP TEDITPROMPTWINDOW 'TEDIT.PROMPTWINDOW T) - (* ; - "And remember that this is a TEdit-supplied prompt window") + (* ; + "And remember that this is a TEdit-supplied prompt window") (WINDOWPROP TEDITPROMPTWINDOW 'PAGEFULLFN (FUNCTION \TEDIT.PROMPT.PAGEFULLFN]) (\SAFE.FIRST - [LAMBDA (LIST.OR.ATOM) (* ; "Edited 26-Apr-91 13:00 by jds") + [LAMBDA (LIST.OR.ATOM) (* ; "Edited 26-Apr-91 13:00 by jds") (* ; - "gives the first element whether the arg is a list or an atom. Should be a macro eventually") + "gives the first element whether the arg is a list or an atom. Should be a macro eventually") (COND ((LISTP LIST.OR.ATOM) (CAR LIST.OR.ATOM)) @@ -1443,7 +1356,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (TEDITWINDOWP - [LAMBDA (WINDOW) (* ; "Edited 16-Jan-89 10:28 by jds") + [LAMBDA (WINDOW) (* ; "Edited 16-Jan-89 10:28 by jds") (* ;; "Returns non-NIL if WINDOW is a legal TEdit window: I.e., if it has a TEXTOBJ property, and the TEXTOBJ thinks this is its window.") @@ -1504,13 +1417,14 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat )]) (\TEDIT.MAKEFILENAME - [LAMBDA (STRING) (* jds " 8-Feb-85 11:25") - - (* Takes a string, removes leading and trailing spaces, and converts it to an - ATOM.) - - (PROG ((FIRSTNONSPACE (STRPOSL '(% ) STRING NIL T)) - (LASTNONSPACE (STRPOSL '(% ) STRING NIL T T))) + [LAMBDA (STRING) (* jds " 8-Feb-85 11:25") + (* Takes a string, removes leading and + trailing spaces, and converts it to an + ATOM.) + (PROG ((FIRSTNONSPACE (STRPOSL '(% ) + STRING NIL T)) + (LASTNONSPACE (STRPOSL '(% ) + STRING NIL T T))) (COND ((AND FIRSTNONSPACE LASTNONSPACE) (RETURN (MKATOM (SUBSTRING STRING FIRSTNONSPACE LASTNONSPACE]) @@ -1523,8 +1437,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (TEDIT.PROMPTPRINT - [LAMBDA (TEXTSTREAM MSG CLEAR?) (* ; - "Edited 4-Jun-93 12:04 by sybalsky:mv:envos") + [LAMBDA (TEXTSTREAM MSG CLEAR?) (* ; + "Edited 4-Jun-93 12:04 by sybalsky:mv:envos") (* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.") @@ -1533,14 +1447,14 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (COND [(AND TEXTOBJ (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) (* ; - "There is a known textobj, and it's a menu. Go use the main editor's promptwindow.") + "There is a known textobj, and it's a menu. Go use the main editor's promptwindow.") (SETQ MAINTEXTOBJ (WINDOWPROP (\TEDIT.MAINW TEXTOBJ) 'TEXTOBJ)) (* ; - "Find the TEXTOBJ for the main edit window, and use ITS prompting window.") + "Find the TEXTOBJ for the main edit window, and use ITS prompting window.") (SETQ WINDOW (AND MAINTEXTOBJ (fetch (TEXTOBJ PROMPTWINDOW) of MAINTEXTOBJ] (TEXTOBJ (SETQ WINDOW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) (* ; - "There IS an editor window to get to; use its prompt window") + "There IS an editor window to get to; use its prompt window") )) [SETQ WINDOW (CAR (NLSETQ (SELECTQ WINDOW (DON'T [COND @@ -1551,10 +1465,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat NIL NIL (NOT (TEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]) WINDOW] (* ; - "Try to find an editor's prompt window for our message") + "Try to find an editor's prompt window for our message") (COND (WINDOW (* ; - "We found a window to use. Print the message.") + "We found a window to use. Print the message.") (* ;; "WAS (RESETLST (RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (COND (CLEAR? (CLEARW WINDOW))) (PRIN1 MSG WINDOW))") @@ -1563,44 +1477,43 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (CLEARW WINDOW))) (PRIN1 MSG WINDOW)) (T (* ; - "Failing all else, use PROMPTWINDOW.") + "Failing all else, use PROMPTWINDOW.") (FRESHLINE PROMPTWINDOW) (printout PROMPTWINDOW MSG]) (TEDIT.PROMPTFLASH - [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:34 by jds") (* Flash the TEdit prompt window, or - the global promptwindow, if TEdit - has none.) + the global promptwindow, if TEdit has + none.) (PROG (WINDOW PWINDOW (TEXTOBJ (TEXTOBJ TEXTSTREAM)) MAINTEXTOBJ) (COND [(AND TEXTOBJ (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) (* There is a known textobj, and it's a menu. - Go use the main editor's promptwindow.) + Go use the main editor's promptwindow.) (SETQ MAINTEXTOBJ (WINDOWPROP (\TEDIT.MAINW TEXTOBJ) - 'TEXTOBJ)) (* Find the TEXTOBJ for the main - edit window, and use ITS prompting - window.) + 'TEXTOBJ)) (* Find the TEXTOBJ for the main edit + window, and use ITS prompting window.) (SETQ WINDOW (AND MAINTEXTOBJ (fetch (TEXTOBJ PROMPTWINDOW) of MAINTEXTOBJ] ((AND TEXTOBJ (SETQ WINDOW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) (* There IS an editor window to get - to; use its prompt window) + to; use its prompt window) ) ((SETQ WINDOW (GETPROMPTWINDOW (\TEDIT.MAINW TEXTSTREAM) - NIL NIL T)) (* Failing that, try any prompt - window attached to the edit window.) + NIL NIL T)) (* Failing that, try any prompt window + attached to the edit window.) )) (* Try to find an editor's prompt - window for our message) + window for our message) (FLASHWINDOW (OR WINDOW PROMPTWINDOW) 2]) (\TEDIT.PROMPT.PAGEFULLFN - [LAMBDA (PROMPT-DISPLAY-STREAM) (* ; "Edited 18-Nov-87 14:44 by jds") - - (* ;; "Given a TEdit promptwindow, expand it to be a line taller--called when a message overflows the window.") + [LAMBDA (PROMPT-DISPLAY-STREAM) (* ; "Edited 18-Nov-87 14:44 by jds") + + (* ;; "Given a TEdit promptwindow, expand it to be a line taller--called when a message overflows the window.") (LET* [(PROMPT-WINDOW (WFROMDS PROMPT-DISPLAY-STREAM)) (%#LINES (ADD1 (OR (WINDOWPROP PROMPT-WINDOW 'TEDIT.NLINES) @@ -1611,14 +1524,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (MAINWINDOW (WINDOWPROP PROMPT-WINDOW 'MAINWINDOW)) (ATTACHEDMENUS (REMOVE PROMPT-WINDOW (ATTACHEDWINDOWS MAINWINDOW] (GETPROMPTWINDOW MAINWINDOW %#LINES) (* ; "Get the new window") - (SETQ \CURRENTDISPLAYLINE (CL:1- %#LINES)) (* ; "Set this so the page-full code will fire again at the end of THIS line, rather than waiting for another screen-ful. There ought to be an interface to this.") - [SETQ NEWTOP (fetch (REGION TOP) of (WINDOWPROP PROMPT-WINDOW 'REGION] - [for WINDOW in (REVERSE ATTACHEDMENUS) - when (>= (fetch (REGION BOTTOM) of (WINDOWPROP WINDOW 'REGION)) - OLDBOTTOM) do (RELMOVEW WINDOW (CREATEPOSITION 0 (IDIFFERENCE NEWTOP - OLDTOP] + [for WINDOW in (REVERSE ATTACHEDMENUS) when (>= (fetch (REGION BOTTOM) + of (WINDOWPROP WINDOW 'REGION)) + OLDBOTTOM) + do (RELMOVEW WINDOW (CREATEPOSITION 0 (IDIFFERENCE NEWTOP OLDTOP] (WINDOWPROP PROMPT-WINDOW 'TEDIT.NLINES %#LINES]) ) @@ -1637,9 +1548,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (TEXTSTREAM.TITLE - [LAMBDA (STREAM) (* ; "Edited 24-Aug-2021 23:25 by rmk:") + [LAMBDA (STREAM) (* ; "Edited 24-Aug-2021 23:25 by rmk:") - (* ;; "returns a string with which you can talk to the user about this stream") + (* ;; "returns a string with which you can talk to the user about this stream") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) TXTFILE) @@ -1652,7 +1563,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ""]) (\TEDIT.ORIGINAL.WINDOW.TITLE - [LAMBDA (FILE DIRTY? PROPS) (* ; "Edited 27-Oct-2021 12:25 by rmk:") + [LAMBDA (FILE DIRTY? PROPS) (* ; "Edited 27-Oct-2021 12:25 by rmk:") (* ; "Edited 24-Aug-2021 23:25 by rmk:") (* ;; "Given a file name, derive a title for the TEdit window that is editing it. RMK: Title may be provided in a property") @@ -1661,18 +1572,17 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat [SETQ TITLE (COND ((LISTGET PROPS 'TITLE)) ((NULL FILE) (* ; - "Just calling (TEDIT) should give a 'Text Editor Window'") + "Just calling (TEDIT) should give a 'Text Editor Window'") "Text Editor Window") ((AND (STRINGP FILE) - (ZEROP (NCHARS FILE))) (* ; - "So should editing an empty string") + (ZEROP (NCHARS FILE))) (* ; "So should editing an empty string") "Text Editor Window") ((WINDOWP FILE) (* ; - "if \TEDIT.WINDOW.SETUP has assigned a title, use it") + "if \TEDIT.WINDOW.SETUP has assigned a title, use it") (OR (WINDOWPROP FILE 'TITLE) "Text Editor Window")) (T (* ; - "Strings use the string itself, otherwise grab the full file name.") + "Strings use the string itself, otherwise grab the full file name.") (CONCAT "Edit Window for: " (CL:TYPECASE FILE (STRINGP FILE) (STREAM (fetch (STREAM FULLNAME) @@ -1684,23 +1594,23 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (T TITLE]) (\TEDIT.WINDOW.TITLE - [LAMBDA (TEXTSTREAM NEW.TITLE) (* jds "23-May-85 15:20") + [LAMBDA (TEXTSTREAM NEW.TITLE) (* jds "23-May-85 15:20") (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) W) (RETURN (COND ((AND (SETQ W (\TEDIT.PRIMARYW TEXTOBJ)) (NOT (TEXTPROP TEXTOBJ 'NOTITLE)) (TEXTPROP TEXTOBJ 'TEDITCREATEDWINDOW)) - - (* Only change the title if there IS a window, and he isn't suppressing title - changes.) + + (* Only change the title if there IS a window, and he isn't suppressing title + changes.) (COND (NEW.TITLE (WINDOWPROP W 'TITLE NEW.TITLE)) (T (WINDOWPROP W 'TITLE]) (\TEXTSTREAM.FILENAME - [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:34 by jds") (* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed") @@ -1708,9 +1618,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat OFILE) [COND ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (SETQ OFILE (PACKFILENAME 'VERSION NIL 'BODY (fetch FULLFILENAME - (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ] + (SETQ OFILE (PACKFILENAME 'VERSION NIL 'BODY (fetch FULLFILENAME (fetch (TEXTOBJ + TXTFILE) + of TEXTOBJ] (RETURN OFILE]) ) @@ -1721,12 +1631,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (TEDIT.DEACTIVATE.WINDOW - [LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 16-Oct-2021 18:51 by rmk:") + [LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 16-Oct-2021 18:51 by rmk:") (* ;; "Deactivate the various button fns for this window") (PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ] (* ; - "Can't be a call to TEXTOBJ, since window may NOT have a textobj on it.") + "Can't be a call to TEXTOBJ, since window may NOT have a textobj on it.") (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T) [COND ((AND TEXTOBJ (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)) @@ -1739,7 +1649,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) (NOT FORCEFLG)) (* ; - "This is an un-quit TEdit window. Try to QUIT out of TEdit.") + "This is an un-quit TEdit window. Try to QUIT out of TEdit.") (COND ((\TEDIT.QUIT W T)) (T @@ -1751,14 +1661,14 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (NOT (PROCESSP (WINDOWPROP W 'PROCESS] (* ; - "Only do this if it's a TEdit window, and has been QUIT out of.") + "Only do this if it's a TEdit window, and has been QUIT out of.") [COND ((AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) (CLEARW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL NIL) (* ; - "Before the window is closed, make SURE that the caret is down, or the window will reappear.") + "Before the window is closed, make SURE that the caret is down, or the window will reappear.") (COND ((AND (\TEDIT.WINDOW.TITLE TEXTOBJ) (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) @@ -1767,27 +1677,26 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (NOT DISCONNECTONLYFLG)) (\TEDIT.WINDOW.TITLE TEXTOBJ "Edit Window [Inactive]") (* ; - "Reset the window's title to a known 'inactive' value") + "Reset the window's title to a known 'inactive' value") )) [COND ((NOT DISCONNECTONLYFLG) (for PANE in (REVERSE (CDR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) do + (* ;; "Run thru any split-off sub-panes, and reattach them, so we get a whole window back before the end of the world.") - (* ;; "Run thru any split-off sub-panes, and reattach them, so we get a whole window back before the end of the world.") - - (\TEDIT.UNSPLITW PANE)) + (\TEDIT.UNSPLITW PANE)) (replace (TEXTOBJ \WINDOW) of TEXTOBJ with NIL) (COND ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (* ; - "Close the file that this window was open on.") + "Close the file that this window was open on.") (COND ((NOT (WINDOWPROP W 'TEDIT-CLOSING-FILE T)) (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (WINDOWPROP W 'TEDIT-CLOSING-FILE NIL] (WINDOWPROP W 'TEXTOBJ NIL) (* ; - "Detach the edit data structures from the window") + "Detach the edit data structures from the window") (WINDOWPROP W 'TEXTSTREAM NIL) (WINDOWPROP W 'LINES NIL) (WINDOWPROP W 'THISLINE NIL) @@ -1804,69 +1713,65 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (WINDOWPROP W 'PROCESS) (\TEDIT.INTERRUPT.SETUP (WINDOWPROP W 'PROCESS) T)) (* ; - "Make sure any disarmed interrupts are restored.") + "Make sure any disarmed interrupts are restored.") (for MENUW in (ATTACHEDWINDOWS W) when (AND (WINDOWPROP MENUW 'TEDITMENU) - (WINDOWPROP MENUW 'TEXTOBJ)) - do (* ; - "Detach all the TEDITMENU windows that belong to this window.") - (replace (TEXTOBJ EDITFINISHEDFLG) of (TEXTOBJ MENUW) with T) + (WINDOWPROP MENUW 'TEXTOBJ)) + do (* ; + "Detach all the TEDITMENU windows that belong to this window.") + (replace (TEXTOBJ EDITFINISHEDFLG) of (TEXTOBJ MENUW) with T) (* ; "Mark it finished") - (WINDOWPROP MENUW 'TEDITMENU NIL) (* ; - "And mark it no longer a menu window") - (GIVE.TTY.PROCESS MENUW) (* ; - "Then give it a chance to kill itself off") - (DISMISS 300)) + (WINDOWPROP MENUW 'TEDITMENU NIL) (* ; + "And mark it no longer a menu window") + (GIVE.TTY.PROCESS MENUW) (* ; + "Then give it a chance to kill itself off") + (DISMISS 300)) (COND ((NOT DISCONNECTONLYFLG) (GIVE.TTY.PROCESS W) (DISMISS 300))) [replace (TEXTOBJ \WINDOW) of TEXTOBJ with (COND - ((LISTP (fetch - (TEXTOBJ \WINDOW) - of TEXTOBJ)) + ((LISTP (fetch (TEXTOBJ \WINDOW) + of TEXTOBJ)) + (* ; "It's a list; remove this window") + (DREMOVE W (fetch (TEXTOBJ \WINDOW) + of TEXTOBJ] (* ; - "It's a list; remove this window") - (DREMOVE W - (fetch - (TEXTOBJ \WINDOW) - of TEXTOBJ] - (* ; - "Disconnect the window from the edit data structures as well.") + "Disconnect the window from the edit data structures as well.") ]) (\TEDIT.REPAINTFN - [LAMBDA (W) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (W) (* ; "Edited 30-May-91 23:34 by jds") (* Will eventually do the right thing w/r/t text margins. - For now, it's a place holder.) + For now, it's a place holder.) (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (TEXTSTREAM (WINDOWPROP W 'TEXTSTREAM)) (WREG (DSPCLIPPINGREGION NIL W)) (CH# 0) WHEIGHT FIRSTCH# LINES LINE WWIDTH) - (OR TEXTOBJ (RETURN)) (* If this window has no TEXTOBJ on - it yet, just leave.) + (OR TEXTOBJ (RETURN)) (* If this window has no TEXTOBJ on it + yet, just leave.) (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL NIL) (* Turn off the selection while we - make changes) - (SETQ WHEIGHT (fetch PTOP of WREG)) (* Old window height) + make changes) + (SETQ WHEIGHT (fetch PTOP of WREG)) (* Old window height) (OR (SETQ LINES (WINDOWPROP W 'LINES)) - (RETURN)) (* If no text has been displayed - yet, just leave) + (RETURN)) (* If no text has been displayed yet, + just leave) (SETQ LINE LINES) (while LINE do - (* Now hunt for the first line that had been visible, so we can find the CH# - that has to appear at the top of the window.) + (* Now hunt for the first line that had been visible, so we can find the CH# that + has to appear at the top of the window.) - (COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT) (* This line was visible) - (SETQ FIRSTCH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (COND + ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) + WHEIGHT) (* This line was visible) + (SETQ FIRSTCH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) (* Note its first character %#) - (RETURN))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + (RETURN))) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) (COND (LINE @@ -1875,20 +1780,20 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\DISPLAYLINE TEXTOBJ LINE W) (* Actually display it) (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) LINE TEXTOBJ NIL W) (* Fill out the window with more - lines, to fill or to EOF) + lines, to fill or to EOF) )) (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) (* Fix up the selection to account - for the line shuffling) + TEXTOBJ) (* Fix up the selection to account for + the line shuffling) (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL T) (* And highlight it) ]) (\TEDIT.RESHAPEFN - [LAMBDA (W BITS OLDREGION) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (W BITS OLDREGION) (* ; "Edited 30-May-91 23:34 by jds") (* Will eventually do the right thing w/r/t text margins. - For now, it's a place holder.) + For now, it's a place holder.) (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (TEXTSTREAM (WINDOWPROP W 'TEXTSTREAM)) @@ -1898,37 +1803,33 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (NEWBOTTOM 0) (CH# 0) WHEIGHT FIRSTCH# LINES LINE WWIDTH) - (OR TEXTOBJ (RETURN)) (* If this window has no TEXTOBJ on - it yet, just leave.) + (OR TEXTOBJ (RETURN)) (* If this window has no TEXTOBJ on it + yet, just leave.) (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL NIL) (* Turn off the selection while we - make changes) - (SETQ WHEIGHT (fetch HEIGHT of OLDREGION)) (* Old window height) - (replace (TEXTOBJ WTOP) of TEXTOBJ with NEWWHEIGHT) - (* Save new height/width for later - use) + make changes) + (SETQ WHEIGHT (fetch HEIGHT of OLDREGION)) (* Old window height) + (replace (TEXTOBJ WTOP) of TEXTOBJ with NEWWHEIGHT)(* Save new height/width for later use) (replace (TEXTOBJ WRIGHT) of TEXTOBJ with NEWWWIDTH) (replace (TEXTOBJ WBOTTOM) of TEXTOBJ with NEWBOTTOM) (replace (TEXTOBJ WLEFT) of TEXTOBJ with NEWLEFT) (OR (SETQ LINES (WINDOWPROP W 'LINES)) - (RETURN)) (* If no text has been displayed - yet, just leave) + (RETURN)) (* If no text has been displayed yet, + just leave) (SETQ LINE LINES) (while LINE do - (* Now hunt for the first line that had been visible, so we can find the CH# - that has to appear at the top of the window.) + (* Now hunt for the first line that had been visible, so we can find the CH# that + has to appear at the top of the window.) - (COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT) (* This line was visible) - (SETQ FIRSTCH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (COND + ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) + WHEIGHT) (* This line was visible) + (SETQ FIRSTCH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) (* Note its first character %#) - (RETURN)) - (T (replace (LINEDESCRIPTOR YBOT) of LINE with - NEWWHEIGHT - ))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) + (RETURN)) + (T (replace (LINEDESCRIPTOR YBOT) of LINE with NEWWHEIGHT))) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) (AND FIRSTCH# (SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ NEWWHEIGHT FIRSTCH# W))) (COND (LINE @@ -1940,30 +1841,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (replace (LINEDESCRIPTOR NEXTLINE) of LINES with LINE) (replace (LINEDESCRIPTOR PREVLINE) of LINE with LINES))) (* Forget the old chain of line - descriptors) - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE - NEWWHEIGHT - (fetch ( - LINEDESCRIPTOR - LHEIGHT) - of LINE))) + descriptors) + (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE NEWWHEIGHT + (fetch (LINEDESCRIPTOR LHEIGHT) + of LINE))) (* Fix the line to appear at the top - of the window) - (replace (LINEDESCRIPTOR YBASE) of LINE with - (IPLUS (fetch (LINEDESCRIPTOR - YBOT) - of LINE) - (fetch (LINEDESCRIPTOR - DESCENT) - of LINE))) + of the window) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR YBOT) + of LINE) + (fetch (LINEDESCRIPTOR DESCENT + ) of LINE))) (\DISPLAYLINE TEXTOBJ LINE W) (* Actually display it) (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) LINE TEXTOBJ NIL W) (* Fill out the window with more - lines, to fill or to EOF) + lines, to fill or to EOF) )) (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) (* Fix up the selection to account - for the line shuffling) + TEXTOBJ) (* Fix up the selection to account for + the line shuffling) (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) NIL T) (* And highlight it) ]) @@ -2352,11 +2247,11 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (\TEDIT.PROCIDLEFN - [LAMBDA (WINDOW) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (WINDOW) (* ; "Edited 30-May-91 23:35 by jds") (* TEDIT's PROC.IDLEFN for regaining control. - If the shift key is down, we're not trying to restart this window, just to copy - from it.) + If the shift key is down, we're not trying to restart this window, just to copy + from it.) (GETMOUSESTATE) (COND @@ -2368,30 +2263,28 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (KEYDOWNP 'MOVE) (KEYDOWNP 'COPY] (PROCESSP (WINDOWPROP WINDOW 'PROCESS] (* No SHIFT key down; - let's regain control.) + let's regain control.) (TTY.PROCESS (WINDOWPROP WINDOW 'PROCESS)) (COND ((fetch (TEXTOBJ MENUFLG) of (WINDOWPROP (WHICHW) - 'TEXTOBJ)) - (* This is a MENU -- - always select.) + 'TEXTOBJ)) (* This is a MENU -- + always select.) (\TEDIT.BUTTONEVENTFN WINDOW] (T (* Otherwise, let him select.) (\TEDIT.BUTTONEVENTFN WINDOW]) (\TEDIT.PROCENTRYFN - [LAMBDA (NEWPROCESS OLDPROCESS) (* jds "15-Feb-84 16:59") - - (* TEDIT's PROCESS.ENTRYFN, which disarms any dangerous interrupts within the - editing world) - + [LAMBDA (NEWPROCESS OLDPROCESS) (* jds "15-Feb-84 16:59") + (* TEDIT's PROCESS.ENTRYFN, which + disarms any dangerous interrupts + within the editing world) (\TEDIT.INTERRUPT.SETUP NEWPROCESS]) (\TEDIT.PROCEXITFN - [LAMBDA (THISP NEWP) (* jds " 5-Apr-84 10:40") - - (* Re-arm any interrupts that TEdit turned off, so the poor user has them - available in other parts of the system.) + [LAMBDA (THISP NEWP) (* jds " 5-Apr-84 10:40") + + (* Re-arm any interrupts that TEdit turned off, so the poor user has them + available in other parts of the system.) (AND (WINDOWPROP (PROCESSPROP THISP 'WINDOW) 'TEXTOBJ) @@ -2407,9 +2300,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (\EDIT.DOWNCARET - [LAMBDA (CARET) (* ; "Edited 13-Nov-87 08:25 by jds") - - (* ;; "Put the caret down -- i.e., MAKE IT VISIBLE -- as fast as possible") + [LAMBDA (CARET) (* ; "Edited 13-Nov-87 08:25 by jds") + + (* ;; "Put the caret down -- i.e., MAKE IT VISIBLE -- as fast as possible") (LET* ((DS (fetch (TEDITCARET TCCARETDS) of CARET)) (X (DSPXPOSITION NIL DS)) @@ -2424,16 +2317,16 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat [LAMBDA (CARET FORCE) (* ; "Edited 30-Mar-87 16:50 by jds") (* ;  "changes the caret from on to off or off to on.") - - (* ;; "(COND ((OR FORCE (fetch TCFORCEDDOWN of CARET) (AND (IGREATERP (CLOCK0 (fetch TCNOWTIME of CARET)) (fetch TCTHENTIME of CARET)) (NOT (fetch TCFORCEUP of CARET)))) (UNINTERRUPTABLY (* note the time of the next change.) (* must be done without creating boxes because happens during keyboard wait.) (\BOXIPLUS (CLOCK0 (fetch TCTHENTIME of CARET)) (fetch TCCARETRATE of CARET)) (* Set the time for the next caret transition) (replace TCUP of CARET with (NOT (fetch TCUP of CARET))) (* Invert the sense of the caret's UPness) (replace TCFORCEDDOWN of CARET with NIL) (* Turn off the force-down & Force-up flags) (replace TCFORCEUP of CARET with NIL) (PROG ((DS (fetch TCCARETDS of CARET)) (CURS (fetch TCCURSORBM of CARET))) (COND ((fetch TCUP of CARET)) (T (* We're putting the caret down -- set the new X,Y position) (replace TCCARETX of CARET with (DSPXPOSITION NIL DS)) (replace TCCARETY of CARET with (DSPYPOSITION NIL DS)))) (BITBLT (fetch (CURSOR CUIMAGE) of CURS) 0 0 DS (IDIFFERENCE (fetch TCCARETX of CARET) (fetch (CURSOR CUHOTSPOTX) of CURS)) (IDIFFERENCE (fetch TCCARETY of CARET) (fetch (CURSOR CUHOTSPOTY) of CURS)) CURSORWIDTH CURSORHEIGHT (QUOTE INPUT) (QUOTE INVERT))))))") + + (* ;; "(COND ((OR FORCE (fetch TCFORCEDDOWN of CARET) (AND (IGREATERP (CLOCK0 (fetch TCNOWTIME of CARET)) (fetch TCTHENTIME of CARET)) (NOT (fetch TCFORCEUP of CARET)))) (UNINTERRUPTABLY (* note the time of the next change.) (* must be done without creating boxes because happens during keyboard wait.) (\BOXIPLUS (CLOCK0 (fetch TCTHENTIME of CARET)) (fetch TCCARETRATE of CARET)) (* Set the time for the next caret transition) (replace TCUP of CARET with (NOT (fetch TCUP of CARET))) (* Invert the sense of the caret's UPness) (replace TCFORCEDDOWN of CARET with NIL) (* Turn off the force-down & Force-up flags) (replace TCFORCEUP of CARET with NIL) (PROG ((DS (fetch TCCARETDS of CARET)) (CURS (fetch TCCURSORBM of CARET))) (COND ((fetch TCUP of CARET)) (T (* We're putting the caret down -- set the new X,Y position) (replace TCCARETX of CARET with (DSPXPOSITION NIL DS)) (replace TCCARETY of CARET with (DSPYPOSITION NIL DS)))) (BITBLT (fetch (CURSOR CUIMAGE) of CURS) 0 0 DS (IDIFFERENCE (fetch TCCARETX of CARET) (fetch (CURSOR CUHOTSPOTX) of CURS)) (IDIFFERENCE (fetch TCCARETY of CARET) (fetch (CURSOR CUHOTSPOTY) of CURS)) CURSORWIDTH CURSORHEIGHT (QUOTE INPUT) (QUOTE INVERT))))))") NIL]) (TEDIT.FLASHCARET - [LAMBDA (CARETS) (* jds "16-Jul-85 12:35") - - (* Unless the caret is constrained to be INVISIBLE, give it a chance to flash.) - + [LAMBDA (CARETS) (* jds "16-Jul-85 12:35") + (* Unless the caret is constrained to + be INVISIBLE, give it a chance to + flash.) (bind (FIRSTTIME _ T) for CARET inside CARETS do (COND ((NOT (fetch TCFORCEUP of CARET)) (* The caret need not stay invisible.) @@ -2450,18 +2343,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (fetch TCCARETY of CARET]) (\EDIT.UPCARET - [LAMBDA (CARET) (* ; "Edited 13-Nov-87 08:27 by jds") - - (* ;; "Take the caret up -- i.e., MAKE IT INVISIBLE -- and keep it up") + [LAMBDA (CARET) (* ; "Edited 13-Nov-87 08:27 by jds") + + (* ;; "Take the caret up -- i.e., MAKE IT INVISIBLE -- and keep it up") (\CARET.DOWN (fetch (TEDITCARET TCCARETDS) of CARET)) - - (* ;; "The TCFORCEUP field is set so that the caret will stay off-screen:") + + (* ;; "The TCFORCEUP field is set so that the caret will stay off-screen:") (replace (TEDITCARET TCFORCEUP) of CARET with T]) (TEDIT.NORMALIZECARET - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (TEXTOBJ SEL) (* ; "Edited 30-May-91 23:35 by jds") (* ;; "Scroll the text window so that the caret is visible in it.") @@ -2477,74 +2370,69 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (OR WINDOW (RETURN)) (OR (fetch (SELECTION SET) of SEL) (RETURN)) (* ; - "If there is no selection set, don't bother.") + "If there is no selection set, don't bother.") (COND (SELWASON (* ; - "The selection is hilited, so turn it off.") + "The selection is hilited, so turn it off.") (\SHOWSEL SEL NIL NIL))) - (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as L1 - inside (fetch (SELECTION L1) of SEL) as LN + (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as L1 inside (fetch (SELECTION L1) + of SEL) as LN inside (fetch (SELECTION LN) of SEL) when (EQ WW WINDOW) do + (* ;; "Get to the line info for the SELWINDOW. (failing that, the main/only edit window) Use that info to decide where the caret is.") - (* ;; "Get to the line info for the SELWINDOW. (failing that, the main/only edit window) Use that info to decide where the caret is.") - - (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (* ; - "The caret is at the left end of the selection; hunt for the first selected character") - (SETQ CH# (fetch (SELECTION CH#) of SEL)) - (SETQ Y (OR (AND L1 (fetch (LINEDESCRIPTOR YBOT) of L1)) - (fetch (SELECTION Y0) of SEL)))) - (RIGHT (* ; - "The caret is at the right end of the selection; hunt for the last selected character") - (SETQ CH# (SUB1 (fetch (SELECTION CHLIM) of SEL))) - (SETQ Y (OR (AND LN (fetch (LINEDESCRIPTOR YBOT) of LN)) - (fetch (SELECTION YLIM) of SEL)))) - NIL)) + (SELECTQ (fetch (SELECTION POINT) of SEL) + (LEFT (* ; + "The caret is at the left end of the selection; hunt for the first selected character") + (SETQ CH# (fetch (SELECTION CH#) of SEL)) + (SETQ Y (OR (AND L1 (fetch (LINEDESCRIPTOR YBOT) of L1)) + (fetch (SELECTION Y0) of SEL)))) + (RIGHT (* ; + "The caret is at the right end of the selection; hunt for the last selected character") + (SETQ CH# (SUB1 (fetch (SELECTION CHLIM) of SEL))) + (SETQ Y (OR (AND LN (fetch (LINEDESCRIPTOR YBOT) of LN)) + (fetch (SELECTION YLIM) of SEL)))) + NIL)) (COND ((AND (OR (IGEQ Y WHEIGHT) (ILESSP Y WBOTTOM)) (NOT (fetch (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ))) (* ; - "The caret is off-screen. Scroll to get it on") + "The caret is off-screen. Scroll to get it on") (for LINE inside (fetch (SELECTION L1) of SEL) when LINE do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 WBOTTOM))) (* ; - "Make sure it thinks the old selection is off-screen for now") + "Make sure it thinks the old selection is off-screen for now") (for LINE inside (fetch (SELECTION LN) of SEL) when LINE do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 WBOTTOM))) (SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ WHEIGHT (IMAX 1 (IMIN CH# - (fetch - (TEXTOBJ TEXTLEN) + (fetch (TEXTOBJ + TEXTLEN) of TEXTOBJ))) WINDOW)) (* ; - "Find the first line to go in the window") - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE - WHEIGHT - (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE))) + "Find the first line to go in the window") + (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE WHEIGHT (fetch ( + LINEDESCRIPTOR + LHEIGHT) + of LINE))) (* ; "Set it up as the top line.") - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch - (LINEDESCRIPTOR - YBOT) of LINE) - (fetch - (LINEDESCRIPTOR - DESCENT) - of LINE))) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR YBOT) + of LINE) + (fetch (LINEDESCRIPTOR DESCENT) + of LINE))) (\DISPLAYLINE TEXTOBJ LINE WINDOW) (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) LINE TEXTOBJ NIL WINDOW) (* ; - "And fill out the window from there.") + "And fill out the window from there.") (\FIXSEL SEL TEXTOBJ) (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW))) (COND (SELWASON (* ; - "The selection is hilited, so turn it back on.") + "The selection is hilited, so turn it back on.") (\SHOWSEL SEL NIL T]) (\SETCARET - [LAMBDA (X Y DS TEXTOBJ CARET) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (X Y DS TEXTOBJ CARET) (* ; "Edited 30-May-91 23:35 by jds") (PROG ((CLIPREGION (DSPCLIPPINGREGION NIL DS))) (COND [(AND (ILESSP Y (fetch PTOP of CLIPREGION)) @@ -2555,20 +2443,19 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\EDIT.DOWNCARET CARET] (T - (* The caret is off screen. Do a MOVETO so the system carets don't appear at - odd times.) + (* The caret is off screen. Do a MOVETO so the system carets don't appear at odd + times.) (MOVETO (IPLUS (fetch PTOP of CLIPREGION) 12) - 0 DS))) (* Only put down the caret the line - it points to is on-screen) + 0 DS))) (* Only put down the caret the line it + points to is on-screen) ]) (\TEDIT.CARET - [LAMBDA (CARETS) (* jds "12-Jul-85 11:18") - - (* Reset the caret to its normal state state, from the selection caret) - + [LAMBDA (CARETS) (* jds "12-Jul-85 11:18") + (* Reset the caret to its normal state + state, from the selection caret) (for CARET inside CARETS do (replace TCCARET of CARET with (\CARET.CREATE BXCARET]) ) @@ -2579,10 +2466,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (TEDIT.ADD.MENUITEM - [LAMBDA (MENU ITEM) (* jds " 9-AUG-83 09:55") - - (* Adds ITEM to the MENU, and updates all the stuff.) - + [LAMBDA (MENU ITEM) (* jds " 9-AUG-83 09:55") + (* Adds ITEM to the MENU, and updates + all the stuff.) (PROG (OLDITM) (COND ((MEMBER ITEM (fetch ITEMS of MENU)) (* Do nothing--it's already in the @@ -2590,23 +2476,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ) ([AND (LISTP ITEM) (SETQ OLDITM (SASSOC (CAR ITEM) - (fetch ITEMS of MENU] - - (* The menu item exists. Make sure the thing behind it is right.) - + (fetch ITEMS of MENU] (* The menu item exists. + Make sure the thing behind it is + right.) (RPLACD OLDITM (CDR ITEM))) - (T - - (* It isn't in the menu, so go ahead and add it.) - + (T (* It isn't in the menu, so go ahead + and add it.) (replace ITEMS of MENU with (NCONC1 (fetch ITEMS of MENU) ITEM)) (COND ((EQ (fetch MENUCOLUMNS of MENU) - 1) - - (* If there is only one column, force a re-figuring of the number of rows) - + 1) (* If there is only one column, force + a re-figuring of the number of rows) (replace MENUROWS of MENU with NIL)) ((EQ (fetch MENUROWS of MENU) 1) (* There's only one row, so recompute @@ -2619,10 +2500,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (UPDATE/MENU/IMAGE MENU]) (TEDIT.DEFAULT.MENUFN - [LAMBDA (W) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (W) (* ; "Edited 30-May-91 23:35 by jds") (* ;; - "Default MENU Fn for editor windows--displays a menu of items & acts on the commands received.") + "Default MENU Fn for editor windows--displays a menu of items & acts on the commands received.") (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (WMENU (WINDOWPROP W 'TEDIT.MENU)) @@ -2632,7 +2513,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat T) (* ;; - "We're busy doing something, but not sure what. Give a general 'please wait' msg:") + "We're busy doing something, but not sure what. Give a general 'please wait' msg:") (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T) (RETURN)) @@ -2640,9 +2521,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (* ;; "We know specifically what's happening. Tell him:") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ - ) - " in progress; please wait.") + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) + " in progress; please wait.") T) (RETURN))) (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) @@ -2657,33 +2537,31 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) '(AND (\TEDIT.MARKINACTIVE OLDVALUE] (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with (OR (CAR ITEM) - T)) + T)) (* ; - "So we ca ntell the guy WHAT op is active.") + "So we ca ntell the guy WHAT op is active.") [SELECTQ (CAR ITEM) ((Put |Put Formatted Document|) (TEDIT.PUT TEXTOBJ NIL NIL (TEXTPROP TEXTOBJ 'CLEARPUT))) (Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T)) (Old-Format (* ; - "Write out the file in the OLD TEdit format.") + "Write out the file in the OLD TEdit format.") (TEDIT.PUT TEXTOBJ NIL NIL NIL T)) ((Get |Get Formatted Document|) (* ; - "Get a new file (overwriting the one being edited.)") + "Get a new file (overwriting the one being edited.)") (TEDIT.GET TEXTOBJ NIL (TEXTPROP TEXTOBJ 'CLEARGET))) (Unformatted% Get (TEDIT.GET TEXTOBJ NIL T)) - (Include (* ; - "Insert a file where the caret is") + (Include (* ; "Insert a file where the caret is") (TEDIT.INCLUDE TEXTOBJ)) (Quit (* ; "Stop this session.") (\TEDIT.QUIT W)) (Substitute (* ; "Search-and-replace") (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.SUBSTITUTE (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ)))) + (TEDIT.SUBSTITUTE (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))) (Find (* ; - "Case sensitive search, with * and # wildcards") + "Case sensitive search, with * and # wildcards") [SETQ OFILE (TEDIT.GETINPUT TEXTOBJ "Text to find: " (WINDOWPROP W 'TEDIT.LAST.FIND.STRING) (CHARCODE (EOL LF ESC] @@ -2696,20 +2574,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (COND (CH (* ; "We found the target text.") (TEDIT.PROMPTPRINT TEXTOBJ "Done.") - (replace (SELECTION CH#) of SEL - with (CAR CH)) + (replace (SELECTION CH#) of SEL with (CAR CH)) (* ; - "Set up SELECTION to be the found text") + "Set up SELECTION to be the found text") (replace (SELECTION CHLIM) of SEL with (ADD1 (CADR CH))) [replace (SELECTION DCH) of SEL with (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] + (CAR CH] (replace (SELECTION POINT) of SEL with 'RIGHT) (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ - with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL - )) + with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "And never pending a deletion.") (\FIXSEL SEL TEXTOBJ) @@ -2722,24 +2598,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\SHOWSEL SEL NIL T] (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Doing a FIND invalidates the insertion-piece cahce? I don't understand this. Check it.") + "Doing a FIND invalidates the insertion-piece cahce? I don't understand this. Check it.") ) (Looks (* ; - "He wants to set the font for the current selection") + "He wants to set the font for the current selection") (\TEDIT.LOOKS TEXTOBJ)) (Hardcopy (* ; "Print this document") (TEDIT.HARDCOPY TEXTOBJ)) (Press% File (* ; - "Make a hardcopy file with this document in it.") + "Make a hardcopy file with this document in it.") (TEDIT.HCPYFILE TEXTOBJ)) (Expanded% Menu (* ; - "Open the expanded operations menu.") + "Open the expanded operations menu.") (\TEDIT.EXPANDED.MENU TEXTOBJ)) (Character% Looks (* ; - "Open the menu for setting character looks") + "Open the menu for setting character looks") (\TEDIT.EXPANDEDCHARLOOKS.MENU TEXTOBJ)) (Paragraph% Formatting (* ; - "Open the paragraph formatting menu") + "Open the paragraph formatting menu") (\TEDIT.EXPANDEDPARA.MENU TEXTOBJ)) (Page% Layout (* ; "Open the page-layout menu") (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) @@ -2747,12 +2623,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat "Page Layout Menu" 150)) (COND ((CAR ITEM) (* ; - "This is a user-supplied entry. Get the function, and apply it to the TEXTSTREAM for him") + "This is a user-supplied entry. Get the function, and apply it to the TEXTSTREAM for him") (APPLY* (CAR ITEM) (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])]) (TEDIT.REMOVE.MENUITEM - [LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06") + [LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06") (PROG (ITEMLIST) [COND ((OR (LITATOM ITEM) @@ -2772,8 +2648,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\TEDIT.CREATEMENU [LAMBDA (ITEMS) (* ; "Edited 16-Oct-87 14:21 by jds") - - (* ;; "Create a TEdit command menu, given a list of menu items.") + + (* ;; "Create a TEdit command menu, given a list of menu items.") (create MENU ITEMS _ ITEMS @@ -2783,7 +2659,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat WHENSELECTEDFN _ '\TEDIT.MENU.WHENSELECTEDFN]) (\TEDIT.MENU.WHENHELDFN - [LAMBDA (ITEM MENU BUTTON) (* jds "10-Apr-84 15:14") + [LAMBDA (ITEM MENU BUTTON) (* jds "10-Apr-84 15:14") (COND ((ATOM ITEM) (CLRPROMPT) @@ -2800,8 +2676,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (\TEDIT.MENU.WHENSELECTEDFN [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 16-Oct-87 14:21 by jds") - - (* ;; "A Selection fn for preserving the button pressed, for special handling in PUT, e.g.") + + (* ;; "A Selection fn for preserving the button pressed, for special handling in PUT, e.g.") (CONS (DEFAULTWHENSELECTEDFN ITEM MENU BUTTON) BUTTON]) @@ -2849,28 +2725,26 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION NIL)) )) -(PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 -1989 1990 1991 1993 1994 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7222 95656 (TEDIT.CREATEW 7232 . 9986) (\TEDIT.CREATEW.FROM.REGION 9988 . 10972) ( -TEDIT.CURSORMOVEDFN 10974 . 22360) (TEDIT.CURSOROUTFN 22362 . 22897) (TEDIT.WINDOW.SETUP 22899 . 24708 -) (TEDIT.MINIMAL.WINDOW.SETUP 24710 . 32499) (\TEDIT.ACTIVE.WINDOWP 32501 . 33482) ( -\TEDIT.BUTTONEVENTFN 33484 . 58474) (\TEDIT.WINDOW.OPS 58476 . 62437) (\TEDIT.EXPANDFN 62439 . 62842) -(\TEDIT.MAINW 62844 . 64133) (\TEDIT.PRIMARYW 64135 . 65347) (\TEDIT.COPYINSERTFN 65349 . 66320) ( -\TEDIT.NEWREGIONFN 66322 . 68789) (\TEDIT.SET.WINDOW.EXTENT 68791 . 74893) (\TEDIT.SHRINK.ICONCREATE -74895 . 77167) (\TEDIT.SHRINKFN 77169 . 77744) (\TEDIT.SPLITW 77746 . 83847) (\TEDIT.UNSPLITW 83849 . -89543) (\TEDIT.WINDOW.SETUP 89545 . 95265) (\SAFE.FIRST 95267 . 95654)) (96986 97893 (TEDITWINDOWP -96996 . 97891)) (97930 100503 (TEDIT.GETINPUT 97940 . 100000) (\TEDIT.MAKEFILENAME 100002 . 100501)) ( -100552 107003 (TEDIT.PROMPTPRINT 100562 . 103466) (TEDIT.PROMPTFLASH 103468 . 105423) ( -\TEDIT.PROMPT.PAGEFULLFN 105425 . 107001)) (107238 111231 (TEXTSTREAM.TITLE 107248 . 107869) ( -\TEDIT.ORIGINAL.WINDOW.TITLE 107871 . 109847) (\TEDIT.WINDOW.TITLE 109849 . 110519) ( -\TEXTSTREAM.FILENAME 110521 . 111229)) (111274 153879 (TEDIT.DEACTIVATE.WINDOW 111284 . 118591) ( -\TEDIT.REPAINTFN 118593 . 121450) (\TEDIT.RESHAPEFN 121452 . 127072) (\TEDIT.SCROLLFN 127074 . 153877) -) (153921 155970 (\TEDIT.PROCIDLEFN 153931 . 155280) (\TEDIT.PROCENTRYFN 155282 . 155575) ( -\TEDIT.PROCEXITFN 155577 . 155968)) (156049 167049 (\EDIT.DOWNCARET 156059 . 156740) (\EDIT.FLIPCARET -156742 . 158277) (TEDIT.FLASHCARET 158279 . 159393) (\EDIT.UPCARET 159395 . 159848) ( -TEDIT.NORMALIZECARET 159850 . 165801) (\SETCARET 165803 . 166723) (\TEDIT.CARET 166725 . 167047)) ( -167083 180838 (TEDIT.ADD.MENUITEM 167093 . 169008) (TEDIT.DEFAULT.MENUFN 169010 . 178277) ( -TEDIT.REMOVE.MENUITEM 178279 . 179280) (\TEDIT.CREATEMENU 179282 . 179735) (\TEDIT.MENU.WHENHELDFN -179737 . 180507) (\TEDIT.MENU.WHENSELECTEDFN 180509 . 180836))))) + (FILEMAP (NIL (7116 90052 (TEDIT.CREATEW 7126 . 9899) (\TEDIT.CREATEW.FROM.REGION 9901 . 10881) ( +TEDIT.CURSORMOVEDFN 10883 . 20782) (TEDIT.CURSOROUTFN 20784 . 21327) (TEDIT.WINDOW.SETUP 21329 . 23154 +) (TEDIT.MINIMAL.WINDOW.SETUP 23156 . 30934) (\TEDIT.ACTIVE.WINDOWP 30936 . 31929) ( +\TEDIT.BUTTONEVENTFN 31931 . 55639) (\TEDIT.WINDOW.OPS 55641 . 58853) (\TEDIT.EXPANDFN 58855 . 59418) +(\TEDIT.MAINW 59420 . 60717) (\TEDIT.PRIMARYW 60719 . 61880) (\TEDIT.COPYINSERTFN 61882 . 62678) ( +\TEDIT.NEWREGIONFN 62680 . 65196) (\TEDIT.SET.WINDOW.EXTENT 65198 . 70741) (\TEDIT.SHRINK.ICONCREATE +70743 . 72944) (\TEDIT.SHRINKFN 72946 . 73505) (\TEDIT.SPLITW 73507 . 78972) (\TEDIT.UNSPLITW 78974 . +83830) (\TEDIT.WINDOW.SETUP 83832 . 89655) (\SAFE.FIRST 89657 . 90050)) (91382 92293 (TEDITWINDOWP +91392 . 92291)) (92330 95120 (TEDIT.GETINPUT 92340 . 94400) (\TEDIT.MAKEFILENAME 94402 . 95118)) ( +95169 101597 (TEDIT.PROMPTPRINT 95179 . 98114) (TEDIT.PROMPTFLASH 98116 . 100025) ( +\TEDIT.PROMPT.PAGEFULLFN 100027 . 101595)) (101832 105804 (TEXTSTREAM.TITLE 101842 . 102467) ( +\TEDIT.ORIGINAL.WINDOW.TITLE 102469 . 104391) (\TEDIT.WINDOW.TITLE 104393 . 105047) ( +\TEXTSTREAM.FILENAME 105049 . 105802)) (105847 147324 (TEDIT.DEACTIVATE.WINDOW 105857 . 112821) ( +\TEDIT.REPAINTFN 112823 . 115671) (\TEDIT.RESHAPEFN 115673 . 120517) (\TEDIT.SCROLLFN 120519 . 147322) +) (147366 149497 (\TEDIT.PROCIDLEFN 147376 . 148671) (\TEDIT.PROCENTRYFN 148673 . 149118) ( +\TEDIT.PROCEXITFN 149120 . 149495)) (149576 160542 (\EDIT.DOWNCARET 149586 . 150255) (\EDIT.FLIPCARET +150257 . 151776) (TEDIT.FLASHCARET 151778 . 153059) (\EDIT.UPCARET 153061 . 153486) ( +TEDIT.NORMALIZECARET 153488 . 159185) (\SETCARET 159187 . 160115) (\TEDIT.CARET 160117 . 160540)) ( +160576 174370 (TEDIT.ADD.MENUITEM 160586 . 162877) (TEDIT.DEFAULT.MENUFN 162879 . 171849) ( +TEDIT.REMOVE.MENUITEM 171851 . 172848) (\TEDIT.CREATEMENU 172850 . 173287) (\TEDIT.MENU.WHENHELDFN +173289 . 174055) (\TEDIT.MENU.WHENSELECTEDFN 174057 . 174368))))) STOP diff --git a/library/TEDITWINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM similarity index 98% rename from library/TEDITWINDOW.LCOM rename to library/tedit/TEDIT-WINDOW.LCOM index 330f8b23b9e369d3636814d6b63759370bfa7bd9..4ce1b6a0dcb562391981e72e2d25d79d35d3e652 100644 GIT binary patch delta 551 zcmaE{i~0Ue<_Qr(Cc0jwIl4v$Mn(#TW>%)=Rwfg(r0PqHQ;Ul2vJ(q(67%eG@{<#D z>~d36a#Aae^-S%`^NX@G^U`%8B6c~MNkxf8m3AemDVZg9A+9c-A-dt7elGsude(-T z3S3Ht$aWZ88CqHym@6qH6{RNU=N4qCTlk_fa1tD%NQN}606Zk|4_&Oxq@KzAsh+6?rasg>R z!S3wu8w?DIpa93fKm|yAOzz(*!KgcV`Bn!RE=^4Za3}>UX!!U$x&T!NXhM~3X4*EB Rhf#O)>_ZMxEPkFoTmTyxs7U|- delta 687 zcmbV~ze?;t7{&40g^PuiX!9{}B`Ff}XX9?71VjF4G$t{Vy(-vb-GHmvWXW0>MD_(N z6f3dz2^Ix!d0*tV_c5F?ji?~l{Fq_R9L{%U{yoqB|1*2NKi}cqtjEiuEQ8e2)s`;a zoGebd_R^kY|0!&PUbwmkx)ow*_p)q3^o^3<{Vax9j`x)Q*jMI6Jrp6^((V-iC^(#OeUlHkI|+m~x!%s2UBK#)3ZQEY>5ZJNP`gZU%`)(tQ) z?}p((k7DPy7j`jklU#sgiQh_#rf^x&N$1MShgj;jdY?)^%;`e&3|6>q{KRkg%jG46GlTHjzeLqnXY;-Tj>2|6O04uu(UO;xNL^N#hDu7#+mk z#%2O6+A5C=z;!Rp$EP(c!+utk=U|o9sI1bnL0KS>w2ng2qEIPTDB2VqUE)yF~J0+90UN%-OT3TyqD+nUGb0LZn zP`7S;0P`BYgZK!(fzx*44M9Yh#T@28=ltI}^Yj>b2qIV2NjZg<4q8Y_C<@3~RZggK z=DO*gl=RtzI*FkO*9 zX}Zo_MtS5Avdo;v0{K!OOCrmDPs-cWBkn5K4JO8~Ri+_T4vzeLe=;>#Bl0ZW)hdLm z@%r6Qsqh9_^43@Y delta 668 zcmbV~K}*9h7>3!jE|yDGWbL4GdHAt*%!wCpaNY;1-wH#pC^HO01-+BY)84YZicF|#O3@EO;-&

m|WQTXos^JGSLp@-erd_ETH<71~5YP@#ChVj4QDNJ6QrxDpT6dGFBf+()BO-B2 zR Date: Thu, 14 Jul 2022 18:48:54 -0700 Subject: [PATCH 2/4] PSEUDOHOSTS: Error if file won't open --- lispusers/PSEUDOHOSTS | 41 ++++++++++++++++++++----------------- lispusers/PSEUDOHOSTS.LCOM | Bin 8676 -> 8720 bytes 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS index 05dc0f81..17392f02 100644 --- a/lispusers/PSEUDOHOSTS +++ b/lispusers/PSEUDOHOSTS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Jun-2022 17:24:45"  -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;149 27524 +(FILECREATED "14-Jul-2022 17:54:43"  +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;150 27644 - :CHANGES-TO (VARS PSEUDOHOSTSCOMS) + :CHANGES-TO (FNS OPENFILE.PH) - :PREVIOUS-DATE "25-Jun-2022 17:07:38" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;148) + :PREVIOUS-DATE "25-Jun-2022 17:24:45" +{DSK}kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;149) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -314,6 +314,8 @@ (OPENFILE.PH [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) + (* ;; "Edited 14-Jul-2022 17:53 by rmk") + (* ;; "Edited 25-Jun-2022 17:06 by rmk: If the stream was opened through the pseudohost, then it should only be registered on the pseudohost. We assume that it is safe to remove it from the target hosts list. The goal is that OPENP should only see it once, as being open on the pseudohost.") (* ;; "Edited 25-Jan-2022 08:45 by rmk") @@ -323,11 +325,12 @@ (LET ((TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF FDEV)) (STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) FDEV))) - (CL:WHEN STREAM - (FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM) - (CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM) - (CONTRACT.PH DATUM FDEV)) - (REPLACE (STREAM DEVICE) OF STREAM WITH FDEV)) + (IF STREAM + THEN (FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM) + (CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM) + (CONTRACT.PH DATUM FDEV)) + (REPLACE (STREAM DEVICE) OF STREAM WITH FDEV) + ELSE (ERROR "File not found: " FILE)) STREAM]) (GETFILENAME.PH @@ -521,13 +524,13 @@ (LOAD 'EXPORTS.ALL)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1355 9387 (PSEUDOHOST 1365 . 6924) (PSEUDOHOSTP 6926 . 7439) (PSEUDOHOSTS 7441 . 7798) -(TARGETHOST 7800 . 8074) (TRUEFILENAME 8076 . 8763) (PSEUDOFILENAME 8765 . 9385)) (9415 16954 ( -EXPAND.PH 9425 . 10678) (CONTRACT.PH 10680 . 13345) (SLASHIT 13347 . 14915) (UNSLASHIT 14917 . 16663) -(GETHOSTINFO.PH 16665 . 16952)) (16955 24859 (OPENFILE.PH 16965 . 17938) (GETFILENAME.PH 17940 . 18229 -) (DIRECTORYNAMEP.PH 18231 . 18855) (CLOSEFILE.PH 18857 . 19324) (REOPENFILE.PH 19326 . 19891) ( -DELETEFILE.PH 19893 . 20177) (OPENP.PH 20179 . 20474) (UNREGISTERFILE.PH 20476 . 21018) ( -REGISTERFILE.PH 21020 . 21554) (GENERATEFILES.PH 21556 . 22596) (GETFILEINFO.PH 22598 . 22900) ( -SETFILEINFO.PH 22902 . 23101) (NEXTFILEFN.PH 23103 . 23645) (FILEINFOFN.PH 23647 . 23918) ( -RENAMEFILE.PH 23920 . 24857))))) + (FILEMAP (NIL (1350 9382 (PSEUDOHOST 1360 . 6919) (PSEUDOHOSTP 6921 . 7434) (PSEUDOHOSTS 7436 . 7793) +(TARGETHOST 7795 . 8069) (TRUEFILENAME 8071 . 8758) (PSEUDOFILENAME 8760 . 9380)) (9410 16949 ( +EXPAND.PH 9420 . 10673) (CONTRACT.PH 10675 . 13340) (SLASHIT 13342 . 14910) (UNSLASHIT 14912 . 16658) +(GETHOSTINFO.PH 16660 . 16947)) (16950 24979 (OPENFILE.PH 16960 . 18058) (GETFILENAME.PH 18060 . 18349 +) (DIRECTORYNAMEP.PH 18351 . 18975) (CLOSEFILE.PH 18977 . 19444) (REOPENFILE.PH 19446 . 20011) ( +DELETEFILE.PH 20013 . 20297) (OPENP.PH 20299 . 20594) (UNREGISTERFILE.PH 20596 . 21138) ( +REGISTERFILE.PH 21140 . 21674) (GENERATEFILES.PH 21676 . 22716) (GETFILEINFO.PH 22718 . 23020) ( +SETFILEINFO.PH 23022 . 23221) (NEXTFILEFN.PH 23223 . 23765) (FILEINFOFN.PH 23767 . 24038) ( +RENAMEFILE.PH 24040 . 24977))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 84c36a9f2107bd03c0b2d87c6704fed2b77d39c8..d2d8d933dff60bfc487e4cae355e11c251f222ba 100644 GIT binary patch delta 309 zcmaFjJi%o`xQL;Nu2*S}u91O}k%FPQm8pr9iOIz5SV>a@O$8-1NkaoG6N`xt#nb!) zT>acUeO&bdJQOnX6qMXTeS8#<73=BgDJi5RmZYX&GsM(HNs~(hWPo#!t7C|(3x*<) zGmIxz`WWWnV2Y8IeR$zxw{7IhWIOJxcLPua3MKDQ^6`A$TiH^2B*U_~gfoViR+tB~2_f6_kujbiGRRbd3y*j1&ybtW1rqOid>~6!*!?FUiQv zOIOIuQ&4gX_3=?aR;Z_^r=*aQSdyB8X@H59fq{}Hmxi0CkE?T#t7C|(%jAcQshSE# z=B7p_3Rcb@j(+a0!MY*-3L0UKLBR@K0l}`JF8&_=!6CuU{=UJJFET2!8kk!dTTG5) w^kp)!*zCp>D##3U;pBP3@r-$s{|Q?&ZkcQ)V$9+tz@Ra?T_kNYizp8-0LxlD0RR91 From 8c75696e651a339a844ec35c607a20831932fc8e Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 14 Jul 2022 18:49:58 -0700 Subject: [PATCH 3/4] LOADUP-*, MEDLEYDIR, UNICODE Adjustment for TEDIT-xxx, plus moving UNICODE to the beginning of LOADUP-LISP, with UNICODEDIRECTORIES creating in MEDLEYDIR --- library/UNICODE | 41 +++++++++++++++++---------------------- library/UNICODE.LCOM | Bin 22170 -> 21982 bytes sources/LOADUP-FULL | 16 +++++++++------ sources/LOADUP-FULL.LCOM | Bin 3856 -> 3927 bytes sources/LOADUP-LISP | 16 +++++++++------ sources/LOADUP-LISP.LCOM | Bin 3484 -> 3594 bytes sources/MEDLEYDIR | 26 +++++++++++++++++++------ sources/MEDLEYDIR.LCOM | Bin 4225 -> 4513 bytes 8 files changed, 58 insertions(+), 41 deletions(-) diff --git a/library/UNICODE b/library/UNICODE index b49f8414..0c64c4a6 100644 --- a/library/UNICODE +++ b/library/UNICODE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Jun-2022 00:02:58"  -{DSK}kaplan>Local>medley3.5>working-medley>library>UNICODE.;195 64708 +(FILECREATED "13-Jul-2022 11:38:18"  +{DSK}kaplan>local>medley3.5>working-medley>library>UNICODE.;196 64439 - :CHANGES-TO (FNS NUTF8CODEBYTES) + :CHANGES-TO (VARS UNICODECOMS) - :PREVIOUS-DATE "30-Sep-2021 16:03:18" -{DSK}kaplan>Local>medley3.5>working-medley>library>UNICODE.;194) + :PREVIOUS-DATE "28-Jun-2022 00:02:58" +{DSK}kaplan>local>medley3.5>working-medley>library>UNICODE.;195) (PRETTYCOMPRINT UNICODECOMS) @@ -25,7 +25,7 @@ (FNS XCCS-UTF8-AFTER-OPEN) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE)) (FNS XTOUCODE UTOXCODE)) - [COMS + (COMS (* ;; "Unicode mapping files") (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING @@ -40,9 +40,7 @@ (UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16] (VARS UNICODE-MAPPING-HEADER) - (INITVARS (UNICODEDIRECTORIES NIL)) - (P (PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR") - '/unicode/xerox/] + (INITVARS (UNICODEDIRECTORIES NIL))) (COMS (* ;; "Set up translation tables for UTF8 and UTFBE external formats") @@ -832,9 +830,6 @@ (RPAQ? UNICODEDIRECTORIES NIL) -(PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR") - '/unicode/xerox/)) - (* ;; "Set up translation tables for UTF8 and UTFBE external formats") @@ -1207,15 +1202,15 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4094 17774 (UTF8.OUTCHARFN 4104 . 6935) (UTF8.INCCODEFN 6937 . 12427) (UTF8.PEEKCCODEFN - 12429 . 17203) (\UTF8.BACKCCODEFN 17205 . 17772)) (17775 21101 (UTF16BE.OUTCHARFN 17785 . 18609) ( -UTF16BE.INCCODEFN 18611 . 19510) (UTF16BE.PEEKCCODEFN 19512 . 20583) (\UTF16.BACKCCODEFN 20585 . 21099 -)) (21131 22939 (MAKE-UNICODE-FORMATS 21141 . 22937)) (23036 24342 (UNICODE.UNMAPPED 23046 . 24340)) ( -24343 24879 (XCCS-UTF8-AFTER-OPEN 24353 . 24877)) (25712 26061 (XTOUCODE 25722 . 25890) (UTOXCODE -25892 . 26059)) (26101 42223 (READ-UNICODE-MAPPING-FILENAMES 26111 . 27212) (READ-UNICODE-MAPPING -27214 . 30512) (WRITE-UNICODE-MAPPING 30514 . 34731) (WRITE-UNICODE-INCLUDED 34733 . 39455) ( -WRITE-UNICODE-MAPPING-HEADER 39457 . 40689) (WRITE-UNICODE-MAPPING-FILENAME 40691 . 42221)) (45556 -54035 (MAKE-UNICODE-TRANSLATION-TABLES 45566 . 54033)) (54452 62478 (HEXSTRING 54462 . 55623) ( -UTF8HEXSTRING 55625 . 57830) (NUTF8CODEBYTES 57832 . 58617) (NUTF8STRINGBYTES 58619 . 59100) ( -XTOUSTRING 59102 . 62113) (XCCSSTRING 62115 . 62476)) (62479 63948 (SHOWCHARS 62489 . 63946))))) + (FILEMAP (NIL (3945 17625 (UTF8.OUTCHARFN 3955 . 6786) (UTF8.INCCODEFN 6788 . 12278) (UTF8.PEEKCCODEFN + 12280 . 17054) (\UTF8.BACKCCODEFN 17056 . 17623)) (17626 20952 (UTF16BE.OUTCHARFN 17636 . 18460) ( +UTF16BE.INCCODEFN 18462 . 19361) (UTF16BE.PEEKCCODEFN 19363 . 20434) (\UTF16.BACKCCODEFN 20436 . 20950 +)) (20982 22790 (MAKE-UNICODE-FORMATS 20992 . 22788)) (22887 24193 (UNICODE.UNMAPPED 22897 . 24191)) ( +24194 24730 (XCCS-UTF8-AFTER-OPEN 24204 . 24728)) (25563 25912 (XTOUCODE 25573 . 25741) (UTOXCODE +25743 . 25910)) (25952 42074 (READ-UNICODE-MAPPING-FILENAMES 25962 . 27063) (READ-UNICODE-MAPPING +27065 . 30363) (WRITE-UNICODE-MAPPING 30365 . 34582) (WRITE-UNICODE-INCLUDED 34584 . 39306) ( +WRITE-UNICODE-MAPPING-HEADER 39308 . 40540) (WRITE-UNICODE-MAPPING-FILENAME 40542 . 42072)) (45287 +53766 (MAKE-UNICODE-TRANSLATION-TABLES 45297 . 53764)) (54183 62209 (HEXSTRING 54193 . 55354) ( +UTF8HEXSTRING 55356 . 57561) (NUTF8CODEBYTES 57563 . 58348) (NUTF8STRINGBYTES 58350 . 58831) ( +XTOUSTRING 58833 . 61844) (XCCSSTRING 61846 . 62207)) (62210 63679 (SHOWCHARS 62220 . 63677))))) STOP diff --git a/library/UNICODE.LCOM b/library/UNICODE.LCOM index 984aecf4752e70efd37e95943813aa46479a92b3..98b4235c393e054d7974ccbc6abeb2aa6419c316 100644 GIT binary patch delta 332 zcmbQWmhs+d#tGrVhQ_*Hr8&Ar21Z5-hK5$g7FLE6v!wV+i&Kk=?XnXKauW0Gawc;y z8P=O=Dk!0-Hn1|W0BTTD;7Te=P0r6P$jnJiQAn*QC@NO9Qpn3M$;ix0SIEp$P;v|P z@lin5tEZ=@q>z$W0#uL1OcN6&O)d>LPajw3AXmo_R~L{XO$>K}Y_4_*_O7+Tbgh}0 zf|-elv895QvxlRfyKAs+h`)kHm}5||0#~S?r?bC{tFymvu%?1lK#*&gr+;X$t_#qn q$*zp@Sp3dty4i|pyUS)@_b?0|_LCQQh);g%Za4W;=n4Qxl3ybL delta 513 zcmcb&nsL@z#tGrVMi#nWrFptW21Z5-1_o9JMpmX1v!wV!i&Kk=?XnXKauW0Gd?x>A zG_F@rGBQV~H8QX=F|{%@R#M`0Mo6#0Znp_%go<6S5L9UJ=u6iy&RhW*o06L)B zCD^;x2E)llY6@m1<^~oDR?Z%de(tWpx*`4w8g72U3S218n|zQ_Slie@H#oHb6b^<8 zhGtd<##V-Sj5cI6*=)$P-6cvvBLIj(gFXCQ!xcjPJV9P|@eFcx4)G821bSQ}z|q-T zOF@GRC>NpY?i%9i7p9=(>+0g;8VOXVq^Y1080sJ5s-Rz*mzkWOlB!>kT9jX*uc^8D SncFws5F(5w-Q=4gtc(Cij*%h& diff --git a/sources/LOADUP-FULL b/sources/LOADUP-FULL index bb51c718..5e17a384 100644 --- a/sources/LOADUP-FULL +++ b/sources/LOADUP-FULL @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Mar-2022 21:08:31" {DSK}larry>medley>sources>LOADUP-FULL.;2 4390 +(FILECREATED "14-Jul-2022 12:33:11"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>LOADUP-FULL.;6 4656 :CHANGES-TO (FNS LOADUP-FULL) - :PREVIOUS-DATE " 4-Mar-2022 19:17:17" {DSK}larry>medley>sources>LOADUP-FULL.;1) + :PREVIOUS-DATE "12-Jul-2022 21:57:39" +{DSK}kaplan>Local>medley3.5>working-medley>sources>LOADUP-FULL.;5) (PRETTYCOMPRINT LOADUP-FULLCOMS) @@ -45,7 +47,9 @@ (PRINTOUT T "FULL fonts loaded" T]) (LOADUP-FULL - [LAMBDA NIL (* ; "Edited 7-Mar-2022 21:06 by larry") + [LAMBDA NIL (* ; "Edited 14-Jul-2022 12:32 by rmk") + (* ; "Edited 12-Jul-2022 21:57 by rmk") + (* ; "Edited 7-Mar-2022 21:06 by larry") (* ; "Edited 2-Mar-2022 13:58 by larry") (* ; "Edited 15-Jan-2022 15:48 ") (* ; "Edited 29-Apr-2021 22:27 by rmk:") @@ -72,8 +76,8 @@ (LOADFULLFONTS) (LISTPUT IDLE.PROFILE 'TIMEOUT 0) (SETQQ *DEFAULT-CLEANUP-COMPILER* BCOMPL) - (LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDITCHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES - GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT UNICODE + (LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER + THINFILES GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT ISO8859IO HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT)) (COND @@ -91,5 +95,5 @@ (FIXMETA) (DECLARE%: DONTCOPY - (FILEMAP (NIL (639 4352 (LOADFULLFONTS 649 . 2090) (LOADUP-FULL 2092 . 4102) (FIXMETA 4104 . 4350))))) + (FILEMAP (NIL (693 4618 (LOADFULLFONTS 703 . 2144) (LOADUP-FULL 2146 . 4368) (FIXMETA 4370 . 4616))))) STOP diff --git a/sources/LOADUP-FULL.LCOM b/sources/LOADUP-FULL.LCOM index f067d4f9d953c42525d220c2e3da5c199ade5e3a..afd70265c4eaeed8d37ec33f5c170f94b909e908 100644 GIT binary patch delta 410 zcmbOrcU^8mc#xrqu2*S}u91O}k%FO-m9epvp^=h;hEj5VZb4>FYKlUBo`RABSG7y9 zcdbomacWVqU3OwYPGX*&PkwS@j$LkQN=|B}v7V`2d45rLW?s7P#6FpNGff306q60D zOpL5d4S*&k6{W(>POT^?Dps{p@bPza2@TM73-$3)$OPI4W+3a=)6-K@NJ%UKx(A!N zCQ6!I8g8CGuFgTOjv=ltE@-MC{xT%lAChJYCT6B)3Rcb@j(+a0!MY*-3L0*H!3tcH qyBKAi42=+BXJlw)YHnq0NwOV`rkh_g-sNP}oqU43VzUR&2_^snU3fqM delta 319 zcmcaEH$iSfxVeJ4u5V(Iu91O}k%Ez-m4Stov6+&BhEj5VZb4>FYKlUBo`RA>wM(#f ztxZOLZmL~QVo_10-DDXi8C@ey1ui88Q-lGAhE|3aR;ETu3Q0w&a1)X<67$kiCw`Dj zMOLe)r>CTll2`(?0;?gWN}606Zk|4_&Oxq@A+9b!S718T5QozwjTB6bEe#Z`oIM=< z++BlpL;MvqxZM1L6(;XxlvP(SL2|RDm7zHh;V_BOaI+=TUCznkJQeJrexA<$F0PyV Icuq0_02dNgRR910 diff --git a/sources/LOADUP-LISP b/sources/LOADUP-LISP index 7e590ddf..5b0285c3 100644 --- a/sources/LOADUP-LISP +++ b/sources/LOADUP-LISP @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED " 4-Mar-2022 19:17:17" |{DSK}larry>medley>sources>LOADUP-LISP.;2| 5132 +(FILECREATED "13-Jul-2022 14:10:00"  +|{DSK}kaplan>Local>medley3.5>working-medley>sources>LOADUP-LISP.;5| 5331 :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE " 2-Mar-2022 16:31:39" |{DSK}larry>medley>sources>LOADUP-LISP.;1|) + :PREVIOUS-DATE "12-Jul-2022 21:57:32" +|{DSK}kaplan>Local>medley3.5>working-medley>sources>LOADUP-LISP.;4|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -17,11 +19,13 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA NIL (* \; "Edited 4-Mar-2022 19:13 by larry") + (LAMBDA NIL (* \; "Edited 13-Jul-2022 14:09 by rmk") + (* \; "Edited 4-Mar-2022 19:13 by larry") (* \; "Edited 2-Mar-2022 16:31 by larry") (* \; "Edited 28-Feb-2022 15:02 by larry") (* \; "Edited 29-Apr-2021 22:30 by rmk:") - (SETQQ COMPILE.EXT LCOM) (* \; "should be set earlier") + (SETQQ COMPILE.EXT LCOM) + (MEDLEY-INIT-VARS) (* \; "should be set earlier") (DRIBBLE (MEDLEYDIR "tmp" "lisp.dribble" T)) (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES) (PRINTOUT T X " bootloaded" T) @@ -73,7 +77,7 @@ CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES)) (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT)) (LOADUP '(ADDARITH)) - (LOADUP '(CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW + (LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN)) (LOADUP '(BREAK-AND-TRACE)) @@ -117,5 +121,5 @@ (GLOBALVARS LISPMAKESYSDATE MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (642 4910 (LOADUP-LISP 652 . 4908))))) + (FILEMAP (NIL (696 5109 (LOADUP-LISP 706 . 5107))))) STOP diff --git a/sources/LOADUP-LISP.LCOM b/sources/LOADUP-LISP.LCOM index 6507ba95dbfbe40e4717a3ddf4529c4005c8cde5..71630d0c22b1cb4b29df8a587acb4e7d68b18ecc 100644 GIT binary patch delta 1272 zcmb7^&u`OM5XT!Mprk!?4=W^~(qQ$Fpmpl^{M^JAig>YKi#N8DwH=_xw6Rb`npA1| zC5&?7z)CAXX0;cz(*6zII|u#%_QqeZmp$%b&pYmqJm7{8eqYbbo6pSi*zd0XeC_p5 zF)_3sAC5GtQwoIHM7MQag^Id6+1nqE(g94yph7u&=Em*kH+u)^^q~2mzd!1aoBm|C zKWgr!gHig_sF}^jlj(!u_`de$<+YiaRYCnCw{EkBZ8VBpJJa+meFjDxb6cQ12BM<5(;1UwpFiwTZAP_+d4D;;NXJF`PbA7SxdJ%prrw^JJdWm+2 zM=_2b!wv%87V&l*@<0I78Q3SAfKmny5RAb6!bv)jCt|Qnz+fC%)Y#};V;^&Efzt`{ zkLSNHS^3}Re^u%%&n~RhHyBi$z>fnSB|O@St61%c>2xB{z|e5d@ilQTiFgrVu>8}7 z^($CQr4_Z^yCK@JmrCLV0;SG!xOiQ~0jsz^??P)k5eV;MeNj2KR8WNnsS=7}FJ*VRe$bY~1{=1?o?z%kklH2HKEFUkr3Rd#x;wOc${Fh6&&QT=) zb*ZUXEMF3T62Z%d2Y^{-t&% ilf%)ZKS&2EQa~LI5B6(=>2POfl&UyVM|;cbrT+m=lTT>? delta 1125 zcmZ{j&u-H|5XKucmTGC3b@C{*yS6G*MeAZK_Zq zAp$+Y0dW8sR0(nAz_|~=nJ3@?CtiRD;KI0VvPBeM_S5XQ^P8DnzncFz_vU^PG{tER z6q=(H2s4OoXhj*)@@9W`f2Y^&Kz|Qp7(TW9+Oyl+{oQV<*BT6-l)~4sc|wO7NXUPs z&<#~H)EpjZ54xiyLl|yuxAwNWZ-32gpSNeTS#)+<2i?x_;!LWXNu=-Dbzbqf8E^}W z`KMx{|F6P_bO?E(QZOpZrd#E{5;OqwxjxhzrnS;k>bBp^fYJ2$s@+)e6$>HApy#Gi zFjQiwOoqh8V~COPuC$swicL;TY)#;I_4t$YE_SGa<=N$Oor79rXFO1K22Hb4Gpk(T zu6eSnYvbL5ka;0BAypx%kVMGbNFD-ZBMr1Dq`*;uqXI_-jtU$_oV8{JNbCF=o~IhGl#BiZra&F>Bo4@LkivTVV{0Qv)`|paKLP=;f85;n~~=mIE|Lug?c; zYOFOayfL*H)56-+d#S*}pHqu^o9SX|)?AEXzv;kscn0r}g)id^Qjvw9$f`Hj*OQNa&PC+ezr5% QX}5b_jA+N-Q@3J&095)OOaK4? diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 46d4713f..22adb5ee 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Mar-2022 19:39:13" {DSK}larry>medley>sources>MEDLEYDIR.;2 6274 +(FILECREATED "13-Jul-2022 15:34:07"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>MEDLEYDIR.;10 6722 - :CHANGES-TO (VARS MEDLEY-INIT-VARS) + :CHANGES-TO (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS) - :PREVIOUS-DATE " 5-Mar-2022 12:43:54" {DSK}larry>medley>sources>MEDLEYDIR.;1) + :PREVIOUS-DATE "13-Jul-2022 11:37:28" +{DSK}kaplan>Local>medley3.5>working-medley>sources>MEDLEYDIR.;8) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -19,6 +21,10 @@ (BEFOREMAKESYSFORMS (SETQ MEDLEYDIR)) (AFTERSYSOUTFORMS (MEDLEY-INIT-VARS)) (AFTERMAKESYSFORMS (MEDLEY-INIT-VARS))) + + (* ;; + "NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.") + (VARS MEDLEY-INIT-VARS) (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS]) @@ -106,6 +112,12 @@ (ADDTOVAR AFTERMAKESYSFORMS (MEDLEY-INIT-VARS)) + + +(* ;; +"NOTE: Do not use backquote in the variable definitions. These get evaluated early in the loadup.") + + (RPAQQ MEDLEY-INIT-VARS ([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"] [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"] @@ -115,8 +127,8 @@ (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) [LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") (UNIX-GETENV "HOME"] - [USERGREETFILES `((,LOGINHOST/DIR "INIT" COM) - (,LOGINHOST/DIR "INIT"] + [USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM)) + (CONS LOGINHOST/DIR '("INIT"] (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts" "fonts/adobe" "fonts/big" "fonts/other") NIL NIL T)) @@ -124,11 +136,13 @@ NIL NIL T)) (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") NIL NIL T)) + (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") + NIL NIL T)) (XCL::*WHERE-IS-CASH-FILES*))) (DECLARE%: EVAL@COMPILE DOCOPY (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1383 4793 (MEDLEY-INIT-VARS 1393 . 3007) (MEDLEYDIR 3009 . 4791))))) + (FILEMAP (NIL (1588 4998 (MEDLEY-INIT-VARS 1598 . 3212) (MEDLEYDIR 3214 . 4996))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index d6ca852a9de559443d29c4ad0a9c5ea8b4db6656..04fd95673c06f6678ee7cff2784e5dea0f964dbe 100644 GIT binary patch delta 741 zcmb7?U2D@&7{|#J!Axwu5galeqhg{YOPX}8nG|Z0t`w4bzkwgXPqYh9ow|u4?Ee4q{C_-$w~lUqcs|f{`AL<^4Ykn#t!e6pskQ|W zg)!NkB`J=9WFP?l#txspeKag^UUa5tmZGfVkugd;yEsnqzOFPouSq^lvK^TQ+{%Hb zN+A4^t(r#L)LAw^%JJ`XJfG#oT@x}=PM8@I*0wqHJUHuB6h(j-mF${-WEzGb@#3cI zIo81GMvl!y-M?40&cEWGrowuQfibOK*WYqNISN4B?hZoW`;P57FKl;U1$}zR-FbZW zU`;dimf2X0Jtw#eZHcGfE?)n<^y%`!ec0FlUhsp+F#&9{pafNcVT8uhR~0Gof>$}g zu!r&ljZzFTewk!RnUJhd0HO(I>K$AH-a~2igCItEy8p|U5)@Z6MUa3$*>y5Yc6~RJ z>3i-H{km*WRA1rvFW0VoTnarmj6k#kpCRyqE!Xb_VYJ3DfcR|4?qr{{@Cv}NNRsqZ z`ah*akFTzBJUy=6phm5~%!BWG5G}m)UG1nj^j#~k9aiC3Q7~|w5X4jZr?pjb%7 delta 425 zcmZ3e+^9Gq++4w2*Eg|9*T}%gNWsw3%GlD%&_YQ;Ln%2ww;(eoHANvmPeDnc+9lY# z)+QrAH`OjDv8brhZn74Wl&+Dc0+*74DUtz(K;2fRMoJ1vMX7KTk~0$X(o-kC7fnT0 ztEZ=@q>z$W0<;3FA*M>2TpDhkKCaF|u8twDE=0z>^nTop7lG-7lVxP1KGJ^eiVgG2OPJcBe9lsx@BLzEPp{e3loDu4>G%1^$| nFE`nPPY7r%hd>Cof}f|4LWm|%2iN3ufrXR(1f_s78G@DoB)o7$ From efa4ae101964f2fac5cf903fe37438eb233fc725 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 14 Jul 2022 22:09:10 -0700 Subject: [PATCH 4/4] TEDIT-FILE: Split up TEDIT.BUILD.PCTB into separate subfunctions Should be easier to update and extend. Not clear that the code for making a string piece is still needed here, since we interpret strings as file names. So this may be further simplified. I hope this also will give us a better handle on some of the file inconsistencies, by isolating the readers for formatted and unformatted files. --- library/tedit/TEDIT-FILE | 805 +++++++++++++++++----------------- library/tedit/TEDIT-FILE.LCOM | Bin 61226 -> 61810 bytes 2 files changed, 393 insertions(+), 412 deletions(-) diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE index 4fd6418a..2dd2a4b2 100644 --- a/library/tedit/TEDIT-FILE +++ b/library/tedit/TEDIT-FILE @@ -1,10 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:44"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;1 235680 +(FILECREATED "14-Jul-2022 21:52:00"  +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;2 232517 - :PREVIOUS-DATE "14-Jul-2022 13:18:18" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;2) + :CHANGES-TO (FNS TEDIT.BUILD.PCTB) + (VARS TEDIT-FILECOMS) + + :PREVIOUS-DATE "14-Jul-2022 16:55:44" +{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;1) (PRETTYCOMPRINT TEDIT-FILECOMS) @@ -19,7 +22,9 @@ (FNS TEDIT.BUILD.PCTB \TEDIT.CONVERT.FOREIGN.FORMAT TEDIT.FORMATTEDFILEP TEDIT.GET TEDIT.PARSE.PAGEFRAMES1 \ARBIN \ATMIN \DWIN \STRINGIN \TEDIT.FORMATTEDP1 - \TEDIT.SET.WINDOW TEDIT.GET.PASSWORD)) + \TEDIT.SET.WINDOW TEDIT.GET.PASSWORD) + (FNS \TEDIT.READ.FORMATTED.FILE \TEDIT.READ.OLDFORMATTED.FILE + \TEDIT.READ.UNFORMATTED.FILE \TEDIT.CACHEFILE \TEDIT.UNIQUIFY.ALL)) (COMS (* ;; "INCLUDEing a file") @@ -79,128 +84,66 @@ (DEFINEQ (TEDIT.BUILD.PCTB - [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS CLEARGET?) + [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS UNFORMATTED?) + (* ; "Edited 14-Jul-2022 10:01 by rmk") (* ; "Edited 29-Apr-2021 22:52 by rmk:") (* ; "Edited 11-Jun-99 14:37 by rmk:") (* ; "Edited 19-Apr-93 13:46 by jds") (* ;  "START = 1st char of file to read from, if specified") - (* ; - "END = use this as eofptr of file. For use in reading files within files.") - (PROG (SEL LINES PCTB PC OLDPC PCCOUNT TYPECODE PCLEN CHLOOKSSEEN NEWPC PARALOOKSSEEN - PIECEINFOCH# CACHE CACHE? TTEXTOBJ USER.CMFILE TSTREAM USERFILEFORMAT USERTEMP - EXISTINGCHARLOOKS EXLOOK EXISTINGFMTSPECS (*READTABLE* *TEDIT-FILE-READTABLE*) - (*PRINT-BASE* 10) - (CURFILECH# (OR START 0)) - (CURCH# 1) - (TEXTSTREAM (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) - LOOKSHASH PARAHASH) - [SETQ DEFAULTPARALOOKS (OR DEFAULTPARALOOKS (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (T (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ] - (* ; - "Set the default paragraph formatting for filling in piece PPARALOOKS fields") - (COND - (TEXTOBJ (* ; - "If there's a TEXTOBJ behind this, set its TXTFILE field to point to the right place.") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT))) - (SETQ DEFAULTLOOKS (OR DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (* ; + + (* ;; "Set the default paragraph formatting for filling in piece PPARALOOKS fields") + + (CL:UNLESS DEFAULTPARALOOKS + [SETQ DEFAULTPARALOOKS (COND + (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) + (T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC]) + (CL:UNLESS DEFAULTLOOKS (* ;  "Set the default CHARLOOKS, for filling in pieces' PLOOKS fields") - (SETQ TEXT (\CREATEPIECEORSTREAM TEXT DEFAULTLOOKS DEFAULTPARALOOKS START END)) + (SETQ DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (CL:WHEN TEXTOBJ (* ; "If there's a TEXTOBJ behind this, set its TXTFILE field to point to the right place, and assume no page formatting") + (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT) + (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) + (CL:UNLESS START (SETQ START 0)) (* ; + "END = use this as eofptr of file. For use in reading files within files.") + (LET (PCTB PCCOUNT CACHE (*READTABLE* *TEDIT-FILE-READTABLE*) + (*PRINT-BASE* 10)) + (SETQ TEXT (\CREATEPIECEORSTREAM TEXT DEFAULTLOOKS DEFAULTPARALOOKS START END)) (* ;  "Grab the file, or a single piece (if the text is a string, or such simple cases)") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) (* ;  "Start by assuming no page formatting") - (COND - ((STREAMP TEXT) (* ; + (CL:WHEN (STREAMP TEXT) (* ;  "OK, it wasn't a string, so check for cases where we have to cache the file locally.") - (AND TEXTOBJ (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT)) - (COND - ((OR [AND TEXTOBJ (SETQ CACHE? (TEXTPROP TEXTOBJ 'CACHE] - (NOT (RANDACCESSP TEXT))) (* ; - "If the file device isn't rancom access, cache the file locally.") + (CL:WHEN TEXTOBJ (* ; + "Didn't we just do this? Did the STREAM text change?") + (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT)) + (CL:WHEN (OR (AND TEXTOBJ (TEXTPROP TEXTOBJ 'CACHE)) + (NOT (RANDACCESSP TEXT))) (* ; + "If the file device isn't random access, cache the file locally.") (* ;  "Also do this if he asks for a local cache.") - [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; "The cache file") - (COND - ((OR START END) - (COPYBYTES TEXT CACHE (OR START 0) - (OR END -1))) - (T (COPYBYTES TEXT CACHE))) (* ; "Copy the text there") - (SETQ CACHE? T) (* ; "Remember that we cached it!") + (SETQ TEXT (\TEDIT.CACHEFILE TEXT TEXTOBJ START END)) - (* ;; "COPYBYTES can only have start/end args of NIL if the file is not random access. So it's impossible to grab out of the middle of a file on an NS server. Sorry.") + (* ;; + "Since we only copied the relevant part of the file into the cache, the whole file is now relevant.") - (COND - (CACHE? + (SETQ START 0) + (SETQ END (GETEOFPTR TEXT))) - (* ;; "for the folx who don't trust the connections, since all their pcs will point to core, we can close the txtfile connection") + (* ;; + "Check to see if this is a formatted file, and find out how many pieces we should allocate for it.") - (CLOSEF TEXT))) - (replace (STREAM EOLCONVENTION) of CACHE with (fetch (STREAM EOLCONVENTION) - of TEXT)) - (* ; - "Remember the EOL convention from the original file, so that we can do a copychars if need be.") - (SETQ TEXT CACHE) (* ; - "And pretend the cache IS the real file from here on") - (SETQ START (SETQ END NIL)) - - (* ;; "Since we only copied the relevant part of the file into the cache, we don't need to remember the limits of interest.") - - )) - (SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END)) - - (* ;; "RMK: Domestic EOL is now LF, so changed from CR") - - (COND - ((AND (NOT PCCOUNT) - (NEQ (fetch (STREAM EOLCONVENTION) of TEXT) - LF.EOLC)) - - (* ;; "This is an UNFORMATTED file, and it has a foreign EOL convention. Convert it, and save the converted copy locally.") - - [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; "Build a cache file") - (COND - ((OR START END) - (COPYCHARS TEXT CACHE (OR START 0) - (OR END -1)) - - (* ;; "mcf: just like before, we have all the relevant portion") - - (SETQ START (SETQ END NIL))) - (T (COPYCHARS TEXT CACHE))) (* ; - "Copy the text, converting from the foreign EOL convention into CR as end of line.") - (SETQ TEXT CACHE) - - (* ;; "And think of THIS as the cache. At this point, we may have cached twice in succession--no need to clip off START and END.") - - (SETQ CACHE? T) (* ; "Remember that we cached the file!") - )) (* ; - "Check to see if this is a formatted file, and find out how may pieces we should allocate for it.") - )) - (AND TEXTOBJ (TEXTPROP TEXTOBJ 'CACHE CACHE?)) (* ; - "REMEMBER THAT THIS TEXT WAS CACHED, SO THAT LATER PUTS DON'T INVALIDATE THE CACHE.") - [COND - [(type? PIECE TEXT) (* ; - "If this isn't a text stream, build a piece table with the one piece in it.") - (COND + (SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END))) + [SETQ PCTB + (COND + ((type? PIECE TEXT) (* ; + "If this isn't a stream, build a piece table with the one piece in it.") + [COND ((EQ (fetch (PIECE PLEN) of TEXT) - 0) (* ; - "I hate piece whose length is zero.") - (SETQ PCTB (\MAKEPCTB (SETQ TEXT NIL))) (* INSERT-BRT (CREATEPCNODE 1 - (QUOTE LASTPIECE)) PCTB) - ) - (T (SETQ PCTB (\MAKEPCTB TEXT)) (* INSERT-BRT (CREATEPCNODE - (ADD1 (fetch (PIECE PLEN) of TEXT)) - (QUOTE LASTPIECE)) PCTB) - (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS + 0) + (SETQ TEXT NIL)) + (T (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE PLOOKS) of TEXT) TEXTOBJ)) (* ; @@ -208,26 +151,28 @@ (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (PIECE PPARALOOKS) of TEXT) TEXTOBJ] - (CLEARGET? + (\MAKEPCTB TEXT)) + (UNFORMATTED? - (* ;; "If the user wants an uninterpreted stream onto the file , build a piece table with the one piece in it.") + (* ;; "If the user wants an uninterpreted stream onto even a formatted file , build a piece table with the one piece in it.") - (SETQ TEXT (create PIECE - PFILE _ TEXT - PFPOS _ (COND - (START START) - (T 0)) - PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - (COND - (START START) - (T 0))) - PREVPIECE _ NIL - PLOOKS _ DEFAULTLOOKS - PPARALAST _ NIL - PPARALOOKS _ DEFAULTPARALOOKS)) + (SETQ TEXT + (create PIECE + PFILE _ TEXT + PFPOS _ (COND + (START START) + (T 0)) + PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + (COND + (START START) + (T 0))) + PREVPIECE _ NIL + PLOOKS _ DEFAULTLOOKS + PPARALAST _ NIL + PPARALOOKS _ DEFAULTPARALOOKS + PEXTERNALFORMAT _ (GETSTREAMPROP TEXT :EXTERNAL-FORMAT))) (* ;  "A single piece to describe the whole file") - (SETQ PCTB (\MAKEPCTB TEXT)) (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE PLOOKS) of TEXT) TEXTOBJ)) @@ -236,276 +181,43 @@ (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (PIECE PPARALOOKS) of TEXT) TEXTOBJ)) - (* INSERT-BRT (CREATEPCNODE - (ADD1 (fetch (PIECE PLEN) of TEXT)) - (QUOTE LASTPIECE)) PCTB) - ) - [(NOT PCCOUNT) (* ; "This is an unformatted file") - (COND - [(SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS - when (SETQ USERTEMP (APPLY* (CAR FILETYPE) - TEXT)) do (RETURN FILETYPE))) - (* ; - "The input file is in a user-sensible format, which he is willing to convert for TEdit's use.") - (* ; "See if there are Bravo headers") - (SETQ PCTB (\TEDIT.CONVERT.FOREIGN.FORMAT (CADR USERFILEFORMAT) - TEXT USERTEMP TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS)) - (* ; - "Convert the foreign format file, and grab its PCTB") - (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] - do (* ; - "Run thru the converted pieces, noting their CHARLOOKS and PARALOOKS for the get/put caches.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) of PC) - TEXTOBJ)) - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) - of PC) - TEXTOBJ)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC] - (T (* ; - "Nope--it's straight unformatted text") - [SETQ PCTB (\MAKEPCTB (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - CURFILECH#) - PREVPIECE _ NIL - PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS - TEXTOBJ) - PPARALAST _ NIL - PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS - DEFAULTPARALOOKS TEXTOBJ] - (* ; - "So create a single piece to describe its contents") - (* INSERT-BRT (CREATEPCNODE - (ADD1 (IDIFFERENCE (OR END - (GETEOFPTR TEXT)) CURFILECH#)) - (QUOTE LASTPIECE)) PCTB) - (* ; "Insert LASTPIECE here") - ] - [(LISTP PCCOUNT) (* ; + (\MAKEPCTB TEXT)) + ((NOT PCCOUNT) (* ; "This is an unformatted file") + (\TEDIT.READ.UNFORMATTED.FILE TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS)) + ((LISTP PCCOUNT) (* ;  "This is an obsolete version of the TEdit file format.") - (SELECTQ (CAR PCCOUNT) - (0 (* ; "VERSION 0") - (SETQ PCTB (TEDIT.BUILD.PCTB0 TEXT TEXTOBJ (CDR PCCOUNT) - START END))) - (1 (* ; - "Version 1; obsoleted at INTERMEZZO release 2/85") - (SETQ PCTB (TEDIT.BUILD.PCTB1 TEXT TEXTOBJ (CDR PCCOUNT) - START END))) - (2 (* ; "Version 2; obsoleted 5/22/85") - (SETQ PCTB (TEDIT.BUILD.PCTB2 TEXT TEXTOBJ (CDR PCCOUNT) - START END))) - (SHOULDNT "File format version incompatible with this version of TEdit.")) - (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] - do (* ; - "Run thru the converted pieces, noting CHARLOOKS and PARALOOKS for the caches.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE - PLOOKS) - of PC) - TEXTOBJ)) - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) of PC) - TEXTOBJ)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC] + (\TEDIT.READ.OLDFORMATTED.FILE TEXT TEXTOBJ START END PCCOUNT DEFAULTLOOKS + DEFAULTPARALOOKS)) (T (* ;  "This IS a TEdit-format file, so read in all the parts.") - (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) - (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from 1 - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - [SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ - with (TEDIT.GET.PAGEFRAMES TEXT))) - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorCHARLOOKSLIST (* ; - "This is the list of CHARLOOKSs used in this document.") - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with ( - \TEDIT.GET.CHARLOOKS.LIST - TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ) - do (SETA LOOKSHASH I LOOKS)) - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARALOOKSLIST (* ; - "This is the list of PARALOOKSs used in this document.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with ( - \TEDIT.GET.PARALOOKS.LIST - TEXT TEXTOBJ)) - (* ; - "Read the list of looks used in this document.") - [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTPARALOOKSLIST) - of TEXTOBJ) - do (SETA PARAHASH I LOOKS)) - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) - (* ; - "Get the new set of looks, for use by later pieces.") - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) - (* ; - "Mark the document as containing paragraph formatting info") - (add PCN -1) - - (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (* ; "Build the new piece") - (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) - (* ; - "Read the character looks for this guy.") - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC))) - (add CURFILECH# PCLEN) (* ; - "And note the passing of characters.") - ) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC))) - (TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) (* ; - "There are new character looks for this object. Read them in.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.GET.SINGLE.CHARLOOKS - TEXT))) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC - with (OR (AND OLDPC (fetch (PIECE PLOOKS) of OLDPC)) - DEFAULTLOOKS] - (replace (PIECE PLEN) of PC with 1) - (* ; - "OBJECTs are officially one character long.") - ) - (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." T) - (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) - (\SMALLPIN TEXT] - (COND - (PC (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) - (* ; - "If we created a piece, save it in the table.") - (add CURCH# (fetch (PIECE PLEN) of PC)) - (SETQ OLDPC PC))) finally - - (* ;; "(\\editseta pctb pcn curch#)") - - (* ;; " (\\editseta pctb (add1 pcn) 'lastpiece)") - - (* ;; - "(\\editseta pctb |\\PCTBLastPieceOffset| (add1 pcn)) ") - - (* ;; "(\\editseta pctb |\\PCTBFreePieces| 0)") - (* INSERT-BRT (CREATEPCNODE CURCH# - (QUOTE LASTPIECE)) PCTB) - ] - (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEXTOBJ)) (* ; - "And make sure that the default and caret looks are reflected in that list.") - (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ)) - (AND DEFAULTLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ)) - (* ; - "And the default looks we used in this function...") - (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) - TEXTOBJ) (* ; - "And make sure the default paralooks are reflected in that list.") - [AND TEXT (bind (CHARLOOKSLIST _ (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) - (PARALOOKSLIST _ (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - for (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) by (fetch (PIECE NEXTPIECE) of PC) - while [AND PC (NOT (EQ PC 'LASTPIECE] - do (* ; + (\TEDIT.READ.FORMATTED.FILE TEXT TEXTOBJ START END PCCOUNT DEFAULTLOOKS + DEFAULTPARALOOKS] + (\TEDIT.UNIQUIFY.ALL TEXTOBJ DEFAULTLOOKS) (* ; + "Make sure the default paralooks are merged.") + (CL:WHEN TEXT + [bind (CHARLOOKSLIST _ (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) + (PARALOOKSLIST _ (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) + for (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) by (fetch (PIECE NEXTPIECE) of PC) while PC + until (EQ PC 'LASTPIECE) do (* ;  "Look at every piece, and assure that its CHARLOOKS and PARALOOKS are in the cache.") - [COND - ((FMEMB (fetch (PIECE PLOOKS) of PC) - CHARLOOKSLIST) (* ; - "This piece's CHARLOOKS are known in the cache already. Don't bother doing anything else.") - ) - (T (* ; - "Nope; add these looks to the cache") - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) - of PC) - TEXTOBJ] - (COND - ((FMEMB (fetch (PIECE PPARALOOKS) of PC) - PARALOOKSLIST) (* ; - "This piece's PARALOOKS are known in the cache already. Don't bother doing anything else.") - ) - (T (* ; - "Nope; add these looks to the cache") - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) - of PC) - TEXTOBJ] - (RETURN PCTB]) + (CL:UNLESS (FMEMB (fetch (PIECE PLOOKS) of PC) + CHARLOOKSLIST) + (* ; + "This piece's CHARLOOKS are not known in the cache already. ") + (replace (PIECE PLOOKS) of PC + with (\TEDIT.UNIQUIFY.CHARLOOKS + (fetch (PIECE PLOOKS) of PC) + TEXTOBJ))) + (CL:UNLESS (FMEMB (fetch (PIECE PPARALOOKS) of PC) + PARALOOKSLIST) + (* ; + "This piece's PARALOOKS are not known in the cache already. ") + (replace (PIECE PPARALOOKS) of PC + with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) of PC) + TEXTOBJ)))]) + PCTB]) (\TEDIT.CONVERT.FOREIGN.FORMAT [LAMBDA (CONVERSIONFN FILE PREDICATERESULT TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS) @@ -838,6 +550,273 @@ [CAR (MEMB (\SMALLPIN STREAM) '(31415 31416 31417 31418 31419])]) ) +(DEFINEQ + +(\TEDIT.READ.FORMATTED.FILE + [LAMBDA (TEXT TEXTOBJ CURFILECH# END PCCOUNT DEFAULTLOOKS DEFAULTPARALOOKS) + (* ; "Edited 14-Jul-2022 10:04 by rmk") + (* ; + "This IS a TEdit-format file, so read in all the parts.") + (LET (PCLEN PC TYPECODE PARAHASH LOOKSHASH PIECEINFOCH# (TEXTSTREAM (AND TEXTOBJ + (fetch (TEXTOBJ + STREAMHINT + ) + of TEXTOBJ))) + (PCTB (\MAKEPCTB NIL PCCOUNT))) + (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + [bind (OLDPC _ NIL) + (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from 1 + do (SETQ PC NIL) (* ; + "This loop may not really read a piece, so we have to distinguish that case.") + (SETQ PCLEN (\DWIN TEXT)) + (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") + [SELECTC TYPECODE + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with ( + TEDIT.GET.PAGEFRAMES + TEXT))) + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorCHARLOOKSLIST (* ; + "This is the list of CHARLOOKSs used in this document.") + (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with ( + \TEDIT.GET.CHARLOOKS.LIST + TEXT)) + (* ; + "Read the list of looks used in this document.") + [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) + of TEXTOBJ] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) + do (SETA LOOKSHASH I LOOKS)) + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + (add I -1)) + (\PieceDescriptorPARALOOKSLIST (* ; + "This is the list of PARALOOKSs used in this document.") + (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with ( + \TEDIT.GET.PARALOOKS.LIST + TEXT TEXTOBJ)) + (* ; + "Read the list of looks used in this document.") + [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) + do (SETA PARAHASH I LOOKS)) + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + (add I -1)) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) + (* ; + "Mark the end of the preceding paragraph.") + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) + (* ; + "Get the new set of looks, for use by later pieces.") + (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) + (* ; + "Mark the document as containing paragraph formatting info") + (add PCN -1) + + (* ;; "(|add| pcn (iminus |\\EltsPerPiece|))") + (* ; + "This didn't create a piece -- don't count it in the PCTB placement.") + ) + (\PieceDescriptorLOOKS (* ; + "New character looks. Build a piece to describe those characters.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) (* ; "Build the new piece") + (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) + (* ; + "Read the character looks for this guy.") + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (add CURFILECH# PCLEN) (* ; + "And note the passing of characters.") + ) + (\PieceDescriptorOBJECT (* ; + "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") + (SETQ PC + (create PIECE + PFILE _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ OLDPARALOOKS)) + (COND + (OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (replace (PIECE NEXTPIECE) of OLDPC with PC))) + (TEDIT.GET.OBJECT TEXTSTREAM PC TEXT CURFILECH#) + (add CURFILECH# (fetch (PIECE PLEN) of PC)) + [COND + ((NOT (ZEROP (\BIN TEXT))) (* ; + "There are new character looks for this object. Read them in.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.GET.SINGLE.CHARLOOKS TEXT))) + (T (* ; + "No new looks; steal them from the prior piece.") + (replace (PIECE PLOOKS) of PC with (OR (AND OLDPC (fetch (PIECE PLOOKS) + of OLDPC)) + DEFAULTLOOKS] + (replace (PIECE PLEN) of PC with 1) (* ; + "OBJECTs are officially one character long.") + ) + (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." T) + (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) + (\SMALLPIN TEXT] + (COND + (PC (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) (* ; + "If we created a piece, save it in the table.") + (SETQ OLDPC PC] + PCTB]) + +(\TEDIT.READ.OLDFORMATTED.FILE + [LAMBDA (TEXT TEXTOBJ START END PCCOUNT DEFAULTLOOKS DEFAULTPARALOOKS) + (* ; "Edited 13-Jul-2022 23:55 by rmk") + (LET (PCTB) + (SELECTQ (CAR PCCOUNT) + (0 (* ; "VERSION 0") + (SETQ PCTB (TEDIT.BUILD.PCTB0 TEXT TEXTOBJ (CDR PCCOUNT) + START END))) + (1 (* ; + "Version 1; obsoleted at INTERMEZZO release 2/85") + (SETQ PCTB (TEDIT.BUILD.PCTB1 TEXT TEXTOBJ (CDR PCCOUNT) + START END))) + (2 (* ; "Version 2; obsoleted 5/22/85") + (SETQ PCTB (TEDIT.BUILD.PCTB2 TEXT TEXTOBJ (CDR PCCOUNT) + START END))) + (SHOULDNT "File format version incompatible with this version of TEdit.")) + (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) while PC until (EQ PC 'LASTPIECE) + do (* ; + "Run thru the converted pieces, noting CHARLOOKS and PARALOOKS for the caches.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE PLOOKS) + of PC) + TEXTOBJ)) + (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (PIECE + PPARALOOKS + ) + of PC) + TEXTOBJ)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) + PCTB]) + +(\TEDIT.READ.UNFORMATTED.FILE + [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS) + (* ; "Edited 13-Jul-2022 23:49 by rmk") + (LET (USERFILEFORMAT USERTEMP PCTB) + (COND + [(SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS + when (SETQ USERTEMP (APPLY* (CAR FILETYPE) + TEXT)) do (RETURN FILETYPE))) + (* ; + "The input file is in a user-sensible format, which he is willing to convert for TEdit's use.") + (* ; "See if there are Bravo headers") + (SETQ PCTB (\TEDIT.CONVERT.FOREIGN.FORMAT (CADR USERFILEFORMAT) + TEXT USERTEMP TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS)) + (* ; + "Convert the foreign format file, and grab its PCTB") + (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) + 0)) while [AND PC (NOT (EQ PC 'LASTPIECE] + do (* ; + "Run thru the converted pieces, noting their CHARLOOKS and PARALOOKS for the get/put caches.") + (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE PLOOKS + ) + of PC) + TEXTOBJ)) + (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS + (fetch (PIECE PPARALOOKS) of PC) + TEXTOBJ)) + (SETQ PC (fetch (PIECE NEXTPIECE) of PC] + (T (* ; + "Nope--it's straight unformatted text") + [SETQ PCTB (\MAKEPCTB (create PIECE + PFILE _ TEXT + PFPOS _ START + PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + START) + PREVPIECE _ NIL + PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ) + PPARALAST _ NIL + PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS DEFAULTPARALOOKS + TEXTOBJ] + (* ; + "So create a single piece to describe its contents") + (* INSERT-BRT (CREATEPCNODE + (ADD1 (IDIFFERENCE (OR END + (GETEOFPTR TEXT)) START)) + (QUOTE LASTPIECE)) PCTB) + (* ; "Insert LASTPIECE here") + )) + PCTB]) + +(\TEDIT.CACHEFILE + [LAMBDA (TEXT TEXTOBJ START END) (* ; "Edited 14-Jul-2022 08:44 by rmk") + (LET (CACHE) + + (* ;; "Sets the external format and its EOL.") + + [SETQ CACHE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW `((TYPE TEXT) + (:EXTERNAL-FORMAT ,(GETSTREAMPROP TEXT + :EXTERNAL-FORMAT + ] + (COND + ((OR START END) + (COPYBYTES TEXT CACHE (OR START 0) + (OR END -1))) + (T (COPYBYTES TEXT CACHE))) (* ; "Copy the text there") + + (* ;; "COPYBYTES can only have start/end args of NIL if the file is not random access. So it's impossible to grab out of the middle of a file on an NS server. Sorry.") + + (CLOSEF TEXT) + (CL:WHEN TEXTOBJ + + (* ;; + "REMEMBER THAT THIS TEXT WAS CACHED, SO THAT LATER PUTS DON'T INVALIDATE THE CACHE.") + + (TEXTPROP TEXTOBJ 'CACHE T)) + CACHE]) + +(\TEDIT.UNIQUIFY.ALL + [LAMBDA (TEXTOBJ DEFAULTLOOKS) (* ; "Edited 13-Jul-2022 22:56 by rmk") + (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) + TEXTOBJ)) (* ; + "And make sure that the default and caret looks are reflected in that list.") + (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) + TEXTOBJ)) + (AND DEFAULTLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ)) + (* ; + "And the default looks we used in this function...") + (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) + TEXTOBJ]) +) @@ -3481,25 +3460,27 @@ (RPLACD TABSPEC TABS]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2979 55273 (TEDIT.BUILD.PCTB 2989 . 34712) (\TEDIT.CONVERT.FOREIGN.FORMAT 34714 . 36294 -) (TEDIT.FORMATTEDFILEP 36296 . 39508) (TEDIT.GET 39510 . 47992) (TEDIT.PARSE.PAGEFRAMES1 47994 . -49700) (\ARBIN 49702 . 50318) (\ATMIN 50320 . 50645) (\DWIN 50647 . 50921) (\STRINGIN 50923 . 51527) ( -\TEDIT.FORMATTEDP1 51529 . 53786) (\TEDIT.SET.WINDOW 53788 . 54299) (TEDIT.GET.PASSWORD 54301 . 55271) -) (55309 74867 (TEDIT.INCLUDE 55319 . 66091) (TEDIT.RAW.INCLUDE 66093 . 74865)) (74901 116749 ( -TEDIT.PUT 74911 . 84872) (TEDIT.PUT.PCTB 84874 . 110430) (\TEDIT.PUTRESET 110432 . 110674) ( -TEDIT.PUT.PIECE.DESCRIPTOR 110676 . 113320) (\ARBOUT 113322 . 114473) (\ATMOUT 114475 . 114986) ( -\DWOUT 114988 . 115267) (\STRINGOUT 115269 . 115705) (\TEDIT-OPEN-FONT-FILE 115707 . 116747)) (116750 -128178 (\TEDIT.GET.CHARLOOKS.LIST 116760 . 117161) (\TEDIT.GET.SINGLE.CHARLOOKS 117163 . 120962) ( -\TEDIT.PUT.CHARLOOKS.LIST 120964 . 122901) (\TEDIT.PUT.SINGLE.CHARLOOKS 122903 . 128176)) (128179 -142455 (\TEDIT.GET.PARALOOKS.LIST 128189 . 128598) (\TEDIT.GET.SINGLE.PARALOOKS 128600 . 135237) ( -\TEDIT.PUT.PARALOOKS.LIST 135239 . 136246) (\TEDIT.PUT.SINGLE.PARALOOKS 136248 . 142453)) (142763 -200061 (TEDIT.BUILD.PCTB2 142773 . 155573) (\TEDIT.GET.CHARLOOKS.LIST2 155575 . 155978) ( -\TEDIT.GET.SINGLE.CHARLOOKS2 155980 . 159457) (\TEDIT.PUT.SINGLE.PARALOOKS2 159459 . 163958) ( -\TEDIT.PUT.SINGLE.CHARLOOKS2 163960 . 168476) (\TEDIT.GET.PARALOOKS.LIST2 168478 . 168881) ( -\TEDIT.GET.SINGLE.PARALOOKS2 168883 . 173506) (TEDIT.PUT.PCTB2 173508 . 197122) ( -\TEDIT.PUT.CHARLOOKS.LIST2 197124 . 199063) (\TEDIT.PUT.PARALOOKS.LIST2 199065 . 200059)) (200138 -221240 (TEDIT.BUILD.PCTB1 200148 . 210066) (TEDIT.GET.PAGEFRAMES1 210068 . 210424) ( -\TEDIT.GET.CHARLOOKS1 210426 . 214588) (\TEDIT.GET.PARALOOKS1 214590 . 219206) (TEDIT.GET.OBJECT1 -219208 . 221238)) (221300 235657 (TEDIT.BUILD.PCTB0 221310 . 225660) (TEDIT.GET.CHARLOOKS0 225662 . -230090) (TEDIT.GET.OBJECT0 230092 . 232122) (TEDIT.GET.PARALOOKS0 232124 . 235655))))) + (FILEMAP (NIL (3224 33441 (TEDIT.BUILD.PCTB 3234 . 12880) (\TEDIT.CONVERT.FOREIGN.FORMAT 12882 . 14462 +) (TEDIT.FORMATTEDFILEP 14464 . 17676) (TEDIT.GET 17678 . 26160) (TEDIT.PARSE.PAGEFRAMES1 26162 . +27868) (\ARBIN 27870 . 28486) (\ATMIN 28488 . 28813) (\DWIN 28815 . 29089) (\STRINGIN 29091 . 29695) ( +\TEDIT.FORMATTEDP1 29697 . 31954) (\TEDIT.SET.WINDOW 31956 . 32467) (TEDIT.GET.PASSWORD 32469 . 33439) +) (33442 52110 (\TEDIT.READ.FORMATTED.FILE 33452 . 43928) (\TEDIT.READ.OLDFORMATTED.FILE 43930 . 46162 +) (\TEDIT.READ.UNFORMATTED.FILE 46164 . 49918) (\TEDIT.CACHEFILE 49920 . 51128) (\TEDIT.UNIQUIFY.ALL +51130 . 52108)) (52146 71704 (TEDIT.INCLUDE 52156 . 62928) (TEDIT.RAW.INCLUDE 62930 . 71702)) (71738 +113586 (TEDIT.PUT 71748 . 81709) (TEDIT.PUT.PCTB 81711 . 107267) (\TEDIT.PUTRESET 107269 . 107511) ( +TEDIT.PUT.PIECE.DESCRIPTOR 107513 . 110157) (\ARBOUT 110159 . 111310) (\ATMOUT 111312 . 111823) ( +\DWOUT 111825 . 112104) (\STRINGOUT 112106 . 112542) (\TEDIT-OPEN-FONT-FILE 112544 . 113584)) (113587 +125015 (\TEDIT.GET.CHARLOOKS.LIST 113597 . 113998) (\TEDIT.GET.SINGLE.CHARLOOKS 114000 . 117799) ( +\TEDIT.PUT.CHARLOOKS.LIST 117801 . 119738) (\TEDIT.PUT.SINGLE.CHARLOOKS 119740 . 125013)) (125016 +139292 (\TEDIT.GET.PARALOOKS.LIST 125026 . 125435) (\TEDIT.GET.SINGLE.PARALOOKS 125437 . 132074) ( +\TEDIT.PUT.PARALOOKS.LIST 132076 . 133083) (\TEDIT.PUT.SINGLE.PARALOOKS 133085 . 139290)) (139600 +196898 (TEDIT.BUILD.PCTB2 139610 . 152410) (\TEDIT.GET.CHARLOOKS.LIST2 152412 . 152815) ( +\TEDIT.GET.SINGLE.CHARLOOKS2 152817 . 156294) (\TEDIT.PUT.SINGLE.PARALOOKS2 156296 . 160795) ( +\TEDIT.PUT.SINGLE.CHARLOOKS2 160797 . 165313) (\TEDIT.GET.PARALOOKS.LIST2 165315 . 165718) ( +\TEDIT.GET.SINGLE.PARALOOKS2 165720 . 170343) (TEDIT.PUT.PCTB2 170345 . 193959) ( +\TEDIT.PUT.CHARLOOKS.LIST2 193961 . 195900) (\TEDIT.PUT.PARALOOKS.LIST2 195902 . 196896)) (196975 +218077 (TEDIT.BUILD.PCTB1 196985 . 206903) (TEDIT.GET.PAGEFRAMES1 206905 . 207261) ( +\TEDIT.GET.CHARLOOKS1 207263 . 211425) (\TEDIT.GET.PARALOOKS1 211427 . 216043) (TEDIT.GET.OBJECT1 +216045 . 218075)) (218137 232494 (TEDIT.BUILD.PCTB0 218147 . 222497) (TEDIT.GET.CHARLOOKS0 222499 . +226927) (TEDIT.GET.OBJECT0 226929 . 228959) (TEDIT.GET.PARALOOKS0 228961 . 232492))))) STOP diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM index 74e0ee7e8d47ba8cebbe7e794fcf428cd46205ea..4380e2ae523681acc9417ebf94425961104d6040 100644 GIT binary patch delta 5268 zcma)AZ){sv6@UKIBy-c$PTVw2Quj9PTDy?Q@A>_)Gb;T2{9M1p@pWxyYf2?&nak27 z>!wXeOiZ{M5<fZYxhF3^^7vy*|w{xT3&CrHeEE%P8+$IF||;* z>N)yA;2z#f;z%qIB~NK!9Q@h-iuT*bm%oC~3P?x@60e|fEw2{O=#|kbM$ufcf&x2V zHHM-Os^tnhf>CN6PgP=Qyj0d7H1Kp~Gz)u~y620H*sh1scs3b`mJlzXl3G>^7*AFT zMx}~C#3R_dyiF8GB@LER=z>wK>gDousj6n+NJ~gW^hjWo038ia7l{q9N-hJ8p;M)@ z`3-+$Z`+BQKlh*Y@(I(k=TL(eQC82X(}ijd7ppPkeRiLh>(ti<)OFvpD_nDygMSYV z2FTA`z{KSd{9;(FEsq!jTSC6S3M3fGH z)>2pdRVwe`E`w+z_b6F8`O`ENt_`KtjMhy=bDTwNGx=PHmDZ>qH`2c*tE&rXYI37v zVRQB5{2bRj%jV-NTjyGv(b0UkYJt>zvvaJ$%&l-A(Ls2QJJ50Y2U z>iekA%_F`ak@+MDI*FIx-Zne0X6e4^)l(Dn;5ImR#2XLVzvn`}ZXEsr4%exdo68eH zc0k>@e|T*Ohv^JYu-}btmD+H z58(b!UiBNn8w`1Wl}3L}qj&3<8(SZJ@AB5x?Zw*{%+udF)HD3p);qP~74M}b|K{pN z^G|`J#!UzK7DK(g82Q!@^kJrE;Q^vPu;Pt)YR9c29>K@=5-hdw$l^P-5ep-44K;5S z>PvezS06Qvy~i4FIPeM94&W2_vgTR!)J|DbIEqi%)}ml7YT*;!+KJ|^CGX~{fFsv% zgdW2pp^NksV~IgaeUWXjcxxQouwTbBTc`t#J#Ni5hKWjoI^Z)fON6iw9t6%I z{L=sF{L-SAFQkh&LW$JEk@Y}k;+;AF3imJS(`2~IYW{O^6DaV;?6w^n_u8^I6g-G~ zcT-v~rL@+TH(;aF`N?#KZJU{7anJ!fTWM4aFKn*GaCndJ1st}?o@uZ30IGo6xe9c4?v-qSFZLq$ZKaGGKvV`uI+Ut zpdu;;Om7n>Qtf;NeCqHWkcg6ux52*>cSu7{Igl!Y!wlPH*~aV!l3o6g;Y``G1l+L$ zvpdykIy5U!E0w z2FpUXz>8W;V#`|_5J3XMn>Jb6ZPYXY5PhmdFPlt=nq9jXz`K+)&DZ=I+^r`B z=+_at(n*0e6oO{JN4u$4=6lbrKTV}=0N-jhZoghHIGsk8mD!{paXJp2iAXyFEYK4Q z25`?VNH#yvLJb-W=O=<*PuftOe&W0vB71TFHQa9p$?6fSulYw$t=DrSy*RnQXXbg_ zyRtQfgWg(jW$QEz9o)Yof-GC&EVM$1NO~YFH@a&5q$?04iB{V}B2EhC5JA#b9PyHD zt_(&(P%*cc=*c8`#w({t=sf~;AYdk|#^JIFB-%g#Am)smI#Y1LMu7gq4kmz1H(U?^ z=?<7tka_gOzAV^w1E^J~+d(6sBa~n+PJkCnV_7q?CahxAgoYGS3 zKbp04+SWbJ4-Uc~WzBP$m$lWtbe{B{+PeR-Eh_zbI!_A-yBk*5{rMoh&``*0r)}>1 zdOsUJ%8@GK5?Bo9`kJ@tW|t^0Ha~{MhU6q48%onvlxo948EFMv(Q^oLUBjiB%uH3U z03xHlr8k!FWczNItXABL)JsN>sGIMe% z(tsp~n~l=UB+tj(tJ>C0(%UlNcI+aSmEQ&+w7n@n?*yEU*Zy{p{;@Mi+sDfyU3BCk zlSeG|`|5U;aW)M?jX@hqFT^s0t5>8y9>M%-aOi$G5+Gprg7yQ|aZfFObio`v^UigX@gAZF8e91!5Q|N&QkXgK=c>?D0 zox|oY?qp%~$(<4N;fD{HpSe3is(yt&ORq;5+_r~ZR{pCJG*;(yVsE3`fjg2=X`U$Tj!67vX*;E zUE6g+8ma5AQA9sA1{Z|-rIL9w zvwL?=@&$kJ&b)c^-tYYzzvqAdJ^16l2EX;_U06xP;)&P`vr`HlM15Eu8vES*kSK^E z!cqcj2_fExLeu9?J$mMevyac8Dx*_RpFQ{FeF?O1=KRd#3y;}f_21ibhkIDGf9dbF zF9wc%3W-uoQ3aGJ6pbTUGEo{z>!yK1x7|_`SnWeEJe#kCOe38&hesx|x%6-$Wsaak zS`7^pP)tKPLJpS@ELD`HAEiNwaf*ZrdQoS5xopX#Od?8+>ctHtj0!1wBp{MYv!$#7 zDG#)YtTLh}1xRw7$(CdMmMo)8HfNZ}3kE$D(TQx{G>XNEf~k+>7!9NT{z8!yawW6B zpE3zRFpXm-85v^)QDrzs_0lLDi*arT-L}%bVn6rIo=OZE$0%${kzoz?Wb+T#jiF=- zO_YqHX^a=>PGma@E<=jrI<;QJ$Sj#fLm#IbfiVoH#wiaFu!c+*7Tu{RrKd)Xhv+(v zDr`g73Myocl#$J6NNRL1rGP6u2bBzi`VGq{ZyaU5#1eR%`P(}a!E-sz26(`6DUxRT z1vp5Ni9Cg>)q?@ff$)r=ID8@g1q5-<<_#8kR5EfvkrBmRw+u8+6gf5s_e7D}2V47O z@cwqttQQ|PO#5Q+k$@uD!@s$wqF|IZGWtZ$%#ge}h}stq27Gr-`QT?hG_o9=ozu&g z+URy=IP%}_$XZ{du+LcT(U*f?uKIpHMNf`C9ipG<5GP(rFK;^fg-wjqo=h7fsk>X* z#;1Q*XQF1Jrjuk0^3|%pTd&>6>B;B;N3U(y*%4Qod5m7&XZ8PxU-)*__a*!N+Kx(} zGjcUm+n*$T6lH3;<%#tU%DRZyMJlSgUgkm))%8b!k)d=RxB4$}Sq|yryzKYyIwEg( zM1VH!b7rR7rdyn3iruiHOOr{DWo~V0oIVt5RQ_$(!kX`cnRgeqtbg#2x4Im1XufOiFMpi*(_6mo z@=Vm{H1PR76bDF@CX0W70f|HokRw5sJ-?divJSA-^Gz7bW6jvcZdfA#Y{UbW)_F|Q zKx|+%TxtfW847ol!W{*;m0R$R-h#L8P5<)&f07LAY2$7d7ps#Ut@tATAu{0!!MF!)%6%T60nX`*Y9Hj$Rzz#d@CIs95|GdeC}r@ z>>h-@gOzq`a`C0$YqYd}N}~QUggojbbrKDDMPzj@CdzYnBJZ6KtX;W<_Zw#_fPtrs zLpE4+xo**mV36_?UEtt+4w9S=;S5&O`^cmgj>|V2^KfeZ63Yqc4B%l>=E zEydGzWG>RBlKJ3rPq)kHkdySn$!b9GTW1}jkOgvxTWenKo;{jjnZ$kLGdzq9k zyDnYnSPs%>hlK6KP`pCI%iZK8gy1Cj6F$>U^^>2mcS7g!IoweH3lg@<&f>cqP6wIU zwX~C*=GyqD`K53vVKRF=Tm9XLI<5eCI8IkT`Jrz>6b1W&+#A4(jn!S_BF3yMqpcC^ zT%hxbYtT8Ev@a-_McBt;2zr9X9-2JfctYPcUN8$qXzHLpQf2%7q27I1Q#5oUGig9m z2UJOMnL)%b^mIlFcvURfk(HiS=$ACnuG(Ag#|pHSpjC&4NsA%9Sk#ZxrGPTf4Lxj* z!X_>QYtIA2tXst~Dehj7Rmr;`$JNFK+1|3U&AxcEtp&@HXkQ!Nx(7?DicX}DX7kXv zOB83eSTggp#ln)P+0V*5gIL1$M|brGB!PZ{qAJ+JpL-8OW7^~uEQ)ZO3lgE5+;9X9 z9$0IT4D}zzV8n@W{jkA0G>nxvRnvm8EP~)&rvz;y4nf1HG)g9NY3f!1EV{MLhp9t| zc|mA&{}{*;?e;bf1p?AkW?4W}z@lAUDkx|&T!p~B)3Lh?sfyeLR28^8;%XdV?u^9Y zv|*K^smxhQJVsA4Hxhub5^ zP3Vk8L224SE;irBU`J8Ur}b3ID3u_ALAVD33o_zL3J835wtZ^_z}JV2;S7|+Fm00Q zAeB$SBw-rjU4UxW*)46`b}=OOWm8@Uiz9C|0R{DGtl#;|e{G z3sS>H3Ix}crGUHYu8Tp9HZ}@PUN+*vFrMbD} zjW}r_k{@W0eC{gl-P6EomqsUTra=>6?5)Q+4r4Ws!sZm4tsx3=Y`+lesUQU&8-7Po zJ&6jq+oi!U$5%0VVE5PNL0<_VGE;pC?>JOq5+mEi?-X*@?Nkm53kagX6o zi|2c($&C^W*DwGh3A{2w;AxkzfW8QiaJHBtMdJbzHPtONnD3?f5}rJ-#>GawMVO&I zEejYDgNnwA!bM}SxLGtjx-L2_HDqAG?8yL&y(QEI_&GCfmS7C`%At`Cvi;fFZS7Ft z@TADt9uoG!A2dN#>?!e~eIX}-*@rgw+W+ckTl#e9Z@ZV? zR7YxC2GKx@jF-^B1L(mAQOLgZVak5*!(M;L{`kYReeh-?d#b*_&3o?DrNz zKza4`sD0&)R{Qri_u4f(YHO>V_V;gYws)@f+kd#(Wv_l^ll>W>y|UV4Us&C1zq+~u TZoSgC&CY+cXX&HW=YszOOziy|