github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-02 06:26:19 +00:00
Code Issues Projects Releases Wiki Activity

Rmk103 font and related code updates (#2216)

Browse Source 
This PR contains a large number of changes in support of the implementation of the  Medley Dsplay Fon file format.

The changes are documented in the docs/internal/FONTCHANGES.TEDIT file.
This commit is contained in:
rmkaplan
2025-08-13 09:59:37 -07:00
committed by GitHub
parent 9c93b27d79
commit a9618e4aaf
55 changed files with 5051 additions and 4016 deletions
Download Patch File Download Diff File Expand all files Collapse all files

739
library/FX-80DRIVER
View File

File diff suppressed because it is too large Load Diff

BIN
library/FX-80DRIVER.LCOM
View File

Binary file not shown.

60
library/IMAGEOBJ
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4 34381
(FILECREATED " 9-Jun-2025 20:33:49" {WMEDLEY}<library>IMAGEOBJ.;5 32874
:EDIT-BY rmk
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
:CHANGES-TO (VARS IMAGEOBJCOMS)
:PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
:PREVIOUS-DATE " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4)
(PRETTYCOMPRINT IMAGEOBJCOMS)
@@ -15,8 +15,7 @@
((COMS
(* ;; "Bit-map image objects")
(FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
)
(FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT)
(* ;; "fns for the bitmap tedit object.")
@@ -117,42 +116,6 @@
(* reset type of function that changes
 the title font)
(DSPFONT FONT WindowTitleDisplayStream)))
(\PRINTBINARYBITMAP
(LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16")
(* * prints the representation of a bitmap onto STREAM in a form that can be
 read back by \READBINARYBITMAP.)
(PROG ((STREAM (GETSTREAM STREAM 'OUTPUT))
BMH)
(OR (BITMAPP BITMAP)
(\ILLEGAL.ARG BITMAP))
(\WOUT STREAM (BITMAPWIDTH BITMAP))
(\WOUT STREAM (SETQ BMH (BITMAPHEIGHT BITMAP)))
(\WOUT STREAM (BITSPERPIXEL BITMAP))
(\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP)
0
(ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
BMH BYTESPERWORD))
(RETURN BITMAP))))
(\READBINARYBITMAP
(LAMBDA (STREAM) (* rrb "23-Jul-84 15:17")
(* * reads a bitmap printed on STREAM by \PRINTBINARYBITMAP.)
(SETQ STREAM (GETSTREAM STREAM 'INPUT))
(PROG ((BMW (\WIN STREAM))
(BMH (\WIN STREAM))
(BPP (\WIN STREAM))
BITMAP)
(SETQ BITMAP (BITMAPCREATE BMW BMH BPP))
(\BINS STREAM (fetch (BITMAP BITMAPBASE) of BITMAP)
0
(ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
BMH BYTESPERWORD))
(RETURN BITMAP))))
)
@@ -770,12 +733,11 @@
(FILESLOAD EDITBITMAP)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT
5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5
20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4
25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
PROMPTFOREVALED 32055 . 34279)))))
(FILEMAP (NIL (2914 5964 (BITMAPTEDITOBJ 2924 . 3567) (COERCETOBITMAP 3569 . 5613) (WINDOWTITLEFONT
5615 . 5962)) (6015 22133 (BMOBJ.BUTTONEVENTINFN 6025 . 10571) (BMOBJ.COPYFN 10573 . 11199) (
BMOBJ.DISPLAYFN 11201 . 14930) (BMOBJ.IMAGEBOXFN 14932 . 17347) (BMOBJ.PUTFN 17349 . 18281) (
BMOBJ.INIT 18283 . 19322) (BMOBJ.GETFN5 19324 . 19914) (BMOBJ.CREATE.MENU 19916 . 22131)) (22223 25507
(SCALED.BITMAP.GETFN 22233 . 22659) (BMOBJ.GETFN 22661 . 23196) (BMOBJ.GETFN2 23198 . 23683) (
BMOBJ.GETFN3 23685 . 24473) (BMOBJ.GETFN4 24475 . 25505)) (27442 32774 (GET.OBJ.FROM.USER 27452 .
29418) (BITMAPOBJ.SNAPW 29420 . 30546) (PROMPTFOREVALED 30548 . 32772)))))
STOP

BIN
library/IMAGEOBJ.LCOM
View File

Binary file not shown.

248
library/MULTI-ALIST Normal file
View File

@@ -0,0 +1,248 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Jul-2025 12:37:33" {WMEDLEY}<lispusers>MULTI-ALIST.;19 12851
:EDIT-BY rmk
:CHANGES-TO (VARS MULTI-ALISTCOMS)
(MACROS PUSHMULTI PUTMULTI PUSHMULTI-NEW FPUSHMULTI FPUSHMULTI-NEW)
:PREVIOUS-DATE " 8-Jul-2025 12:54:37" {WMEDLEY}<lispusers>MULTI-ALIST.;18)
(PRETTYCOMPRINT MULTI-ALISTCOMS)
(RPAQQ MULTI-ALISTCOMS
((MACROS GETMULTI PUSHMULTI PUTMULTI PUSHMULTI-NEW CHANGEMULTI REMOVEMULTI REMOVEMULTIALL)
(MACROS FGETMULTI FPUSHMULTI FPUTMULTI FPUSHMULTI-NEW FCHANGEMULTI)
(FNS MAPMULTI MAPMULTI1 COLLECTMULTI)
(FNS GETMULTI.EXPAND PUTMULTI.EXPAND REMOVEMULTI.EXPAND)
(MACROS ADDTOMULTI)
(FNS ADDTOMULTI1)
(LOCALVARS . T)))
(DECLARE%: EVAL@COMPILE
(PUTPROPS GETMULTI MACRO (ARGS (GETMULTI.EXPAND 'SASSOC ARGS)))
(PUTPROPS PUSHMULTI MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS)))
(PUTPROPS PUTMULTI MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS NIL T)))
(PUTPROPS PUSHMULTI-NEW MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS)))
(PUTPROPS CHANGEMULTI MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS NIL NIL T)))
(PUTPROPS REMOVEMULTI MACRO (ARGS (REMOVEMULTI.EXPAND ARGS)))
(PUTPROPS REMOVEMULTIALL MACRO (ARGS (REMOVEMULTI.EXPAND ARGS T)))
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS FGETMULTI MACRO (ARGS (GETMULTI.EXPAND 'FASSOC ARGS)))
(PUTPROPS FPUSHMULTI MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
(PUTPROPS FPUTMULTI MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
(PUTPROPS FPUSHMULTI-NEW MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
(PUTPROPS FCHANGEMULTI MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS NIL NIL T)))
)
(DEFINEQ
(MAPMULTI
[LAMBDA (MULTIALIST MAPFN) (* ; "Edited 29-Jan-2025 19:33 by rmk")
(* ; "Edited 25-Jan-2025 14:51 by rmk")
(* ; "Edited 16-Jan-2025 10:32 by rmk")
(* ; "Edited 6-Jan-2020 10:15 by rmk:")
(* ;; "MAPMULTI applies a mapping function of N args to each item in an N-way item in the multi-alist at MULTIALIST. If an item C is inserted by (PUTMULTI FOO A B C), then MAPFN should be a 3 argument function and it will be applied to A B C. The caller is responsible for making sure the arities of the index and the mapfn correspond.")
(DECLARE (SPECVARS MAPFN))
(LET ($$LISTFORARGS$$)
(DECLARE (SPECVARS $$LISTFORARGS$$))
(SETQ $$LISTFORARGS$$ (FOR I FROM 1 TO (NARGS MAPFN) COLLECT NIL))
(MAPMULTI1 MULTIALIST $$LISTFORARGS$$ (NARGS MAPFN])
(MAPMULTI1
[LAMBDA (SUBALIST ARGLIST NREMAINING) (* ; "Edited 25-Jan-2025 15:03 by rmk")
(* ; "Edited 22-Jan-2025 23:42 by rmk")
(* ; "Edited 16-Jan-2025 10:29 by rmk")
(* ; "Edited 6-Jan-2020 10:21 by rmk:")
(DECLARE (USEDFREE $$LISTFORARGS$$ MAPFN))
(if [AND (IGREATERP NREMAINING 1)
(LISTP (CAR (LISTP SUBALIST]
then
(* ;; "Still a list of alists.")
(for SI in SUBALIST do (RPLACA ARGLIST (CAR SI))
(MAPMULTI1 (CDR SI)
(CDR ARGLIST)
(SUB1 NREMAINING)))
else (for ITEM inside SUBALIST do (RPLACA ARGLIST ITEM)
(APPLY MAPFN $$LISTFORARGS$$])
(COLLECTMULTI
[LAMBDA (MULTIALIST MAPFN) (* ; "Edited 25-Jan-2025 15:00 by rmk")
(* ; "Edited 22-Jan-2025 23:44 by rmk")
(* ; "Edited 6-Jan-2020 10:15 by rmk:")
(LET ($$COLLECT)
(DECLARE (SPECVARS $$COLLECT))
(MAPMULTI MULTIALIST MAPFN)
$$COLLECT])
)
(DEFINEQ
(GETMULTI.EXPAND
[LAMBDA (ASSOCFN ARGS) (* ; "Edited 14-Jun-2025 09:47 by rmk")
(* ; "Edited 16-Jan-2025 10:27 by rmk")
(* ; "Edited 19-Jul-2020 00:38 by rmk:")
(* ; "Edited 22-Mar-2020 13:21 by rmk:")
(* ; "Edited 27-Feb-2020 13:44 by rmk:")
(* ; "Edited 30-Dec-2019 20:50 by rmk:")
(* ;; "If SUM, returns the value after the last argument, paired with PUTMULTISUM")
(IF (CDR ARGS)
THEN `(LET ($$CELL$$)
(DECLARE (LOCALVARS $$CELL$$))
,@[FOR ATAIL (HEAD _ (CAR ARGS)) ON (CDR ARGS)
COLLECT (PROG1 `[SETQ $$CELL$$ (CDR (,ASSOCFN ,(CAR ATAIL)
,HEAD]
(SETQ HEAD '$$CELL$$))]
$$CELL$$)
ELSE (CAR ARGS])
(PUTMULTI.EXPAND
[LAMBDA (ASSOCFN ARGS ALLOWREPEATS SINGLEVALUE CHANGE) (* ; "Edited 8-Jul-2025 12:52 by rmk")
(* ; "Edited 14-Jun-2025 09:44 by rmk")
(* ; "Edited 23-Jan-2025 09:40 by rmk")
(* ; "Edited 16-Jan-2025 10:18 by rmk")
(* ; "Edited 17-Aug-2020 14:09 by rmk:")
(* ;; "If ALLOWREPEATS, doesn't test (MEMBER) for preexisting values, just accumulates")
(* ;; "If SINGLEVALUE, new value smashes out old")
(* ;; "For CHANGE, the last argument is the change expression to be evaluated, with the current value denoted by the atom DATUM")
(* ;; "")
(* ;; "We get the setf method so that any expressions in the form will be evaluated only once.")
(CL:MULTIPLE-VALUE-BIND
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
(CL:GET-SETF-METHOD (CAR ARGS))
(if (CDR ARGS)
then
(LET
((VALBINDINGS (FOR VF IN VALFORMS AS TV IN TEMPVARS COLLECT (LIST TV VF)))
EXPANSION)
(SETQ EXPANSION
`(LET
($$ARG1$$ $$ARG2$$)
(DECLARE (LOCALVARS $$ARG1$$ $$ARG2$$))
,@[FOR ATAIL (HEAD _ ACCESSFORM) ON ARGS WHILE (CDR ATAIL)
JOIN
(IF (AND CHANGE (NULL (CDDR ATAIL)))
THEN (POP ATAIL)
[AND NIL `((CL:UNLESS ,HEAD (RPLACD $$ARG1$$ 0))
(SETQ $$ARG2$$ (ADD ,HEAD ,(CAR ATAIL]
`[(SETQ $$ARG2$$ ,(SUBST HEAD 'DATUM (CAR ATAIL]
ELSE
(PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
,(IF (CDDR ATAIL)
THEN `[SETQ $$ARG1$$ (OR (,ASSOCFN $$ARG2$$ ,HEAD)
(CAR (CL:PUSH (CONS $$ARG2$$)
,HEAD]
ELSEIF ALLOWREPEATS
THEN `(push ,HEAD $$ARG2$$)
ELSEIF SINGLEVALUE
THEN `(CL:SETF ,HEAD $$ARG2$$)
ELSE `(OR (MEMBER $$ARG2$$ ,HEAD)
(push ,HEAD $$ARG2$$]
(SETQ HEAD '(CDR $$ARG1$$)))]
$$ARG2$$))
(CL:IF VALBINDINGS
`(LET* ,VALBINDINGS (DECLARE (LOCALVARS ,@TEMPVARS))
,EXPANSION)
EXPANSION))
else (CAR ARGS])
(REMOVEMULTI.EXPAND
[LAMBDA (ARGS ALLFLAG) (* ; "Edited 16-Jan-2025 10:34 by rmk")
(* ; "Edited 17-Aug-2020 15:12 by rmk:")
(* ; "Edited 17-May-2020 17:25 by rmk:")
(* ; "Edited 14-Feb-2020 11:24 by rmk:")
(* ; "Edited 25-Dec-2019 09:57 by rmk:")
(* ;; "If ALLFLAG, then all data after the last of ARGS, if any, is removed. That is, if there are 3 keys to the index, and REMOVEMULTIALL is invoked with 2 keys, then it's as if no entries were made for any of the third keys after those first two. In the case of REMOVEMULTIALL, it returns the previous tail.")
(* ;; "No point in distinguishing FASSOC from SASSOC here.")
(CL:MULTIPLE-VALUE-BIND
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
(CL:GET-SETF-METHOD (CAR ARGS))
(CL:IF (CDR ARGS)
`(LET*
,(FOR VF IN VALFORMS AS TV IN TEMPVARS COLLECT (LIST TV VF))
(DECLARE (LOCALVARS ,@TEMPVARS))
(LET
($$ARG1$$ $$ARG2$$)
(DECLARE (LOCALVARS $$ARG1$$ $$ARG2$$))
,@[FOR ATAIL (HEAD _ ACCESSFORM) ON ARGS WHILE (CDR ATAIL)
JOIN (PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
,(IF (CDDR ATAIL)
THEN `(SETQ $$ARG1$$ (SASSOC $$ARG2$$ ,HEAD))
ELSEIF ALLFLAG
THEN `(CL:WHEN (SETQ $$ARG1$$ (SASSOC $$ARG2$$ ,HEAD))
(SETQ $$ARG2$$ (CDR $$ARG1$$))
(RPLACD $$ARG1$$))
ELSE `(AND (SETQ $$ARG2$$ (MEMBER $$ARG2$$ ,HEAD))
(RPLACD $$ARG1$$ (DREMOVE (SETQ $$ARG2$$ (CAR $$ARG2$$))
,HEAD]
(SETQ HEAD '(CDR $$ARG1$$)))]
$$ARG2$$))
(CAR ARGS))])
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS ADDTOMULTI MACRO [ARGS (CL:MULTIPLE-VALUE-BIND
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
(CL:GET-SETF-METHOD (CAR ARGS))
`(LET* [,@(FOR VF IN VALFORMS AS TV IN TEMPVARS
COLLECT (LIST TV VF))
($$KEYS ,(CADR ARGS]
(DECLARE (LOCALVARS $$KEYS ,@TEMPVARS))
(COND
[(LISTP $$KEYS)
(CL:UNLESS (SASSOC (CAR $$KEYS)
,ACCESSFORM)
(CL:PUSH (CONS (CAR $$KEYS))
,ACCESSFORM))
(ADDTOMULTI1 ,ACCESSFORM $$KEYS ,(CADDR ARGS]
(T (CL:SETF ,ACCESSFORM ,(CADDR ARGS])
)
(DEFINEQ
(ADDTOMULTI1
[LAMBDA (PLACE KEYS VAL) (* ; "Edited 22-Jan-2025 23:47 by rmk")
(* ; "Edited 17-Aug-2020 15:05 by rmk:")
(* ;; "This allows the keys to be provided in a single list rather than as separate arguments.")
(FOR I (P _ PLACE) IN KEYS DO [SETQ P (OR (SASSOC I P)
(CAR (PUSH (CDR P)
(CONS I] FINALLY (PUSH (CDR P)
VAL))
VAL])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1845 4457 (MAPMULTI 1855 . 2923) (MAPMULTI1 2925 . 3982) (COLLECTMULTI 3984 . 4455)) (
4458 10939 (GETMULTI.EXPAND 4468 . 5698) (PUTMULTI.EXPAND 5700 . 8623) (REMOVEMULTI.EXPAND 8625 .
10937)) (12089 12774 (ADDTOMULTI1 12099 . 12772)))))
STOP

BIN
library/MULTI-ALIST.LCOM Normal file
View File

Binary file not shown.

BIN
library/MULTI-ALIST.TEDIT Normal file
View File

Binary file not shown.

216
library/POSTSCRIPTSTREAM
View File

@@ -1,16 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Jun-2025 16:12:21" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;5 258146
(FILECREATED "14-Jul-2025 22:21:34" {WMEDLEY}<library>POSTSCRIPTSTREAM.;24 258986
:EDIT-BY "mth"
:EDIT-BY rmk
:CHANGES-TO (FNS \BLTSHADE.PSC \PSC.COLOR.TO.RGB \DRAWLINE.PSC \DRAWARC.PSC POSTSCRIPTSEND
\TERPRI.PSC POSTSCRIPT.PUTCOMMAND POSTSCRIPT.PUTRGBCOLOR \DSPCOLOR.PSC
\DRAWCIRCLE.PSC \DRAWELLIPSE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC
\FILLCIRCLE.PSC \FILLPOLYGON.PSC POSTSCRIPT.TEDIT \BITBLT.PSC)
:CHANGES-TO (FNS \DSPFONT.PSC)
:PREVIOUS-DATE "28-Apr-2025 00:17:24"
{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;1)
:PREVIOUS-DATE "16-Jun-2025 00:04:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;23)
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -46,7 +42,7 @@
(FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE
PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES
POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS
POSTSCRIPT.FONTSAVAILABLE)
POSTSCRIPT.FONTSAVAILABLE POSTSCRIPT.FONTEXISTS?)
(COMS
(* ;; "Until macro in FONT is exported")
@@ -175,7 +171,8 @@
(IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
(FONTCREATE POSTSCRIPT.FONTCREATE)
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
(CREATECHARSET \CREATECHARSET.PSC]
(CREATECHARSET \CREATECHARSET.PSC)
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
(INITVARS (POSTSCRIPT.PAGETYPE 'LETTER))
(* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk")
@@ -619,11 +616,12 @@
PF])
(PSCFONT.SPELLFILE
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 22:15 by rmk:")
(* ; "Edited 5-Oct-92 15:23 by jds")
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 15-Jun-2025 23:31 by rmk")
(* ; "Edited 5-Oct-93 22:15 by rmk:")
(* ; "Edited 5-Oct-92 15:23 by jds")
(* ;;
 "Find the font file for a postscript font. Does the display-name conversion as well, for DOS.")
(* ;;
 "Find the font file for a postscript font. Does the display-name conversion as well, for DOS.")
(CL:WHEN POSTSCRIPTFONTDIRECTORIES
(\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST))
@@ -883,43 +881,44 @@
FONTID])
(POSTSCRIPT.FONTCREATE
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 29-Oct-93 16:39 by rmk:")
(* ; "Edited 3-Feb-93 17:22 by jds")
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 15-Jun-2025 23:40 by rmk")
(* ; "Edited 29-Oct-93 16:39 by rmk:")
(* ; "Edited 3-Feb-93 17:22 by jds")
(LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD
FACECHANGED (WEIGHT (CAR FACE))
(SLOPE (CADR FACE))
(EXPANSION (CADDR FACE)))
(* ;;
 "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.")
(* ;;
 "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.")
[COND
[(EQ SIZE 1)
(* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info")
(* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info")
(COND
((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
(* ;; "Check in-core cache for exact match first")
(* ;; "Check in-core cache for exact match first")
(SETQ FACECHANGED NIL))
((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
(* ;; "Check file for exact match next")
(* ;; "Check file for exact match next")
(SETQ PSCFD (PSCFONT.READFONT FULLNAME))
(SETQ FACECHANGED NIL))
((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION
ROTATION DEVICE))
((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION
DEVICE))
(* ;; "Then check cache for coerced match")
(* ;; "Then check cache for coerced match")
(SETQ FACECHANGED T))
((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION
DEVICE))
(* ;; "Check file for coerced match")
(* ;; "Check file for coerced match")
(SETQ PSCFD (PSCFONT.READFONT FULLNAME))
(SETQ FACECHANGED T)))
@@ -930,15 +929,14 @@
0.1)))
(COND
(FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD
with (POSTSCRIPT.GETFONTID (fetch (PSCFONT
FID)
of PSCFD)
WEIGHT SLOPE EXPANSION]
with (POSTSCRIPT.GETFONTID (fetch (PSCFONT FID)
of PSCFD)
WEIGHT SLOPE EXPANSION]
((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T))
(SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT)
'PSCFONT))
(* ;; "Scale the ASCENT and DESCENT")
(* ;; "Scale the ASCENT and DESCENT")
(SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD)
0.1)))
@@ -946,20 +944,20 @@
0.1)))
(SETQ SCALEFONTP T))
(T
(* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.")
(* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.")
(COND
([SETQ PSCFD (COND
((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION
DEVICE))
((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE
))
(PSCFONT.READFONT FULLNAME]
(SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD))
(SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD))
(SETQ SCALEFONTP NIL]
(COND
(PSCFD
(* ;; "Set up the Charset descriptions and Widths vectors for character set 0:")
(* ;; "Set up the Charset descriptions and Widths vectors for character set 0:")
(SETQ FD
(create FONTDESCRIPTOR
@@ -977,37 +975,35 @@
(SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD))
[COND
[SCALEFONTP (for CH from 0 to 255
do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE
(ELT FIXPWIDTHS
CH)
0.1]
(T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH
(ELT FIXPWIDTHS CH]
do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE (ELT FIXPWIDTHS
CH)
0.1]
(T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH (ELT FIXPWIDTHS CH]
(SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT))
(* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.")
(* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.")
(for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH
(\FGETWIDTH WIDTHSBLOCK CH)))
(for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH (\FGETWIDTH WIDTHSBLOCK CH)
))
[LET [(TMP (COND
(FULLNAME (\FONTINFOFROMFILENAME FULLNAME DEVICE))
(UNITFONT (fetch FONTDEVICESPEC of UNITFONT]
(* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got")
(* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got")
(COND
((AND TMP (NEQ FAMILY (CAR TMP)))
(replace FONTDEVICESPEC of FD with (LIST (CAR TMP)
SIZE
(COPY FACE)
0 DEVICE]
[LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION
DEVICE))
(DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD
ROTATION DEVICE)))
SIZE
(COPY FACE)
0 DEVICE]
[LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION DEVICE)
)
(DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD ROTATION
DEVICE)))
(* ;;
 "Now run thru the mapping table, filling in the new font from whatever source is specified:")
(* ;;
 "Now run thru the mapping table, filling in the new font from whatever source is specified:")
[MAPHASH *POSTSCRIPT-NS-HASH*
(FUNCTION (LAMBDA (MAPPING CODE)
@@ -1015,13 +1011,12 @@
(KIND CODE2 BASECHAR)
MAPPING
(* ;;
 "Depending on what kind of item it is, process it:")
(* ;; "Depending on what kind of item it is, process it:")
(SELECTQ KIND
(NIL
(* ;;
 "Translating an NS character to a PSC char in CS 0.")
(* ;;
 "Translating an NS character to a PSC char in CS 0.")
(\FSETCHARWIDTH FD CODE (\FGETWIDTH
PSCWIDTHSBLOCK
@@ -1036,8 +1031,8 @@
(\CHAR8CODE
CODE2])
(FUNCTION
(* ;;
 "This is fake and only works for the fractions. Need a better case.")
(* ;;
 "This is fake and only works for the fractions. Need a better case.")
[\FSETCHARWIDTH
FD CODE
@@ -1046,25 +1041,25 @@
(\FGETWIDTH
PSCWIDTHSBLOCK
(CHARCODE 1])
(ACCENT (* ;
 "CODE2 is the rendering character but width comes from width of basechar")
(ACCENT (* ;
 "CODE2 is the rendering character but width comes from width of basechar")
(\FSETCHARWIDTH FD CODE (\FGETWIDTH
PSCWIDTHSBLOCK
BASECHAR)))
(ACCENTPAIR
(* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent")
(* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent")
(\FSETCHARWIDTH FD CODE (\FGETWIDTH
PSCWIDTHSBLOCK
CODE2)))
(PROGN
(* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else")
(* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else")
NIL]
(* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)")
(* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)")
(MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE)
(CL:WHEN (EQ (CAR MAPPING)
@@ -1173,6 +1168,22 @@
NF))
else (LIST FD)))
else FONTSAVAILABLE])
(POSTSCRIPT.FONTEXISTS?
[LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 16-Jun-2025 00:04 by rmk")
(* ; "Edited 29-Oct-93 16:39 by rmk:")
(* ; "Edited 3-Feb-93 17:22 by jds")
(* ;; "Non-NIL if a postscript font with these parameters can be constructed.")
(* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, size 1 is presumed to be the base for all postscript fonts.")
(LET ((WEIGHT (fetch (FONTFACE WEIGHT) of FACE))
(SLOPE (fetch (FONTFACE SLOPE) of FACE))
(EXPANSION (fetch (FONTFACE EXPANSION) of FACE)))
(OR (PSCFONT.SPELLFILE FAMILY 1 FACE ROTATION DEVICE)
(PSCFONTFROMCACHE.COERCEFILE FAMILY 1 WEIGHT SLOPE EXPANSION ROTATION DEVICE)
(PSCFONT.COERCEFILE FAMILY 1 WEIGHT SLOPE EXPANSION ROTATION DEVICE])
)
@@ -2681,7 +2692,8 @@
CURRENT])
(\DSPFONT.PSC
[LAMBDA (STREAM FONT) (* ;
[LAMBDA (STREAM FONT) (* ; "Edited 14-Jul-2025 22:21 by rmk")
(* ;
 "Edited 26-May-93 01:06 by sybalsky:mv:envos")
(* ; "Edited 11-May-93 02:11 by jds")
(* ; "Edited 19-Jan-93 17:17 by jds")
@@ -2694,7 +2706,7 @@
(OLDFONT (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA))
NEWFONT FONTID)
(COND
((AND FONT (SETQ NEWFONT (OR (\COERCEFONTDESC FONT STREAM)
((AND FONT (SETQ NEWFONT (OR (FONTCREATE FONT NIL NIL NIL STREAM T)
(FONTCOPY OLDFONT FONT)))
(type? FONTDESCRIPTOR NEWFONT)
(NEQ NEWFONT OLDFONT))
@@ -4357,7 +4369,8 @@
(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
(FONTCREATE POSTSCRIPT.FONTCREATE)
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
(CREATECHARSET \CREATECHARSET.PSC)))
(CREATECHARSET \CREATECHARSET.PSC)
(FONTEXISTS? POSTSCRIPT.FONTEXISTS?)))
(RPAQ? POSTSCRIPT.PAGETYPE 'LETTER)
@@ -4401,38 +4414,39 @@
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (22736 33232 (POSTSCRIPT.INIT 22746 . 29838) (POSTSCRIPT.PUTRGBCOLOR 29840 . 30862) (
\PSC.COLOR.TO.RGB 30864 . 33230)) (34218 69002 (PSCFONT.READFONT 34228 . 36136) (PSCFONT.SPELLFILE
36138 . 36716) (PSCFONT.COERCEFILE 36718 . 38290) (PSCFONTFROMCACHE.SPELLFILE 38292 . 39277) (
PSCFONTFROMCACHE.COERCEFILE 39279 . 40931) (PSCFONT.WRITEFONT 40933 . 41948) (READ-AFM-FILE 41950 .
47821) (CONVERT-AFM-FILES 47823 . 49035) (POSTSCRIPT.GETFONTID 49037 . 50432) (POSTSCRIPT.FONTCREATE
50434 . 62833) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62835 . 65232) (POSTSCRIPT.FONTSAVAILABLE 65234
. 69000)) (69557 78842 (OPENPOSTSCRIPTSTREAM 69567 . 78508) (CLOSEPOSTSCRIPTSTREAM 78510 . 78840)) (
78887 84941 (POSTSCRIPT.HARDCOPYW 78897 . 82004) (POSTSCRIPT.TEDIT 82006 . 82490) (POSTSCRIPT.TEXT
82492 . 82783) (POSTSCRIPTFILEP 82785 . 83892) (MAKEEPSFILE 83894 . 84939)) (84942 128516 (
POSTSCRIPT.BITMAPSCALE 84952 . 87408) (POSTSCRIPT.CLOSESTRING 87410 . 87963) (POSTSCRIPT.ENDPAGE 87965
. 88856) (POSTSCRIPT.OUTSTR 88858 . 90075) (POSTSCRIPT.PUTBITMAPBYTES 90077 . 98548) (
POSTSCRIPT.PUTCOMMAND 98550 . 99539) (POSTSCRIPT.SET-FAKE-LANDSCAPE 99541 . 104061) (
POSTSCRIPT.SHOWACCUM 104063 . 106218) (POSTSCRIPT.STARTPAGE 106220 . 108752) (\POSTSCRIPTTAB 108754 .
109551) (\PS.BOUTFIXP 109553 . 110833) (\PS.SCALEHACK 110835 . 113478) (\PS.SCALEREGION 113480 .
114040) (\SCALEDBITBLT.PSC 114042 . 118352) (\SETPOS.PSC 118354 . 118835) (\SETXFORM.PSC 118837 .
121421) (\STRINGWIDTH.PSC 121423 . 121896) (\SWITCHFONTS.PSC 121898 . 127390) (\TERPRI.PSC 127392 .
128514)) (128551 182631 (\BITBLT.PSC 128561 . 129113) (\BLTSHADE.PSC 129115 . 133776) (\CHARWIDTH.PSC
133778 . 134285) (\CREATECHARSET.PSC 134287 . 135985) (\DRAWARC.PSC 135987 . 138365) (\DRAWCIRCLE.PSC
138367 . 140618) (\DRAWCURVE.PSC 140620 . 144464) (\DRAWELLIPSE.PSC 144466 . 146830) (\DRAWLINE.PSC
146832 . 149572) (\DRAWPOINT.PSC 149574 . 150150) (\DRAWPOLYGON.PSC 150152 . 153281) (
\DSPBOTTOMMARGIN.PSC 153283 . 153970) (\DSPCLIPPINGREGION.PSC 153972 . 155347) (\DSPCOLOR.PSC 155349
. 156280) (\DSPFONT.PSC 156282 . 159801) (\DSPLEFTMARGIN.PSC 159803 . 160489) (\DSPLINEFEED.PSC
160491 . 161081) (\DSPPUSHSTATE.PSC 161083 . 162543) (\DSPPOPSTATE.PSC 162545 . 166030) (\DSPRESET.PSC
166032 . 166697) (\DSPRIGHTMARGIN.PSC 166699 . 167388) (\DSPROTATE.PSC 167390 . 168389) (
\DSPSCALE.PSC 168391 . 169343) (\DSPSCALE2.PSC 169345 . 170185) (\DSPSPACEFACTOR.PSC 170187 . 171108)
(\DSPTOPMARGIN.PSC 171110 . 171681) (\DSPTRANSLATE.PSC 171683 . 173714) (\DSPXPOSITION.PSC 173716 .
174280) (\DSPYPOSITION.PSC 174282 . 174873) (\FILLCIRCLE.PSC 174875 . 177100) (\FILLPOLYGON.PSC 177102
. 180339) (\FIXLINELENGTH.PSC 180341 . 181660) (\MOVETO.PSC 181662 . 182432) (\NEWPAGE.PSC 182434 .
182629)) (182687 204710 (\POSTSCRIPT.CHANGECHARSET 182697 . 183434) (\POSTSCRIPT.OUTCHARFN 183436 .
195564) (\POSTSCRIPT.PRINTSLUG 195566 . 197290) (\POSTSCRIPT.SPECIALOUTCHARFN 197292 . 199643) (
\UPDATE.PSC 199645 . 200891) (\POSTSCRIPT.ACCENTFN 200893 . 201835) (\POSTSCRIPT.ACCENTPAIR 201837 .
204708)) (204808 206453 (\PSC.SPACEDISP 204818 . 205097) (\PSC.SPACEWID 205099 . 205718) (\PSC.SYMBOLS
205720 . 206451)) (206562 209553 (\POSTSCRIPT.NSHASH 206572 . 209551)) (254327 255033 (POSTSCRIPTSEND
254337 . 255031)))))
(FILEMAP (NIL (22458 32954 (POSTSCRIPT.INIT 22468 . 29560) (POSTSCRIPT.PUTRGBCOLOR 29562 . 30584) (
\PSC.COLOR.TO.RGB 30586 . 32952)) (33940 69653 (PSCFONT.READFONT 33950 . 35858) (PSCFONT.SPELLFILE
35860 . 36557) (PSCFONT.COERCEFILE 36559 . 38131) (PSCFONTFROMCACHE.SPELLFILE 38133 . 39118) (
PSCFONTFROMCACHE.COERCEFILE 39120 . 40772) (PSCFONT.WRITEFONT 40774 . 41789) (READ-AFM-FILE 41791 .
47662) (CONVERT-AFM-FILES 47664 . 48876) (POSTSCRIPT.GETFONTID 48878 . 50273) (POSTSCRIPT.FONTCREATE
50275 . 62428) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62430 . 64827) (POSTSCRIPT.FONTSAVAILABLE 64829
. 68595) (POSTSCRIPT.FONTEXISTS? 68597 . 69651)) (70208 79493 (OPENPOSTSCRIPTSTREAM 70218 . 79159) (
CLOSEPOSTSCRIPTSTREAM 79161 . 79491)) (79538 85592 (POSTSCRIPT.HARDCOPYW 79548 . 82655) (
POSTSCRIPT.TEDIT 82657 . 83141) (POSTSCRIPT.TEXT 83143 . 83434) (POSTSCRIPTFILEP 83436 . 84543) (
MAKEEPSFILE 84545 . 85590)) (85593 129167 (POSTSCRIPT.BITMAPSCALE 85603 . 88059) (
POSTSCRIPT.CLOSESTRING 88061 . 88614) (POSTSCRIPT.ENDPAGE 88616 . 89507) (POSTSCRIPT.OUTSTR 89509 .
90726) (POSTSCRIPT.PUTBITMAPBYTES 90728 . 99199) (POSTSCRIPT.PUTCOMMAND 99201 . 100190) (
POSTSCRIPT.SET-FAKE-LANDSCAPE 100192 . 104712) (POSTSCRIPT.SHOWACCUM 104714 . 106869) (
POSTSCRIPT.STARTPAGE 106871 . 109403) (\POSTSCRIPTTAB 109405 . 110202) (\PS.BOUTFIXP 110204 . 111484)
(\PS.SCALEHACK 111486 . 114129) (\PS.SCALEREGION 114131 . 114691) (\SCALEDBITBLT.PSC 114693 . 119003)
(\SETPOS.PSC 119005 . 119486) (\SETXFORM.PSC 119488 . 122072) (\STRINGWIDTH.PSC 122074 . 122547) (
\SWITCHFONTS.PSC 122549 . 128041) (\TERPRI.PSC 128043 . 129165)) (129202 183400 (\BITBLT.PSC 129212 .
129764) (\BLTSHADE.PSC 129766 . 134427) (\CHARWIDTH.PSC 134429 . 134936) (\CREATECHARSET.PSC 134938 .
136636) (\DRAWARC.PSC 136638 . 139016) (\DRAWCIRCLE.PSC 139018 . 141269) (\DRAWCURVE.PSC 141271 .
145115) (\DRAWELLIPSE.PSC 145117 . 147481) (\DRAWLINE.PSC 147483 . 150223) (\DRAWPOINT.PSC 150225 .
150801) (\DRAWPOLYGON.PSC 150803 . 153932) (\DSPBOTTOMMARGIN.PSC 153934 . 154621) (
\DSPCLIPPINGREGION.PSC 154623 . 155998) (\DSPCOLOR.PSC 156000 . 156931) (\DSPFONT.PSC 156933 . 160570)
(\DSPLEFTMARGIN.PSC 160572 . 161258) (\DSPLINEFEED.PSC 161260 . 161850) (\DSPPUSHSTATE.PSC 161852 .
163312) (\DSPPOPSTATE.PSC 163314 . 166799) (\DSPRESET.PSC 166801 . 167466) (\DSPRIGHTMARGIN.PSC 167468
. 168157) (\DSPROTATE.PSC 168159 . 169158) (\DSPSCALE.PSC 169160 . 170112) (\DSPSCALE2.PSC 170114 .
170954) (\DSPSPACEFACTOR.PSC 170956 . 171877) (\DSPTOPMARGIN.PSC 171879 . 172450) (\DSPTRANSLATE.PSC
172452 . 174483) (\DSPXPOSITION.PSC 174485 . 175049) (\DSPYPOSITION.PSC 175051 . 175642) (
\FILLCIRCLE.PSC 175644 . 177869) (\FILLPOLYGON.PSC 177871 . 181108) (\FIXLINELENGTH.PSC 181110 .
182429) (\MOVETO.PSC 182431 . 183201) (\NEWPAGE.PSC 183203 . 183398)) (183456 205479 (
\POSTSCRIPT.CHANGECHARSET 183466 . 184203) (\POSTSCRIPT.OUTCHARFN 184205 . 196333) (
\POSTSCRIPT.PRINTSLUG 196335 . 198059) (\POSTSCRIPT.SPECIALOUTCHARFN 198061 . 200412) (\UPDATE.PSC
200414 . 201660) (\POSTSCRIPT.ACCENTFN 201662 . 202604) (\POSTSCRIPT.ACCENTPAIR 202606 . 205477)) (
205577 207222 (\PSC.SPACEDISP 205587 . 205866) (\PSC.SPACEWID 205868 . 206487) (\PSC.SYMBOLS 206489 .
207220)) (207331 210322 (\POSTSCRIPT.NSHASH 207341 . 210320)) (255096 255802 (POSTSCRIPTSEND 255106 .
255800)))))
STOP

BIN
library/POSTSCRIPTSTREAM.LCOM
View File

Binary file not shown.

243
library/PRESS
View File

@@ -1,21 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Apr-2023 07:15:37" {DSK}<home>larry>il>medley>library>PRESS.;2 452576Q
(FILECREATED "14-Jul-2025 22:58:49" {WMEDLEY}<library>PRESS.;4 453237Q
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (VARS PRESSCOMS)
:CHANGES-TO (FNS \DSPFONT.PRESS)
:PREVIOUS-DATE " 5-Feb-2021 22:18:06" {DSK}<home>larry>il>medley>library>PRESS.;1)
:PREVIOUS-DATE " 5-Jul-2025 18:52:40" {WMEDLEY}<library>PRESS.;3)
(* ; "
Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT PRESSCOMS)
(RPAQQ PRESSCOMS
(RPAQQ PRESSCOMS
[
(* ;;; "PRESS printing support module")
@@ -1321,46 +1317,44 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(freplace PRClippingRegion of PRDATA with REGION))])])
(\DSPFONT.PRESS
[LAMBDA (PRSTREAM FONT) (* ; "Edited 12-Jun-90 10:40 by mitani")
[LAMBDA (PRSTREAM FONT) (* ; "Edited 14-Jul-2025 22:58 by rmk")
(* ; "Edited 5-Jul-2025 18:49 by rmk")
(* * The DSPFONT method for PRESS-type image streams --
 change the stream's current font to FONT)
(* ;;; "The DSPFONT method for PRESS-type image streams -- change the stream's current font to FONT")
(* * The DSPFONT method for PRESS-type image streams --
 change the stream's current font to FONT)
(PROG ((PRDATA (ffetch (STREAM IMAGEDATA) of PRSTREAM))
CSINFO OLDFONT FDENTRY)
(SETQ OLDFONT (ffetch PRFONT of PRDATA))
(COND
([OR (NULL FONT)
(EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT 'PRESS T)
(EQ OLDFONT (SETQ FONT (OR (FONTCREATE FONT NIL NIL NIL 'PRESS T)
(FONTCOPY OLDFONT FONT]
(* If no new font was specified, or it's the same font, don't bother with it.)
(* ;
 "If no new font was specified, or it's the same font, don't bother with it.")
(RETURN OLDFONT)))
(SHOW.PRESS PRSTREAM)
(SETQ CSINFO (\GETCHARSETINFO 0 FONT T)) (* Since PRESS only uses charset 0
 for now....)
(SETQ CSINFO (\GETCHARSETINFO 0 FONT T)) (* ;
 "Since PRESS only uses charset 0 for now....")
(SETQ FDENTRY (\DEFINEFONT.PRESS PRSTREAM FONT))
(COND
((NEQ (ffetch FONTSET# of FDENTRY)
(ffetch FONTSET# of (ffetch PRCURRFDE of PRDATA)))
(* Swtich font sets)
(* ; "Swtich font sets")
(\ENTITYEND.PRESS PRSTREAM)
(\ENTITYSTART.PRESS PRSTREAM)))
(freplace PRCURRFDE of PRDATA with FDENTRY)
(freplace PRFONT of PRDATA with FONT)
(\BOUT (ffetch ELSTREAM of PRDATA)
(LOGOR FontCode (ffetch FONT# of FDENTRY)))
(freplace PRWIDTHSCACHE of PRDATA with (fetch (CHARSETINFO WIDTHS)
OF CSINFO))
(freplace PRWIDTHSCACHE of PRDATA with (fetch (CHARSETINFO WIDTHS) OF CSINFO))
[\SETSPACE.PRESS PRSTREAM (FIXR (TIMES (ffetch PRSPACEFACTOR of PRDATA)
(\FGETWIDTH (ffetch PRWIDTHSCACHE
of PRDATA)
(CHARCODE SPACE]
[freplace PRLINEFEED of PRDATA with (IDIFFERENCE (CONSTANT (IMINUS
MicasPerPoint
))
(FONTPROP FONT 'HEIGHT]
(\FGETWIDTH (ffetch PRWIDTHSCACHE of PRDATA)
(CHARCODE SPACE]
[freplace PRLINEFEED of PRDATA with (IDIFFERENCE (CONSTANT (IMINUS MicasPerPoint))
(FONTPROP FONT 'HEIGHT]
(\FIXLINELENGTH.PRESS PRSTREAM)
(RETURN OLDFONT])
@@ -2417,51 +2411,55 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop each
 page.)
PRHEADINGFONT (* Font to print the heading in)
PRXPOS (* Current X position)
PRYPOS (* Current Y position)
PRFONT (* Current font)
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
(* Page left margin)
(PRBOTTOM WORD) (* Page bottom margin)
(PRRIGHT WORD) (* Page right margin)
(PRTOP WORD) (* Page top margin)
(PRPAGENUM WORD) (* Current Page number)
(DATATYPE PRESSDATA (PRHEADING (* ;
 "The string to be printed atop each page.")
PRHEADINGFONT (* ; "Font to print the heading in")
PRXPOS (* ; "Current X position")
PRYPOS (* ; "Current Y position")
PRFONT (* ; "Current font")
PRCURRFDE PRESSFONTDIR (PRWIDTHSCACHE POINTER
(* ;
 "Widths table for the current logical character set")
)
PRCOLOR PRLINEFEED PRPAGESTATE PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME
(PRLEFT WORD) (* ; "Page left margin")
(PRBOTTOM WORD) (* ; "Page bottom margin")
(PRRIGHT WORD) (* ; "Page right margin")
(PRTOP WORD) (* ; "Page top margin")
(PRPAGENUM WORD) (* ; "Current Page number")
(PRNEXTFONT# BYTE)
(PRMAXFONTSET BYTE)
(PRPARTSTART INTEGER)
(DLSTARTBYTE INTEGER)
(ELSTARTBYTE INTEGER)
(STARTCHARBYTE INTEGER)
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with
 vector fonts, are we moving to the
 right?)
(VECMOVINGRIGHT FLAG) (* ;
 "If we're drawing a curve with vector fonts, are we moving to the right?")
(VECWASDISPLAYING FLAG)
(* Used during curve/line clipping to remember whether we were on-screen or not,
 so we know when to force a SETXY.)
(* ;; "Used during curve/line clipping to remember whether we were on-screen or not, so we know when to force a SETXY.")
VECSEGCHARS (* Cache for vector characters while
 we're moving to the left.)
VECCURX (* Current X position within vector
 code, in Dover spots)
VECCURY (* Current Y position with vector
 code, in Dover spots)
VECSEGCHARS (* ;
 "Cache for vector characters while we're moving to the left.")
VECCURX (* ;
 "Current X position within vector code, in Dover spots")
VECCURY (* ;
 "Current Y position with vector code, in Dover spots")
PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
(* Says whether we have been printing
 characters inside the clipping region)
(* ;
 "Says whether we have been printing characters inside the clipping region")
PRClippingRegion
(* The edges of the paper, as far as PRESS is concerned.
 Used to protect SPRUCE users who get killed when the image goes off-paper)
(* ;; "The edges of the paper, as far as PRESS is concerned. Used to protect SPRUCE users who get killed when the image goes off-paper")
)
PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 (* We assume that the origin is
 translated to the bottom-left of the
 page region)
PRLOGICALFONT (* ; "Current logical font")
PRLOGICALCHARSET (* ;
 "Current logical character set, whose info is cached. NIL if cache is invalid")
(PRTRANSLATIONCACHE POINTER (* ;
 "Translation table for the current logical character set")
))
PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 (* ;
 "We assume that the origin is translated to the bottom-left of the page region")
PRClippingRegion _ (create REGION
LEFT _ SPRUCEPAPERLEFTMICAS
BOTTOM _ SPRUCEPAPERBOTTOMMICAS
@@ -2492,7 +2490,8 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(/DECLAREDATATYPE 'PRESSDATA
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP
FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER)
FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER
)
'((PRESSDATA 0 POINTER)
(PRESSDATA 2 POINTER)
(PRESSDATA 4 POINTER)
@@ -2527,14 +2526,18 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(PRESSDATA 50 POINTER)
(PRESSDATA 52 POINTER)
(PRESSDATA 52 (FLAGBITS . 0))
(PRESSDATA 54 POINTER))
'56)
(PRESSDATA 54 POINTER)
(PRESSDATA 56 POINTER)
(PRESSDATA 58 POINTER)
(PRESSDATA 60 POINTER))
'62)
)
(/DECLAREDATATYPE 'PRESSDATA
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP
FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER)
FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER
)
'((PRESSDATA 0 POINTER)
(PRESSDATA 2 POINTER)
(PRESSDATA 4 POINTER)
@@ -2569,8 +2572,11 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(PRESSDATA 50 POINTER)
(PRESSDATA 52 POINTER)
(PRESSDATA 52 (FLAGBITS . 0))
(PRESSDATA 54 POINTER))
'56)
(PRESSDATA 54 POINTER)
(PRESSDATA 56 POINTER)
(PRESSDATA 58 POINTER)
(PRESSDATA 60 POINTER))
'62)
(RPAQ? DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 24765))
@@ -2597,7 +2603,7 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(RPAQQ PRESSOPS
(RPAQQ PRESSOPS
(SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode
ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode
SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode
@@ -2722,60 +2728,59 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(CREATECHARSET \CREATECHARSET.PRESS)
(FONTSAVAILABLE \SEARCHPRESSFONTS)))
(ADDTOVAR PRINTERTYPES ((PRESS SPRUCE PENGUIN DOVER)
(CANPRINT (PRESS))
(STATUS PUP.PRINTER.STATUS)
(PROPERTIES PUP.PRINTER.PROPERTIES)
(SEND EFTP)
(BITMAPSCALE NIL)
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
((FULLPRESS RAVEN)
(ADDTOVAR PRINTERTYPES
((PRESS SPRUCE PENGUIN DOVER)
(CANPRINT (PRESS))
(STATUS PUP.PRINTER.STATUS)
(PROPERTIES PUP.PRINTER.PROPERTIES)
(SEND EFTP)
(BITMAPSCALE NIL)
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
((FULLPRESS RAVEN)
(* ;
 "same as PRESS but can scale bitmaps")
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(ADDTOVAR PRINTFILETYPES [PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT
(LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
NIL 'PRESS)
(CLOSEF? FILE)
PFILE])
(PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q
3711Q 3745Q))
(ADDTOVAR PRINTFILETYPES
[PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
NIL 'PRESS)
(CLOSEF? FILE)
PFILE])
(DECLARE%: DONTCOPY
(FILEMAP (NIL (15752Q 72731Q (\SEARCHPRESSFONTS 15764Q . 17721Q) (\GETPRESSFONTNAMES 17723Q . 26561Q)
(\PRESSFAMILYCODELST 26563Q . 30505Q) (\DECODEPRESSFACEBYTE 30507Q . 33276Q) (\CREATEPRESSFONT 33300Q
. 35545Q) (\CREATECHARSET.PRESS 35547Q . 72727Q)) (73366Q 127171Q (PRESSBITMAP 73400Q . 103002Q) (
FULLPRESSBITMAP 103004Q . 111016Q) (SHOWREGION 111020Q . 112362Q) (SHOWPRESSBITMAPREGION 112364Q .
113026Q) (PRESSWINDOW 113030Q . 117167Q) (\WRITEPRESSBITMAP 117171Q . 127167Q)) (127267Q 157142Q (
\BCPLSOUT.PRESS 127301Q . 130256Q) (\PAGEPAD.PRESS 130260Q . 131515Q) (\ENTITYEND.PRESS 131517Q .
137013Q) (\PARTEND.PRESS 137015Q . 141402Q) (\ENTITYSTART.PRESS 141404Q . 145015Q) (SETX.PRESS 145017Q
. 146652Q) (SETXY.PRESS 146654Q . 151656Q) (SETY.PRESS 151660Q . 153260Q) (SHOW.PRESS 153262Q .
157140Q)) (157224Q 274041Q (OPENPRSTREAM 157236Q . 164365Q) (\BITBLT.PRESS 164367Q . 167001Q) (
\BLTSHADE.PRESS 167003Q . 170436Q) (\SCALEDBITBLT.PRESS 170440Q . 173064Q) (\BITMAPSIZE.PRESS 173066Q
. 174026Q) (\CHARWIDTH.PRESS 174030Q . 176077Q) (\CLOSEF.PRESS 176101Q . 206070Q) (\DRAWLINE.PRESS
206072Q . 207430Q) (\ENDPAGE.PRESS 207432Q . 210702Q) (NEWLINE.PRESS 210704Q . 212315Q) (NEWPAGE.PRESS
212317Q . 212611Q) (SETUPFONTS.PRESS 212613Q . 216344Q) (\DEFINEFONT.PRESS 216346Q . 220470Q) (
\DSPBOTTOMMARGIN.PRESS 220472Q . 221266Q) (\DSPCLIPPINGREGION.PRESS 221270Q . 222662Q) (\DSPFONT.PRESS
222664Q . 227656Q) (\DSPLEFTMARGIN.PRESS 227660Q . 230540Q) (\DSPLINEFEED.PRESS 230542Q . 232052Q) (
\DSPRIGHTMARGIN.PRESS 232054Q . 232737Q) (\DSPSPACEFACTOR.PRESS 232741Q . 234345Q) (
\DSPTOPMARGIN.PRESS 234347Q . 235132Q) (\DSPXPOSITION.PRESS 235134Q . 235652Q) (\DSPYPOSITION.PRESS
235654Q . 236372Q) (\FIXLINELENGTH.PRESS 236374Q . 240471Q) (\OUTCHARFN.PRESS 240473Q . 247527Q) (
\SETSPACE.PRESS 247531Q . 251025Q) (\STARTPAGE.PRESS 251027Q . 255370Q) (\STRINGWIDTH.PRESS 255372Q .
270750Q) (SHOWRECTANGLE.PRESS 270752Q . 271473Q) (\PRESS.CONVERT.NSCHARACTER 271475Q . 274037Q)) (
274101Q 405143Q (\ENDVECRUN 274113Q . 303731Q) (\VECENCODE 303733Q . 304762Q) (\VECPUT 304764Q .
314412Q) (\VECSKIP 314414Q . 315147Q) (\VECFONTINIT 315151Q . 322274Q) (\DRAWCIRCLE.PRESS 322276Q .
324601Q) (\DRAWARC.PRESS 324603Q . 325374Q) (\DRAWCURVE.PRESS 325376Q . 333334Q) (
\DRAWCURVE.PRESS.LINE 333336Q . 342203Q) (\DRAWELLIPSE.PRESS 342205Q . 345764Q) (\GETBRUSHFONT.PRESS
345766Q . 347670Q) (\PRESSCURVE2 347672Q . 405141Q)) (410775Q 415621Q (\PRESSINIT 411007Q . 415617Q))
(443570Q 446657Q (MAKEPRESS 443602Q . 444106Q) (PRESSFILEP 444110Q . 445665Q) (PRESS.BITMAPSCALE
445667Q . 446655Q)))))
(FILEMAP (NIL (15566Q 72545Q (\SEARCHPRESSFONTS 15600Q . 17535Q) (\GETPRESSFONTNAMES 17537Q . 26375Q)
(\PRESSFAMILYCODELST 26377Q . 30321Q) (\DECODEPRESSFACEBYTE 30323Q . 33112Q) (\CREATEPRESSFONT 33114Q
. 35361Q) (\CREATECHARSET.PRESS 35363Q . 72543Q)) (73202Q 127005Q (PRESSBITMAP 73214Q . 102616Q) (
FULLPRESSBITMAP 102620Q . 110632Q) (SHOWREGION 110634Q . 112176Q) (SHOWPRESSBITMAPREGION 112200Q .
112642Q) (PRESSWINDOW 112644Q . 117003Q) (\WRITEPRESSBITMAP 117005Q . 127003Q)) (127103Q 156756Q (
\BCPLSOUT.PRESS 127115Q . 130072Q) (\PAGEPAD.PRESS 130074Q . 131331Q) (\ENTITYEND.PRESS 131333Q .
136627Q) (\PARTEND.PRESS 136631Q . 141216Q) (\ENTITYSTART.PRESS 141220Q . 144631Q) (SETX.PRESS 144633Q
. 146466Q) (SETXY.PRESS 146470Q . 151472Q) (SETY.PRESS 151474Q . 153074Q) (SHOW.PRESS 153076Q .
156754Q)) (157040Q 273644Q (OPENPRSTREAM 157052Q . 164201Q) (\BITBLT.PRESS 164203Q . 166615Q) (
\BLTSHADE.PRESS 166617Q . 170252Q) (\SCALEDBITBLT.PRESS 170254Q . 172700Q) (\BITMAPSIZE.PRESS 172702Q
. 173642Q) (\CHARWIDTH.PRESS 173644Q . 175713Q) (\CLOSEF.PRESS 175715Q . 205704Q) (\DRAWLINE.PRESS
205706Q . 207244Q) (\ENDPAGE.PRESS 207246Q . 210516Q) (NEWLINE.PRESS 210520Q . 212131Q) (NEWPAGE.PRESS
212133Q . 212425Q) (SETUPFONTS.PRESS 212427Q . 216160Q) (\DEFINEFONT.PRESS 216162Q . 220304Q) (
\DSPBOTTOMMARGIN.PRESS 220306Q . 221102Q) (\DSPCLIPPINGREGION.PRESS 221104Q . 222476Q) (\DSPFONT.PRESS
222500Q . 227461Q) (\DSPLEFTMARGIN.PRESS 227463Q . 230343Q) (\DSPLINEFEED.PRESS 230345Q . 231655Q) (
\DSPRIGHTMARGIN.PRESS 231657Q . 232542Q) (\DSPSPACEFACTOR.PRESS 232544Q . 234150Q) (
\DSPTOPMARGIN.PRESS 234152Q . 234735Q) (\DSPXPOSITION.PRESS 234737Q . 235455Q) (\DSPYPOSITION.PRESS
235457Q . 236175Q) (\FIXLINELENGTH.PRESS 236177Q . 240274Q) (\OUTCHARFN.PRESS 240276Q . 247332Q) (
\SETSPACE.PRESS 247334Q . 250630Q) (\STARTPAGE.PRESS 250632Q . 255173Q) (\STRINGWIDTH.PRESS 255175Q .
270553Q) (SHOWRECTANGLE.PRESS 270555Q . 271276Q) (\PRESS.CONVERT.NSCHARACTER 271300Q . 273642Q)) (
273704Q 404746Q (\ENDVECRUN 273716Q . 303534Q) (\VECENCODE 303536Q . 304565Q) (\VECPUT 304567Q .
314215Q) (\VECSKIP 314217Q . 314752Q) (\VECFONTINIT 314754Q . 322077Q) (\DRAWCIRCLE.PRESS 322101Q .
324404Q) (\DRAWARC.PRESS 324406Q . 325177Q) (\DRAWCURVE.PRESS 325201Q . 333137Q) (
\DRAWCURVE.PRESS.LINE 333141Q . 342006Q) (\DRAWELLIPSE.PRESS 342010Q . 345567Q) (\GETBRUSHFONT.PRESS
345571Q . 347473Q) (\PRESSCURVE2 347475Q . 404744Q)) (410600Q 415424Q (\PRESSINIT 410612Q . 415422Q))
(444757Q 450046Q (MAKEPRESS 444771Q . 445275Q) (PRESSFILEP 445277Q . 447054Q) (PRESS.BITMAPSCALE
447056Q . 450044Q)))))
STOP

BIN
library/PRESS.LCOM
View File

Binary file not shown.

324
library/tedit/TEDIT-LOOKS
View File

@@ -1,13 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jul-2025 19:39:57" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;426 158882
(FILECREATED " 1-Aug-2025 13:43:51" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-LOOKS.;443 160489
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT-LOOKSCOMS)
(FNS \TEDIT.GET.INSERT.CHARLOOKS TEDIT.CARETLOOKS \TEDIT.CARETPIECE)
:CHANGES-TO (RECORDS CHARLOOKS)
(FNS \TEDIT.EQCLOOKS \TEDIT.TRANSLATE.ASCIICHARS \TEDIT.UNIQUIFY.ALL
\TEDIT.FLUSH.UNUSED.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS
\TEDIT.CHANGE.CHARLOOKS)
:PREVIOUS-DATE "24-Apr-2025 23:47:54" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;425)
:PREVIOUS-DATE "29-Jul-2025 09:30:33" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;435)
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
@@ -29,21 +32,23 @@
(* ;;
 "Added by yabu.fx, for SUNLOADUP without DWIM. Not sure any of these are needed/used.")
(FNS \TEDIT.CREATE.DEFAULT.FMTSPEC \TEDIT.CREATE.FACE.MENU \TEDIT.CREATE.SIZE.MENU))
[INITVARS (TEDIT.DEFAULT.FOLIO)
(TEDIT.KNOWN.FONTS '((Classic 'CLASSIC)
(FNS \TEDIT.CREATE.FACE.MENU \TEDIT.CREATE.SIZE.MENU))
(INITVARS (TEDIT.DEFAULT.FOLIO)
[TEDIT.KNOWN.FONTS '((Classic 'CLASSIC)
(Modern 'MODERN)
(Terminal 'TERMINAL)
(Titan 'TITAN)
(Gacha 'GACHA)
(Helvetica 'HELVETICA)
(Times% Roman 'TIMESROMAN]
(VARS TEDIT.CHARLOOKS.FEATURES (TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC))
(TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU))
(TEDIT.DEFAULT.TAB 36)
(TEDIT.DEFAULT.PARALOOKS `(QUAD LEFT LEFTMARGIN 0 1STLEFTMARGIN 0 RIGHTMARGIN 0
PARALEADING 0 POSTPARALEADING 0 DEFAULTTAB 36))
(TEDIT.DEFAULT.FMTSPEC TEDIT.DEFAULT.PARALOOKS))
(VARS TEDIT.CHARLOOKS.FEATURES (TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU))
(TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU)))
(FNS \TEDIT.CHARLOOKS.FEATURE.CHECK)
(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU
TEDIT.DEFAULT.FMTSPEC)
(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU)
(ADDVARS (FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT)
(TEDIT.ICON.FONT MENUFONT)))
(COMS (* ; "Character looks functions")
@@ -130,8 +135,8 @@
 "Spaces are treated as nonbreaking spaces")
CLSTYLE (* ;
 "The style to be used in marking these characters; overridden by the other fields")
CLUSERINFO (* ;
 "Any information that an outsider wants to include")
CLPROPS (* ;
 "Was CLUSERINFO:Any information that an outsider wants to include")
CLLEADER (* ;
 "For creating dotted and other kinds of leader")
CLRULES
@@ -148,8 +153,9 @@
CLOFFSET _ 0 CLCOLOR _ 'BLACK (INIT (DEFPRINT 'CHARLOOKS (FUNCTION
\TEDIT.CHARLOOKS.DEFPRINT
)))
(ACCESSFNS (CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM)
(replace (CHARLOOKS CLFONTUNPARSE) of DATUM with NEWVALUE))))
(ASSOCRECORD CLPROPS (CLUSERINFO CLCHARENCODING))
[ACCESSFNS ((CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM)
(replace (CHARLOOKS CLFONTUNPARSE) of DATUM with NEWVALUE])
(DATATYPE PARALOOKS (
(* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
@@ -452,21 +458,6 @@
(DEFINEQ
(\TEDIT.CREATE.DEFAULT.FMTSPEC
[LAMBDA NIL (* ; "Edited 8-Feb-2025 22:05 by rmk")
(* ; "Edited 4-Aug-2024 17:13 by rmk")
(* ; "Edited 28-Jul-2024 12:57 by rmk")
(* ; "Edited 24-Aug-2023 23:31 by rmk")
(create PARALOOKS
QUAD _ 'LEFT
1STLEFTMAR _ 0
LEFTMAR _ 0
RIGHTMAR _ 0
LEADBEFORE _ 0
LEADAFTER _ 0
LINELEAD _ 0
FMTDEFAULTTAB _ DEFAULTTAB])
(\TEDIT.CREATE.FACE.MENU
[LAMBDA NIL
(create MENU
@@ -494,14 +485,19 @@
(Helvetica 'HELVETICA)
(Times% Roman 'TIMESROMAN)))
(RPAQ? TEDIT.DEFAULT.TAB 36)
(RPAQ? TEDIT.DEFAULT.PARALOOKS `(QUAD LEFT LEFTMARGIN 0 1STLEFTMARGIN 0 RIGHTMARGIN 0 PARALEADING 0
POSTPARALEADING 0 DEFAULTTAB 36))
(RPAQ? TEDIT.DEFAULT.FMTSPEC TEDIT.DEFAULT.PARALOOKS)
(RPAQQ TEDIT.CHARLOOKS.FEATURES
(DEVICE FAMILY SIZE FACE ITALIC WEIGHT SLOPE BOLD EXPANSION FONT INVERTED INVISIBLE OFFSET
OFFSETINCREMENT OVERLINE PROTECTED SELECTPOINT SELAFTER SELBEFORE SIZEINCREMENT
SMALLCAPS STRIKEOUT STYLE SUBSCRIPT SUPERSCRIPT UNBREAKABLE UNDERLINE USERINFO
OFFSETTYPE COLOR))
(RPAQ TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC))
(RPAQ TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU))
(RPAQ TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU))
@@ -535,8 +531,7 @@
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU
TEDIT.DEFAULT.FMTSPEC)
(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU)
)
(ADDTOVAR FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT)
@@ -576,7 +571,9 @@
CLNAME _ (FONTUNPARSE FONT])
(\TEDIT.EQCLOOKS
[LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 15-Apr-2025 16:45 by rmk")
[LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 1-Aug-2025 11:43 by rmk")
(* ; "Edited 21-Jul-2025 23:43 by rmk")
(* ; "Edited 15-Apr-2025 16:45 by rmk")
(* ; "Edited 2-Jan-2025 21:01 by rmk")
(* ; "Edited 18-Oct-2024 22:29 by rmk")
(* ; "Edited 11-Aug-2024 20:41 by rmk")
@@ -622,11 +619,12 @@
(FGETCLOOKS CLOOK2 CLSTYLE))
(EQ (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
(FGETCLOOKS CLOOK2 CLUNBREAKABLE))
(EQUAL (FGETCLOOKS CLOOK1 CLUSERINFO)
(FGETCLOOKS CLOOK2 CLUSERINFO])
(EQUAL (FGETCLOOKS CLOOK1 CLPROPS)
(FGETCLOOKS CLOOK2 CLPROPS])
(\TEDIT.SAMECLOOKS
[LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 15-Apr-2025 16:42 by rmk")
[LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 21-Jul-2025 23:45 by rmk")
(* ; "Edited 15-Apr-2025 16:42 by rmk")
(* ; "Edited 2-Jan-2025 20:31 by rmk")
(* ; "Edited 31-Dec-2024 23:59 by rmk")
(* ; "Edited 31-Jul-2024 00:06 by rmk")
@@ -662,10 +660,12 @@
(FGETCLOOKS CLOOK2 CLSTRIKE)))
(UNDERLINE (EQ (FGETCLOOKS CLOOK1 CLULINE)
(FGETCLOOKS CLOOK2 CLULINE)))
(UNBREAKABLE (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
(FGETCLOOKS CLOOK2 CLUNBREAKABLE))
(COLOR (FGETCLOOKS CLOOK1 CLCOLOR)
(FGETCLOOKS CLOOK2 CLCOLOR))
(UNBREAKABLE (EQ (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
(FGETCLOOKS CLOOK2 CLUNBREAKABLE)))
(COLOR (EQUAL (FGETCLOOKS CLOOK1 CLCOLOR)
(FGETCLOOKS CLOOK2 CLCOLOR)))
(CHARENCODING (EQ (FGETCLOOKS CLOOK1 CLCHARENCODING)
(FGETCLOOKS CLOOK2 CLCHARENCODING CLCOLOR)))
(FACE (EQUAL (FONTPROP FONT1 'FACE)
(FONTPROP FONT2 'FACE)))
(ERROR (CONCAT F
@@ -932,7 +932,9 @@
(DEFINEQ
(\TEDIT.TRANSLATE.ASCIICHARS
[LAMBDA (TSTREAM NOASCIIFONTS) (* ; "Edited 24-Apr-2025 23:47 by rmk")
[LAMBDA (TSTREAM NOASCIIFONTS) (* ; "Edited 31-Jul-2025 09:56 by rmk")
(* ; "Edited 28-Jul-2025 23:35 by rmk")
(* ; "Edited 24-Apr-2025 23:47 by rmk")
(* ; "Edited 30-Mar-2025 22:00 by rmk")
(* ; "Edited 28-Mar-2025 14:24 by rmk")
(* ; "Edited 2-Jan-2025 23:30 by rmk")
@@ -967,7 +969,7 @@
)
(for CHNO CLOOKS TRANS MAPARRAY NEWFONTNAME STRING FAT CLOOKSLIST FAMILY TARRAYLAST
from 1 by (PLEN PC) as PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
eachtime (SETQ CLOOKS (PLOOKS PC))
eachtime (SETQ CLOOKS (PCHARLOOKS PC))
(SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
'FAMILY)) unless (OR (EQ OBJECT.PTYPE (PTYPE PC))
(EQ FAMILY 'CLASSIC))
@@ -984,7 +986,7 @@
(* ;; " Look backward for NEWFONTNAME, since that piece has already been coerced. The idea is to get Cyrillic to continue the previous looks (serif, san-serif)")
(SETQ NEWFONTNAME (FONTPROP (GETCLOOKS (PLOOKS (PREVPIECE PC))
(SETQ NEWFONTNAME (FONTPROP (GETCLOOKS (PCHARLOOKS (PREVPIECE PC))
CLFONT)
'FAMILY))))
(if (OR MAPARRAY NOASCIIFONTS)
@@ -1022,8 +1024,8 @@
(UNFOLD (PLEN PC)
2)
(PLEN PC)))
(FSETPC PC PLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS
NEWFONTNAME))
(FSETPC PC PCHARLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS
NEWFONTNAME))
else
(* ;; "Must be a text font (GACHA, TIMESROMAN, HELVETICA) \ASCIITONS is the translation array, mostly identities. ")
@@ -1047,19 +1049,12 @@
do (\TEDIT.RPLCHARCODE TSTREAM I NEWCODE NEWLOOKS))
(RETURN))) finally
(* ;; "Here we change the default and caret looks. Perhaps this should be done only if NOASCIIFONTS. But there is a risk that Ascii fonts and characters would slip in by future editing. ")
(* ;; "Here we change the caret looks. Perhaps this should be done only if NOASCIIFONTS. But there is a risk that Ascii fonts and characters would slip in by future editing. ")
(CL:WHEN NOASCIIFONTS
(SETQ CLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
(SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
'FAMILY))
(CL:WHEN (AND (NEQ FAMILY 'CLASSIC)
(SETQ TRANS (ASSOC FAMILY
ASCIITONSTRANSLATIONS
)))
(FSETTOBJ TEXTOBJ DEFAULTCHARLOOKS
(\TEDIT.TRANSLATE.ASCII.CHARLOOKS
TEXTOBJ CLOOKS (CADDR TRANS))))
(SETQ CLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS))
(SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
'FAMILY))
@@ -1222,7 +1217,8 @@
(RETURN NEWLOOK])
(\TEDIT.UNIQUIFY.ALL
[LAMBDA (TEXTOBJ) (* ; "Edited 8-Feb-2025 20:24 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Jul-2025 09:17 by rmk")
(* ; "Edited 8-Feb-2025 20:24 by rmk")
(* ; "Edited 16-Mar-2024 10:03 by rmk")
(* ; "Edited 14-Nov-2023 16:20 by rmk")
(* ; "Edited 25-Aug-2023 08:57 by rmk")
@@ -1236,7 +1232,7 @@
(* ;;
 "Assure that the CHARLOOKS and PARALOOKS of every piece are in the cache.")
(change (PLOOKS PC)
(change (PCHARLOOKS PC)
(\TEDIT.UNIQUIFY.CHARLOOKS DATUM TEXTOBJ))
(change (PPARALOOKS PC)
(\TEDIT.UNIQUIFY.PARALOOKS DATUM TEXTOBJ))
@@ -1250,7 +1246,8 @@
(\TEDIT.UNIQUIFY.PARALOOKS DATUM TEXTOBJ])
(\TEDIT.FLUSH.UNUSED.LOOKS
[LAMBDA (TEXTOBJ) (* ; "Edited 19-Feb-2025 11:56 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Jul-2025 09:17 by rmk")
(* ; "Edited 19-Feb-2025 11:56 by rmk")
(* ; "Edited 8-Feb-2025 20:36 by rmk")
(* ; "Edited 16-Mar-2024 10:03 by rmk")
(* ; "Edited 25-Aug-2023 08:03 by rmk")
@@ -1269,7 +1266,7 @@
(* ;; "Run thru the pieces in the document, marking the looks that are really in use.")
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) do (FSETCLOOKS (PLOOKS PC)
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) do (FSETCLOOKS (PCHARLOOKS PC)
CLMARK T)
(FSETPLOOKS (PPARALOOKS PC)
FMTMARK T))
@@ -1323,7 +1320,8 @@
TSTREAM])
(TEDIT.GET.LOOKS
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 17-Mar-2024 00:27 by rmk")
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 31-Jul-2025 09:18 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 14-Dec-2023 21:00 by rmk")
(* ; "Edited 21-Jun-2023 11:10 by rmk")
(* ; "Edited 22-Aug-2022 13:14 by rmk")
@@ -1339,18 +1337,21 @@
then (* ;
 "Empty document, use extant caret looks.")
(FGETTOBJ TEXTOBJ CARETLOOKS)
else (PLOOKS (\TEDIT.CHTOPC
(OR (FIXP CH#ORCHARLOOKS)
(GETSEL (if (type? SELECTION CH#ORCHARLOOKS)
then CH#ORCHARLOOKS
elseif (NULL CH#ORCHARLOOKS)
then (TEXTSEL TEXTOBJ)
else (\ILLEGAL.ARG CH#ORCHARLOOKS))
CH#))
TEXTOBJ])
else (PCHARLOOKS (\TEDIT.CHTOPC
(OR (FIXP CH#ORCHARLOOKS)
(GETSEL (if (type? SELECTION
CH#ORCHARLOOKS)
then CH#ORCHARLOOKS
elseif (NULL CH#ORCHARLOOKS)
then (TEXTSEL TEXTOBJ)
else (\ILLEGAL.ARG
CH#ORCHARLOOKS))
CH#))
TEXTOBJ])
(TEDIT.SUBLOOKS
[LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 22-Apr-2025 20:41 by rmk")
[LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 31-Jul-2025 09:20 by rmk")
(* ; "Edited 22-Apr-2025 20:41 by rmk")
(* ; "Edited 20-Apr-2025 13:26 by rmk")
(* ; "Edited 6-Apr-2025 14:27 by rmk")
(* ; "Edited 5-Apr-2025 13:31 by rmk")
@@ -1377,7 +1378,7 @@
(NEWLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKSLIST NIL TEXTOBJ))
(FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A)))
inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) as CH# from 1 by (PLEN PC)
when (\TEDIT.SAMECLOOKS OLDLOOKS (PLOOKS PC)
when (\TEDIT.SAMECLOOKS OLDLOOKS (PCHARLOOKS PC)
FEATURELIST) do (CL:UNLESS CHANGEMADE
(SETQ CHANGEMADE T)
(SETQ SEL (TEXTSEL TEXTOBJ))
@@ -1388,12 +1389,12 @@
(* ;;
 "Note that we may be creating new looks each time, depending on what is there and what is changed.")
(FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
(\TEDIT.PARSE.CHARLOOKS.LIST
NEWLOOKSLIST
(PLOOKS PC)
TEXTOBJ)
TEXTOBJ))
(FSETPC PC PCHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
(\TEDIT.PARSE.CHARLOOKS.LIST
NEWLOOKSLIST
(PCHARLOOKS PC)
TEXTOBJ)
TEXTOBJ))
(* ;; "This goes piece by piece, each one adding to the collection of dirty lines. We keep track of the first and last changes")
@@ -1406,7 +1407,8 @@
(RETURN CHANGEMADE)))])
(TEDIT.FINDLOOKS
[LAMBDA (TEXTSTREAM OLDLOOKSLIST CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk")
[LAMBDA (TEXTSTREAM OLDLOOKSLIST CH#) (* ; "Edited 31-Jul-2025 09:18 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 3-Dec-2023 00:09 by rmk")
(* ; "Edited 13-Nov-2023 00:26 by rmk")
(* ; "Edited 18-Apr-2023 23:53 by rmk")
@@ -1428,10 +1430,11 @@
[for PC PCLAST FOUNDCH# (OLDLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST NIL
TEXTOBJ))
(FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A)))
inpieces (\TEDIT.CHTOPC CH# TEXTOBJ) when (\TEDIT.SAMECLOOKS OLDLOOKS (PLOOKS PC)
inpieces (\TEDIT.CHTOPC CH# TEXTOBJ) when (\TEDIT.SAMECLOOKS OLDLOOKS (PCHARLOOKS
PC)
FEATURELIST)
do [SETQ PCLAST (find PC1 inpieces (NEXTPIECE PC)
suchthat (NOT (\TEDIT.SAMECLOOKS OLDLOOKS (PLOOKS PC1)
suchthat (NOT (\TEDIT.SAMECLOOKS OLDLOOKS (PCHARLOOKS PC1)
FEATURELIST]
(SETQ PCLAST (CL:IF PCLAST
(PREVPIECE PCLAST)
@@ -1449,7 +1452,8 @@
(DEFINEQ
(\TEDIT.CHANGE.CHARLOOKS
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 22-Apr-2025 20:17 by rmk")
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 31-Jul-2025 09:18 by rmk")
(* ; "Edited 22-Apr-2025 20:17 by rmk")
(* ; "Edited 21-Apr-2025 20:17 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
(* ; "Edited 16-Apr-2025 09:03 by rmk")
@@ -1508,7 +1512,7 @@
(* ;; "Verify that all of the new looks are OK before we change anything")
[SETQ NEWLOOKSLIST (for PC OLDCHARLOOKS inselpieces SELPIECES
collect (SETQ OLDCHARLOOKS (PLOOKS PC))
collect (SETQ OLDCHARLOOKS (PCHARLOOKS PC))
(OR (CL:IF (type? CHARLOOKS NEWLOOKS)
NEWLOOKS
(\TEDIT.CHANGE.CHARLOOKS.NEW NEWLOOKS OLDCHARLOOKS
@@ -1519,12 +1523,12 @@
[for PC UNDOLIST NEWCHARLOOKS (FIRSTCHAR _ (GETSPC SELPIECES SPFIRSTCHAR))
(ORIGFILEPTR _ (\TEDIT.TEXTGETFILEPTR TSTREAM))
OLDCHARLOOKS inselpieces SELPIECES as NEWCHARLOOKS in NEWLOOKSLIST
do (SETQ OLDCHARLOOKS (PLOOKS PC))
do (SETQ OLDCHARLOOKS (PCHARLOOKS PC))
(add FIRSTCHAR (PLEN PC)) (* ;
 "Beginning of next piece--where to stop undoing if new pieces inserted")
(if (\TEDIT.EQCLOOKS OLDCHARLOOKS NEWCHARLOOKS)
then (SETQ OLDCHARLOOKS NIL) (* ; "Undo skips if NIL")
else (FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWCHARLOOKS TEXTOBJ))
else (FSETPC PC PCHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWCHARLOOKS TEXTOBJ))
(CL:UNLESS DIRTY (* ;
 "Resetting DIRTY is expensive, only do it once ")
(FSETTOBJ TEXTOBJ \DIRTY T)
@@ -2033,7 +2037,8 @@
join (LIST PROPNAME PROP])
(\TEDIT.PARSE.PARALOOKS.LIST
[LAMBDA (NEWLOOKS OLDLOOKS TEXTOBJ) (* ; "Edited 19-Feb-2025 11:57 by rmk")
[LAMBDA (NEWLOOKS OLDPARALOOKS) (* ; "Edited 28-Jul-2025 23:19 by rmk")
(* ; "Edited 19-Feb-2025 11:57 by rmk")
(* ; "Edited 8-Feb-2025 22:27 by rmk")
(* ; "Edited 28-Jul-2024 22:14 by rmk")
(* ; "Edited 29-Apr-2024 11:03 by rmk")
@@ -2042,17 +2047,28 @@
(* ; "Edited 5-Sep-2022 15:39 by rmk")
(* ;
 "Edited 3-Jul-93 21:49 by sybalskY:MV:ENVOS")
(* ;
 "Apply a given format spec to the paragraphs which are included in this guy.")
(* ;; "Produce a PARALOOKS based on the priority union of NEWLOOKS over OLDLOOKS. ")
(* ;; "This causes errors for invalid arguments (e.g. nonnumeric). User values should be checked and reported by the caller.ÿ<02><>ÿ")
(if (type? PARALOOKS NEWLOOKS)
then (* ;
 "if we were given a PARALOOKS it replace the PARALOOKS of all pieces affected")
then
(* ;; "A PARALOOKS is complete, OLDPARALOOKS ignored ")
NEWLOOKS
else (LET (NEWFMT 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPEC QUADD NLOOKSAVE 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 DEFTAB TABS) (* ; "create PARALOOKS from the Plist")
else (LET (NEWPARALOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPEC QUADD NLOOKSAVE TYPE
SUBTYPE TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP
KEEPSET HEADINGKEEP HEADINGKEEPSET BASETOBASE BASESET REVISED REVISEDSET
COLUMN COLUMNSET USERINFO USERINFOSET SPECIALX SPECXSET SPECIALY SPECYSET
STYLE STYLESET CHARSTYLES CHARSTYLESSET DEFTAB TABS)
(* ; "create PARALOOKS from the Plist")
(CL:WHEN (LISTP OLDPARALOOKS) (* ; "Defaults from OLDPARALOOKS")
(SETQ NEWLOOKS (APPEND NEWLOOKS OLDPARALOOKS)))
(* ;;
 "For values that can be NIL, we have to keep track of what was there. ALIST would have been better")
(SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN))
(SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN))
(SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN))
@@ -2067,11 +2083,12 @@
(SETQ NEWBEFORE (LISTGET NEWLOOKS 'NEWPAGEBEFORE))
(SETQ NEWAFTERSET (FMEMB 'NEWPAGEAFTER NEWLOOKS))
(SETQ NEWAFTER (LISTGET NEWLOOKS 'NEWPAGEAFTER))
(SETQ HEADINGKEEPSET (FMEMB 'HEADINGKEEP NEWLOOKS))
(SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP))
(* ; "Keep for headings")
(SETQ KEEP (LISTGET NEWLOOKS 'KEEP)) (* ;
 "More general `Keep-together' spec -- undefined as of 5/22/85")
(SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS))
(SETQ KEEP (LISTGET NEWLOOKS 'KEEP)) (* ;
 "More general `Keep-together' spec -- undefined as of 5/22/8ÿ<02>ÿ5")
(SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE))
(SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS))
(SETQ REVISED (LISTGET NEWLOOKS 'REVISED))
@@ -2093,6 +2110,9 @@
(SETQ TABS (LISTGET NEWLOOKS 'TABS))
(SETQ TABSPEC (LISTGET NEWLOOKS 'TABSPEC))
(CL:WHEN TABSPEC
(* ;; "Cÿœœœÿhange from the users list to the real tabspec, a CONS pair of default width and LIST of TAB record instances")
(SETQ DEFTAB (fetch (TABSPEC DEFAULTTAB) of TABSPEC))
(SETQ TABS (fetch (TABSPEC TABS) of TABSPEC)))
[SELECTQ QUADD
@@ -2106,39 +2126,36 @@
((C CENTER)
(SETQQ QUADD CENTERED))
(PROGN (* ;
 "We got an illegal QUAD value. Use LEFT.")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Illegal paragraph quad " QUADD
", replaced with LEFT.")
T)
 "Value should have been checked, error reported")
(SETQ QUADD 'LEFT]
(* ;; "change from the users list to the real tabspec, a CONS pair of default width and LIST of TAB record instances")
(SETQ NEWFMT (create PARALOOKS using (OR OLDLOOKS TEDIT.DEFAULT.FMTSPEC)))
(AND 1STLEFT (FSETPLOOKS NEWFMT 1STLEFTMAR 1STLEFT))
(AND LEFT (FSETPLOOKS NEWFMT LEFTMAR LEFT))
(AND RIGHT (FSETPLOOKS NEWFMT RIGHTMAR RIGHT))
(AND LEADB (FSETPLOOKS NEWFMT LEADBEFORE LEADB))
(AND LEADA (FSETPLOOKS NEWFMT LEADAFTER LEADA))
(AND LLEAD (FSETPLOOKS NEWFMT LINELEAD LLEAD))
(AND TABS (FSETPLOOKS NEWFMT FMTTABS TABS))
(AND DEFTAB (FSETPLOOKS NEWFMT FMTDEFAULTTAB DEFTAB))
(AND QUADD (FSETPLOOKS NEWFMT QUAD QUADD))
(AND TYPESET (FSETPLOOKS NEWFMT FMTPARATYPE TYPE))
(AND SUBTYPESET (FSETPLOOKS NEWFMT FMTPARASUBTYPE SUBTYPE))
(AND NEWBEFORESET (FSETPLOOKS NEWFMT FMTNEWPAGEBEFORE NEWBEFORE))
(AND NEWAFTERSET (FSETPLOOKS NEWFMT FMTNEWPAGEAFTER NEWAFTER))
[AND HEADINGKEEP (FSETPLOOKS NEWFMT FMTHEADINGKEEP (EQ HEADINGKEEP 'ON]
(AND KEEPSET (FSETPLOOKS NEWFMT FMTKEEP KEEP))
(AND BASESET (FSETPLOOKS NEWFMT FMTBASETOBASE BASETOBASE))
(AND REVISEDSET (FSETPLOOKS NEWFMT FMTREVISED REVISED))
(AND COLUMNSET (FSETPLOOKS NEWFMT FMTCOLUMN COLUMN))
(AND SPECXSET (FSETPLOOKS NEWFMT FMTSPECIALX SPECIALX))
(AND SPECYSET (FSETPLOOKS NEWFMT FMTSPECIALY SPECIALY))
(AND STYLESET (FSETPLOOKS NEWFMT FMTSTYLE STYLE))
(AND CHARSTYLESSET (FSETPLOOKS NEWFMT FMTCHARSTYLES CHARSTYLES))
(AND USERINFOSET (FSETPLOOKS NEWFMT FMTUSERINFO USERINFO))
NEWFMT])
(SETQ NEWPARALOOKS (if (type? PARALOOKS OLDPARALOOKS)
then (create PARALOOKS using OLDPARALOOKS)
else (create PARALOOKS)))
(AND 1STLEFT (FSETPLOOKS NEWPARALOOKS 1STLEFTMAR 1STLEFT))
(AND LEFT (FSETPLOOKS NEWPARALOOKS LEFTMAR LEFT))
(AND RIGHT (FSETPLOOKS NEWPARALOOKS RIGHTMAR RIGHT))
(AND LEADB (FSETPLOOKS NEWPARALOOKS LEADBEFORE LEADB))
(AND LEADA (FSETPLOOKS NEWPARALOOKS LEADAFTER LEADA))
(AND LLEAD (FSETPLOOKS NEWPARALOOKS LINELEAD LLEAD))
(AND TABS (FSETPLOOKS NEWPARALOOKS FMTTABS TABS))
(AND DEFTAB (FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB DEFTAB))
(AND QUADD (FSETPLOOKS NEWPARALOOKS QUAD QUADD))
(AND TYPESET (FSETPLOOKS NEWPARALOOKS FMTPARATYPE TYPE))
(AND SUBTYPESET (FSETPLOOKS NEWPARALOOKS FMTPARASUBTYPE SUBTYPE))
(AND NEWBEFORESET (FSETPLOOKS NEWPARALOOKS FMTNEWPAGEBEFORE NEWBEFORE))
(AND NEWAFTERSET (FSETPLOOKS NEWPARALOOKS FMTNEWPAGEAFTER NEWAFTER))
[AND HEADINGKEEPSET (FSETPLOOKS NEWPARALOOKS FMTHEADINGKEEP (EQ HEADINGKEEP
'ON]
(AND KEEPSET (FSETPLOOKS NEWPARALOOKS FMTKEEP KEEP))
(AND BASESET (FSETPLOOKS NEWPARALOOKS FMTBASETOBASE BASETOBASE))
(AND REVISEDSET (FSETPLOOKS NEWPARALOOKS FMTREVISED REVISED))
(AND COLUMNSET (FSETPLOOKS NEWPARALOOKS FMTCOLUMN COLUMN))
(AND SPECXSET (FSETPLOOKS NEWPARALOOKS FMTSPECIALX SPECIALX))
(AND SPECYSET (FSETPLOOKS NEWPARALOOKS FMTSPECIALY SPECIALY))
(AND STYLESET (FSETPLOOKS NEWPARALOOKS FMTSTYLE STYLE))
(AND CHARSTYLESSET (FSETPLOOKS NEWPARALOOKS FMTCHARSTYLES CHARSTYLES))
(AND USERINFOSET (FSETPLOOKS NEWPARALOOKS FMTUSERINFO USERINFO))
NEWPARALOOKS])
(TEDIT.PARALOOKS
[LAMBDA (TSTREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 10-Aug-2024 00:23 by rmk")
@@ -2394,7 +2411,8 @@
(DEFINEQ
(TEDIT.SUBPARALOOKS
[LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 21-Apr-2025 20:15 by rmk")
[LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 28-Jul-2025 22:57 by rmk")
(* ; "Edited 21-Apr-2025 20:15 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
(* ; "Edited 6-Apr-2025 14:31 by rmk")
(* ; "Edited 25-Nov-2024 22:00 by rmk")
@@ -2416,7 +2434,6 @@
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
(for PC CHANGEMADE SEL FIRSTCHANGEDCHNO (NCHARSCHANGED _ 0)
(OLDLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST OLDLOOKSLIST))
(NEWLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST NEWLOOKSLIST))
(FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A)))
inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) as CH# from 1 by (PLEN PC)
when (SAMEPARALOOKS OLDLOOKS (PPARALOOKS PC PPARALOOKS)
@@ -2429,8 +2446,7 @@
(FSETPC PC PPARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS
(\TEDIT.PARSE.PARALOOKS.LIST
NEWLOOKSLIST
(PPARALOOKS PC)
TEXTOBJ)
(PPARALOOKS PC))
TEXTOBJ))
(* ;; "This goes piece by piece, each one adding to the collection of dirty lines. We keep track of the first and last changes")
@@ -2517,26 +2533,26 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (22170 24112 (\TEDIT.CHARLOOKS.DEFPRINT 22180 . 23316) (\TEDIT.PARALOOKS.DEFPRINT 23318
. 24110)) (24216 25312 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24226 . 24934) (\TEDIT.CREATE.FACE.MENU 24936
. 25108) (\TEDIT.CREATE.SIZE.MENU 25110 . 25310)) (26111 28000 (\TEDIT.CHARLOOKS.FEATURE.CHECK 26121
. 27998)) (28302 52994 (\TEDIT.CHARLOOKS.FROM.FONT 28312 . 30525) (\TEDIT.EQCLOOKS 30527 . 33349) (
\TEDIT.SAMECLOOKS 33351 . 36237) (TEDIT.CARETLOOKS 36239 . 37785) (TEDIT.COPY.LOOKS 37787 . 41070) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 41072 . 44566) (\TEDIT.MODIFYLOOKS 44568 . 46728) (TEDIT.NEW.FONT 46730
. 47177) (\TEDIT.CARETLOOKS.VERIFY 47179 . 48016) (\TEDIT.CARETPIECE 48018 . 48323) (
\TEDIT.GET.INSERT.CHARLOOKS 48325 . 51372) (\TEDIT.GET.TERMSA.WIDTHS 51374 . 51790) (
\TEDIT.PARSE.CHARLOOKS.LIST 51792 . 52992)) (52995 70141 (\TEDIT.TRANSLATE.ASCIICHARS 53005 . 63877) (
\TEDIT.CONVERT.TO.FORMATTED 63879 . 70139)) (71153 78264 (\TEDIT.UNIQUIFY.CHARLOOKS 71163 . 72823) (
\TEDIT.UNIQUIFY.PARALOOKS 72825 . 74092) (\TEDIT.UNIQUIFY.ALL 74094 . 76069) (
\TEDIT.FLUSH.UNUSED.LOOKS 76071 . 78262)) (78297 89604 (TEDIT.LOOKS 78307 . 80696) (TEDIT.GET.LOOKS
80698 . 82727) (TEDIT.SUBLOOKS 82729 . 86968) (TEDIT.FINDLOOKS 86970 . 89602)) (89679 119187 (
\TEDIT.CHANGE.CHARLOOKS 89689 . 98346) (\TEDIT.CHANGE.CHARLOOKS.NEW 98348 . 102142) (
\TEDIT.CHARLOOKS.CHANGE.FONT 102144 . 110451) (\TEDIT.FONT.NEXTSIZE 110453 . 112074) (\TEDIT.LOOKS
112076 . 115405) (\TEDIT.FONTCOPY 115407 . 116908) (\TEDIT.COERCE.FONTCLASS 116910 . 118061) (
\TEDIT.FONTCLASS.TO.FONT 118063 . 119185)) (119230 150187 (\TEDIT.EQFMTSPEC 119240 . 122455) (
TEDIT.GET.PARALOOKS 122457 . 126504) (\TEDIT.PARSE.PARALOOKS.LIST 126506 . 133848) (TEDIT.PARALOOKS
133850 . 134890) (\TEDIT.CHANGE.PARALOOKS 134892 . 141860) (\TEDIT.CHANGE.PARALOOKS.NEW 141862 .
145845) (TEDIT.COPY.PARALOOKS 145847 . 148521) (\TEDIT.PARABOUNDS 148523 . 150185)) (150247 158000 (
TEDIT.SUBPARALOOKS 150257 . 154396) (SAMEPARALOOKS 154398 . 157998)) (158001 158688 (
\TEDIT.MARK.REVISION 158011 . 158686)))))
(FILEMAP (NIL (22579 24521 (\TEDIT.CHARLOOKS.DEFPRINT 22589 . 23725) (\TEDIT.PARALOOKS.DEFPRINT 23727
. 24519)) (24625 25011 (\TEDIT.CREATE.FACE.MENU 24635 . 24807) (\TEDIT.CREATE.SIZE.MENU 24809 . 25009
)) (26015 27904 (\TEDIT.CHARLOOKS.FEATURE.CHECK 26025 . 27902)) (28176 53365 (
\TEDIT.CHARLOOKS.FROM.FONT 28186 . 30399) (\TEDIT.EQCLOOKS 30401 . 33435) (\TEDIT.SAMECLOOKS 33437 .
36608) (TEDIT.CARETLOOKS 36610 . 38156) (TEDIT.COPY.LOOKS 38158 . 41441) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 41443 . 44937) (\TEDIT.MODIFYLOOKS 44939 . 47099) (TEDIT.NEW.FONT 47101
. 47548) (\TEDIT.CARETLOOKS.VERIFY 47550 . 48387) (\TEDIT.CARETPIECE 48389 . 48694) (
\TEDIT.GET.INSERT.CHARLOOKS 48696 . 51743) (\TEDIT.GET.TERMSA.WIDTHS 51745 . 52161) (
\TEDIT.PARSE.CHARLOOKS.LIST 52163 . 53363)) (53366 70096 (\TEDIT.TRANSLATE.ASCIICHARS 53376 . 63832) (
\TEDIT.CONVERT.TO.FORMATTED 63834 . 70094)) (71108 78445 (\TEDIT.UNIQUIFY.CHARLOOKS 71118 . 72778) (
\TEDIT.UNIQUIFY.PARALOOKS 72780 . 74047) (\TEDIT.UNIQUIFY.ALL 74049 . 76137) (
\TEDIT.FLUSH.UNUSED.LOOKS 76139 . 78443)) (78478 90436 (TEDIT.LOOKS 78488 . 80877) (TEDIT.GET.LOOKS
80879 . 83214) (TEDIT.SUBLOOKS 83216 . 87596) (TEDIT.FINDLOOKS 87598 . 90434)) (90511 120140 (
\TEDIT.CHANGE.CHARLOOKS 90521 . 99299) (\TEDIT.CHANGE.CHARLOOKS.NEW 99301 . 103095) (
\TEDIT.CHARLOOKS.CHANGE.FONT 103097 . 111404) (\TEDIT.FONT.NEXTSIZE 111406 . 113027) (\TEDIT.LOOKS
113029 . 116358) (\TEDIT.FONTCOPY 116360 . 117861) (\TEDIT.COERCE.FONTCLASS 117863 . 119014) (
\TEDIT.FONTCLASS.TO.FONT 119016 . 120138)) (120183 151831 (\TEDIT.EQFMTSPEC 120193 . 123408) (
TEDIT.GET.PARALOOKS 123410 . 127457) (\TEDIT.PARSE.PARALOOKS.LIST 127459 . 135492) (TEDIT.PARALOOKS
135494 . 136534) (\TEDIT.CHANGE.PARALOOKS 136536 . 143504) (\TEDIT.CHANGE.PARALOOKS.NEW 143506 .
147489) (TEDIT.COPY.PARALOOKS 147491 . 150165) (\TEDIT.PARABOUNDS 150167 . 151829)) (151891 159607 (
TEDIT.SUBPARALOOKS 151901 . 156003) (SAMEPARALOOKS 156005 . 159605)) (159608 160295 (
\TEDIT.MARK.REVISION 159618 . 160293)))))
STOP

BIN
library/tedit/TEDIT-LOOKS.LCOM
View File

Binary file not shown.

185
library/tedit/TEDIT-STREAM
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-May-2025 19:06:45" {WMEDLEY}<library>tedit>TEDIT-STREAM.;901 191318
(FILECREATED "29-Jul-2025 11:58:01" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;912 190401
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.PIECES)
:CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS)
:PREVIOUS-DATE "26-Apr-2025 12:59:53" {WMEDLEY}<library>tedit>TEDIT-STREAM.;900)
:PREVIOUS-DATE "28-Jul-2025 23:52:41" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;911)
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -14,8 +14,8 @@
(RPAQQ TEDIT-STREAMCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY
(EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
(MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PLOOKS PCHARLOOKS PCHARSET
PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
(MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PCHARLOOKS PCHARSET PPARALOOKS
PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
(MACROS SETPC FSETPC GETPC FGETPC)
(MACROS THINPIECEP)
(MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
@@ -126,14 +126,8 @@
 "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece")
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
(type? IMAGEOBJ (PCONTENTS DATUM))
(PCONTENTS DATUM)))
(PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM)
FAST
(fetch (PIECE PCHARLOOKS) of DATUM))
(STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE)
FAST
(freplace (PIECE PCHARLOOKS) of DATUM with NEWVALUE]
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
(PCONTENTS DATUM]
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
(DATATYPE TEXTOBJ (
(* ;;
@@ -202,7 +196,7 @@
 "Flag for paragraph formatting. T if this document is to contain paragraph formatting information.")
(TXTREADONLY FLAG) (* ;
 "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.")
(UNDERTEDIT FLAG) (* ; "Was TXTEDITING, but it was never fetched. 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.")
(TXTNOTSPLITTABLE FLAG) (* ; "Can't split into panes, split-region not show. Was TXTNONSCHARS: 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")
@@ -252,8 +246,7 @@
(freplace \XDIRTY OF DATUM WITH NEWVALUE))]
SEL _ (create SELECTION)
TEXTLEN _ 0 WTOP _ 0 MOUSEREGION _ 'TEXT THISLINE _ (create THISLINE)
DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _
(CHARCODE (EOL FORM LF CR)))
PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
(ACCESSFNS TEXTSTREAM
(
@@ -410,9 +403,6 @@
(PUTPROPS PCONTENTS MACRO ((PC)
(ffetch (PIECE PCONTENTS) of PC)))
(PUTPROPS PLOOKS MACRO ((PC)
(ffetch (PIECE PCHARLOOKS) of PC)))
(PUTPROPS PCHARLOOKS MACRO ((PC)
(ffetch (PIECE PCHARLOOKS) of PC)))
@@ -1640,18 +1630,8 @@
WINDOW])
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
[LAMBDA (TEXTOBJ) (* ; "Edited 22-Mar-2025 21:37 by rmk")
(* ; "Edited 8-Feb-2025 22:04 by rmk")
(* ; "Edited 29-Dec-2024 20:37 by rmk")
(* ; "Edited 20-Dec-2024 11:56 by rmk")
(* ; "Edited 16-Dec-2024 13:14 by rmk")
(* ; "Edited 21-Nov-2024 14:35 by rmk")
(* ; "Edited 29-Aug-2024 09:46 by rmk")
(* ; "Edited 31-Jul-2024 12:09 by rmk")
(* ; "Edited 29-Apr-2024 11:05 by rmk")
(* ; "Edited 11-Nov-2023 16:13 by rmk")
(* ; "Edited 17-Sep-2023 07:43 by rmk")
(* ; "Edited 3-Aug-2023 23:02 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 29-Jul-2025 11:53 by rmk")
(* ; "Edited 22-Mar-2025 21:37 by rmk")
(* ; "Edited 26-Apr-2023 14:29 by rmk")
(* ;;
@@ -1663,21 +1643,26 @@
(SETQ FONT (OR (GETTEXTPROP TEXTOBJ 'FONT)
(FONTCREATE DEFAULTFONT)))
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'CHARLOOKS))
(* ;; "LOOKS for backward compatibility and compatibility with documentation")
[SETQ CHARLOOKS (OR (GETTEXTPROP TEXTOBJ 'CHARLOOKS)
(GETTEXTPROP TEXTOBJ 'LOOKS]
(SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
(AND (type? CHARLOOKS FONT)
FONT)
(\TEDIT.CHARLOOKS.FROM.FONT FONT)))
(SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ))
(SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
(OR (GETTEXTPROP TEXTOBJ 'PARALOOKS)
(create PARALOOKS using
TEDIT.DEFAULT.FMTSPEC
))
NIL TEXTOBJ)
TEXTOBJ))
(SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS)
(SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS)
(* ;; "PARALOOKS")
(SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST (GETTEXTPROP
TEXTOBJ
'PARALOOKS)
TEDIT.DEFAULT.PARALOOKS)
TEXTOBJ))
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
(\TEDIT.OPENTEXTFILE
@@ -1709,7 +1694,8 @@
(ERROR TEXT " does not identify a Tedit document")))])
(\TEDIT.CREATE.TEXTSTREAM
[LAMBDA (PROPS) (* ; "Edited 7-Feb-2025 08:09 by rmk")
[LAMBDA (PROPS) (* ; "Edited 28-Jul-2025 22:56 by rmk")
(* ; "Edited 7-Feb-2025 08:09 by rmk")
(* ; "Edited 16-Mar-2024 09:52 by rmk")
(* ; "Edited 21-Jan-2024 15:16 by rmk")
(* ; "Edited 17-Sep-2023 00:38 by rmk")
@@ -1717,15 +1703,15 @@
(* ;; "Creates and initializes an empty, windowless textstream")
(LET (TSTREAM (TEXTOBJ (create TEXTOBJ)))
(SETQ TSTREAM (create TEXTSTREAM
TEXTOBJ _ TEXTOBJ))
(SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
(\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
(\TEDIT.MAKEPCTB TEXTOBJ)
(\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
0)
TSTREAM])
(LET* ((TEXTOBJ (create TEXTOBJ))
(TSTREAM (create TEXTSTREAM
TEXTOBJ _ TEXTOBJ)))
(SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
(\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS)
(\TEDIT.MAKEPCTB TEXTOBJ)
(\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
0)
TSTREAM])
(\TEDIT.REOPEN.STREAM
[LAMBDA (TSTREAM PIECESTREAM) (* ; "Edited 14-May-2024 18:00 by rmk")
@@ -1766,7 +1752,8 @@
NEWSTREAM])
(\TEDIT.TEXTINIT
[LAMBDA NIL (* ; "Edited 15-Apr-2025 23:10 by rmk")
[LAMBDA NIL (* ; "Edited 10-Jul-2025 11:28 by rmk")
(* ; "Edited 15-Apr-2025 23:10 by rmk")
(* ; "Edited 4-Sep-2024 22:05 by rmk")
(* ; "Edited 22-May-2024 14:53 by rmk")
(* ; "Edited 19-Mar-2024 18:16 by rmk")
@@ -1817,7 +1804,7 @@
IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
(FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY)
(ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
(FONTSAVAILABLE \SEARCHFONTFILES)
(CREATECHARSET \CREATECHARSET.DISPLAY)))
(* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count. If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed. But INCCODE wants to go through the BIN opcode")
@@ -1936,7 +1923,9 @@
(CLOSEF? (GETTOBJ TEXTOBJ TXTFILE])
(\TEDIT.TEXTDSPFONT
[LAMBDA (TSTREAM NEWFONT) (* ; "Edited 17-Mar-2024 11:49 by rmk")
[LAMBDA (TSTREAM NEWFONT) (* ; "Edited 14-Jul-2025 22:57 by rmk")
(* ; "Edited 5-Jul-2025 18:55 by rmk")
(* ; "Edited 17-Mar-2024 11:49 by rmk")
(* ; "Edited 15-Oct-2023 17:13 by rmk")
(* ; "Edited 8-Sep-2022 14:16 by rmk")
(* ; "Edited 31-May-91 14:02 by jds")
@@ -1946,7 +1935,7 @@
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
(PROG1 (fetch (CHARLOOKS CLFONT) of (FGETTOBJ TEXTOBJ CARETLOOKS))
(CL:WHEN NEWFONT
(TEDIT.CARETLOOKS TSTREAM (\GETFONTDESC NEWFONT 'DISPLAY))
(TEDIT.CARETLOOKS TSTREAM (FONTCREATE NEWFONT NIL NIL NIL 'DISPLAY))
(for PANE inpanes (PROGN TEXTOBJ) do (DSPFONT NEWFONT PANE))))])
(\TEDIT.TEXTEOFP
@@ -2337,7 +2326,8 @@
TSTREAM))])
(\TEDIT.PIECE.RPLCHARCODE
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 24-Apr-2025 16:30 by rmk")
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 28-Jul-2025 23:38 by rmk")
(* ; "Edited 24-Apr-2025 16:30 by rmk")
(* ; "Edited 20-Apr-2025 13:25 by rmk")
(* ; "Edited 28-Mar-2025 10:04 by rmk")
@@ -2353,7 +2343,7 @@
(MEMB (PTYPE PC)
STRING.PTYPES)
(OR (NULL NEWCHARLOOKS)
(EQ NEWCHARLOOKS (PLOOKS PC)))
(EQ NEWCHARLOOKS (PCHARLOOKS PC)))
(NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
(NOT PARALAST))
then
@@ -2375,7 +2365,7 @@
elseif [AND (IMAGEOBJP NEWCHARCODE)
(EQ OBJECT.PTYPE (PTYPE PC))
(OR (NULL NEWCHARLOOKS)
(EQ NEWCHARLOOKS (PLOOKS PC]
(EQ NEWCHARLOOKS (PCHARLOOKS PC]
then (SETQ OLDCHAR (POBJ PC)) (* ; "We know PLEN is 1")
(FSETPC PC PCONTENTS NEWCHARCODE)
else
@@ -2419,11 +2409,11 @@
(FSETPC PC PCHARSET 0)))
(FSETPC PC PFPOS NIL)
(CL:WHEN NEWCHARLOOKS
(FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS)
(\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
NEWCHARLOOKS)
TEXTOBJ)
NEWCHARLOOKS)))]
(FSETPC PC PCHARLOOKS (CL:IF (FONTP NEWCHARLOOKS)
(\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
NEWCHARLOOKS)
TEXTOBJ)
NEWCHARLOOKS)))]
(CL:WHEN PARALAST (FSETPC PC PPARALAST T))
OLDCHAR])
@@ -2520,7 +2510,8 @@
T)])
(\TEDIT.INSERTCH
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 26-Mar-2025 00:29 by rmk")
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 26-Jul-2025 21:13 by rmk")
(* ; "Edited 26-Mar-2025 00:29 by rmk")
(* ; "Edited 22-Nov-2024 13:48 by rmk")
(* ; "Edited 22-Sep-2024 12:32 by rmk")
(* ; "Edited 13-Aug-2024 08:30 by rmk")
@@ -2603,7 +2594,7 @@
PCONTENTS _ INSERTION
PLEN _ ILEN
PCHARLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS)
PPARALOOKS _ (PPARALOOKS (OR PREVPC INSERTPC))
PPARALOOKS _ (PPARALOOKS (OR INSERTPC PREVPC))
PNEW _ T))
(SELECTC INSERTPTYPE
(THINSTRING.PTYPE
@@ -2967,7 +2958,8 @@
OLDITEMS])
(\TEDIT.TEXTPROP
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 16-Feb-2025 23:27 by rmk")
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 17-Jul-2025 00:19 by rmk")
(* ; "Edited 16-Feb-2025 23:27 by rmk")
(* ; "Edited 15-Feb-2025 14:02 by rmk")
(* ; "Edited 22-Dec-2024 00:23 by rmk")
(* ; "Edited 23-Nov-2024 09:47 by rmk")
@@ -2998,9 +2990,8 @@
(FSETTOBJ TEXTOBJ TXTREADONLY NEWVALUE)
(FSETTOBJ TEXTOBJ TXTREADONLYQUIET (EQ 'QUIET NEWVALUE))
(\TEDIT.HISTORY.PROP TEXTOBJ T 'OFF))))
((BEING-EDITED ACTIVE)
(PROG1 (FGETTOBJ TEXTOBJ TXTEDITING)
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTEDITING NEWVALUE))))
(ACTIVE (PROG1 (FGETTOBJ TEXTOBJ EDITOPACTIVE)
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ EDITOPACTIVE NEWVALUE))))
(READTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTRTBL)
(CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTRTBL NEWVALUE))))
(TERMTABLE (PROG1 (FSETTOBJ TEXTOBJ TXTTERMSA (fetch (TERMTABLEP TERMSA) of NEWVALUE))
@@ -3132,34 +3123,34 @@
(ADDTOVAR LAMA TEXTPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (37559 68375 (\TEDIT.TEXTBIN 37569 . 48319) (\TEDIT.TEXTPEEKBIN 48321 . 53871) (
\TEDIT.TEXTBACKFILEPTR 53873 . 59546) (\TEDIT.TEXTBOUT 59548 . 64165) (\TEDIT.INSTALL.FILEBUFFER 64167
. 68373)) (69273 73564 (\TEDIT.TEXTOUTCHARFN 69283 . 70839) (\TEDIT.TEXTINCCODEFN 70841 . 71580) (
\TEDIT.TEXTBACKCCODEFN 71582 . 72174) (\TEDIT.TEXTFORMATBYTESTREAM 72176 . 73013) (
\TEDIT.TEXTFORMATBYTESTRING 73015 . 73562)) (73611 85252 (OPENTEXTSTREAM 73621 . 80573) (
COPYTEXTSTREAM 80575 . 84475) (TEDIT.STREAMCHANGEDP 84477 . 84779) (TXTFILE 84781 . 85250)) (85253
116062 (\TEDIT.REOPENTEXTSTREAM 85263 . 86615) (\TEDIT.OPENTEXTSTREAM.PIECES 86617 . 91551) (
\TEDIT.OPENTEXTSTREAM.PROPS 91553 . 92655) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92657 . 97898) (
\TEDIT.OPENTEXTSTREAM.WINDOW 97900 . 100691) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100693 . 103663) (
\TEDIT.OPENTEXTFILE 103665 . 105378) (\TEDIT.CREATE.TEXTSTREAM 105380 . 106425) (\TEDIT.REOPEN.STREAM
106427 . 108763) (\TEDIT.TEXTINIT 108765 . 116060)) (116100 117288 (\TEDIT.TTYBOUT 116110 . 117286)) (
117406 137175 (\TEDIT.TEXTCLOSEF 117416 . 118740) (\TEDIT.TEXTDSPFONT 118742 . 119712) (
\TEDIT.TEXTEOFP 119714 . 121469) (\TEDIT.TEXTGETEOFPTR 121471 . 121794) (\TEDIT.TEXTSETEOFPTR 121796
. 123083) (\TEDIT.TEXTGETFILEPTR 123085 . 125920) (\TEDIT.TEXTSETFILEINFO 125922 . 126430) (
\TEDIT.TEXTOPENF 126432 . 127363) (\TEDIT.TEXTSETEOF 127365 . 127981) (\TEDIT.TEXTSETFILEPTR 127983 .
130093) (\TEDIT.TEXTDSPXPOSITION 130095 . 131112) (\TEDIT.TEXTDSPYPOSITION 131114 . 131855) (
\TEDIT.TEXTLEFTMARGIN 131857 . 132448) (\TEDIT.TEXTCOLOR 132450 . 133033) (\TEDIT.TEXTRIGHTMARGIN
133035 . 136324) (\TEDIT.TEXTDSPCHARWIDTH 136326 . 136630) (\TEDIT.TEXTDSPSTRINGWIDTH 136632 . 136938)
(\TEDIT.TEXTDSPLINEFEED 136940 . 137173)) (137213 149689 (\TEDIT.NTHCHARCODE 137223 . 138674) (
\TEDIT.PIECE.NTHCHARCODE 138676 . 142586) (\TEDIT.RPLCHARCODE 142588 . 144046) (
\TEDIT.PIECE.RPLCHARCODE 144048 . 149334) (\TEDIT.NTHCHARLOOKS 149336 . 149687)) (150736 171721 (
\TEDIT.DELETE.SELPIECES 150746 . 154371) (\TEDIT.INSERTCH 154373 . 162303) (\TEDIT.INSERTCH.HISTORY
162305 . 165769) (\TEDIT.INSERTEOL 165771 . 167596) (\TEDIT.INSERTCH.INSERTION 167598 . 170435) (
\TEDIT.INSERTCH.EXTEND 170437 . 171719)) (171722 173226 (\TEDIT.NEXTCHANGEABLE.CHNO 171732 . 172447) (
\TEDIT.LASTCHANGEABLE.CHNO 172449 . 173224)) (173227 174931 (\SETUPGETCH 173237 . 174929)) (174989
179447 (\TEDIT.INSTALL.PIECE 174999 . 179445)) (179485 188499 (TEXTPROP 179495 . 179842) (GETTEXTPROP
179844 . 180088) (PUTTEXTPROP 180090 . 180347) (GETTEXTPROPS 180349 . 180793) (PUTTEXTPROPS 180795 .
181699) (TEXTPROP.ADD 181701 . 181964) (\TEDIT.TEXTPROP 181966 . 188497)) (188500 190570 (
\TEDIT.TEXTOBJ.PROPNAMES 188510 . 189462) (\TEDIT.TEXTOBJ.PROPFETCHFN 189464 . 189980) (
\TEDIT.TEXTOBJ.PROPSTOREFN 189982 . 190568)))))
(FILEMAP (NIL (36908 67724 (\TEDIT.TEXTBIN 36918 . 47668) (\TEDIT.TEXTPEEKBIN 47670 . 53220) (
\TEDIT.TEXTBACKFILEPTR 53222 . 58895) (\TEDIT.TEXTBOUT 58897 . 63514) (\TEDIT.INSTALL.FILEBUFFER 63516
. 67722)) (68622 72913 (\TEDIT.TEXTOUTCHARFN 68632 . 70188) (\TEDIT.TEXTINCCODEFN 70190 . 70929) (
\TEDIT.TEXTBACKCCODEFN 70931 . 71523) (\TEDIT.TEXTFORMATBYTESTREAM 71525 . 72362) (
\TEDIT.TEXTFORMATBYTESTRING 72364 . 72911)) (72960 84601 (OPENTEXTSTREAM 72970 . 79922) (
COPYTEXTSTREAM 79924 . 83824) (TEDIT.STREAMCHANGEDP 83826 . 84128) (TXTFILE 84130 . 84599)) (84602
114584 (\TEDIT.REOPENTEXTSTREAM 84612 . 85964) (\TEDIT.OPENTEXTSTREAM.PIECES 85966 . 90900) (
\TEDIT.OPENTEXTSTREAM.PROPS 90902 . 92004) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92006 . 97247) (
\TEDIT.OPENTEXTSTREAM.WINDOW 97249 . 100040) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100042 . 101981) (
\TEDIT.OPENTEXTFILE 101983 . 103696) (\TEDIT.CREATE.TEXTSTREAM 103698 . 104845) (\TEDIT.REOPEN.STREAM
104847 . 107183) (\TEDIT.TEXTINIT 107185 . 114582)) (114622 115810 (\TEDIT.TTYBOUT 114632 . 115808)) (
115928 135925 (\TEDIT.TEXTCLOSEF 115938 . 117262) (\TEDIT.TEXTDSPFONT 117264 . 118462) (
\TEDIT.TEXTEOFP 118464 . 120219) (\TEDIT.TEXTGETEOFPTR 120221 . 120544) (\TEDIT.TEXTSETEOFPTR 120546
. 121833) (\TEDIT.TEXTGETFILEPTR 121835 . 124670) (\TEDIT.TEXTSETFILEINFO 124672 . 125180) (
\TEDIT.TEXTOPENF 125182 . 126113) (\TEDIT.TEXTSETEOF 126115 . 126731) (\TEDIT.TEXTSETFILEPTR 126733 .
128843) (\TEDIT.TEXTDSPXPOSITION 128845 . 129862) (\TEDIT.TEXTDSPYPOSITION 129864 . 130605) (
\TEDIT.TEXTLEFTMARGIN 130607 . 131198) (\TEDIT.TEXTCOLOR 131200 . 131783) (\TEDIT.TEXTRIGHTMARGIN
131785 . 135074) (\TEDIT.TEXTDSPCHARWIDTH 135076 . 135380) (\TEDIT.TEXTDSPSTRINGWIDTH 135382 . 135688)
(\TEDIT.TEXTDSPLINEFEED 135690 . 135923)) (135963 148576 (\TEDIT.NTHCHARCODE 135973 . 137424) (
\TEDIT.PIECE.NTHCHARCODE 137426 . 141336) (\TEDIT.RPLCHARCODE 141338 . 142796) (
\TEDIT.PIECE.RPLCHARCODE 142798 . 148221) (\TEDIT.NTHCHARLOOKS 148223 . 148574)) (149623 170717 (
\TEDIT.DELETE.SELPIECES 149633 . 153258) (\TEDIT.INSERTCH 153260 . 161299) (\TEDIT.INSERTCH.HISTORY
161301 . 164765) (\TEDIT.INSERTEOL 164767 . 166592) (\TEDIT.INSERTCH.INSERTION 166594 . 169431) (
\TEDIT.INSERTCH.EXTEND 169433 . 170715)) (170718 172222 (\TEDIT.NEXTCHANGEABLE.CHNO 170728 . 171443) (
\TEDIT.LASTCHANGEABLE.CHNO 171445 . 172220)) (172223 173927 (\SETUPGETCH 172233 . 173925)) (173985
178443 (\TEDIT.INSTALL.PIECE 173995 . 178441)) (178481 187582 (TEXTPROP 178491 . 178838) (GETTEXTPROP
178840 . 179084) (PUTTEXTPROP 179086 . 179343) (GETTEXTPROPS 179345 . 179789) (PUTTEXTPROPS 179791 .
180695) (TEXTPROP.ADD 180697 . 180960) (\TEDIT.TEXTPROP 180962 . 187580)) (187583 189653 (
\TEDIT.TEXTOBJ.PROPNAMES 187593 . 188545) (\TEDIT.TEXTOBJ.PROPFETCHFN 188547 . 189063) (
\TEDIT.TEXTOBJ.PROPSTOREFN 189065 . 189651)))))
STOP

BIN
library/tedit/TEDIT-STREAM.LCOM
View File

Binary file not shown.

49
library/tedit/TEDIT-TFBRAVO
View File

@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-May-2025 12:53:24" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;183 97073
(FILECREATED "28-Jul-2025 23:34:14" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;185 97353
:EDIT-BY rmk
:CHANGES-TO (FNS \TFBRAVO.GET.USER.CM TEDITFROMBRAVO \TFBRAVO.USER.CM.LOOKS)
(VARS TEDIT-TFBRAVOCOMS)
:CHANGES-TO (FNS \TFBRAVO.INSERT.RUN \TFBRAVO.INIT.PARALOOKS)
:PREVIOUS-DATE " 9-May-2025 09:51:51" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;178)
:PREVIOUS-DATE "10-May-2025 12:53:24" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;183)
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -419,7 +419,8 @@
(GO LLP)))])
(\TFBRAVO.INIT.PARALOOKS
[LAMBDA (ALIST) (* ; "Edited 8-Feb-2025 22:09 by rmk")
[LAMBDA (ALIST) (* ; "Edited 28-Jul-2025 23:12 by rmk")
(* ; "Edited 8-Feb-2025 22:09 by rmk")
(* ; "Edited 4-Aug-2024 22:17 by rmk")
(* ; "Edited 28-Jul-2024 21:36 by rmk")
(* ; "Edited 13-Aug-2023 11:27 by rmk")
@@ -429,7 +430,7 @@
(* ;; "creates the default paragraph looks from the USER.CM. The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points. ")
(LET ((INITPARALOOKS (create PARALOOKS using TEDIT.DEFAULT.FMTSPEC)))
(LET ((INITPARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST TEDIT.DEFAULT.PARALOOKS)))
(* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60. I'm going with 36.")
@@ -1010,7 +1011,8 @@
(\TFBRAVO.INSERT.RUN RUN BSTREAM PARALOOKS TEXTOBJ])
(\TFBRAVO.INSERT.RUN
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 8-Feb-2025 23:08 by rmk")
[LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ) (* ; "Edited 28-Jul-2025 23:33 by rmk")
(* ; "Edited 8-Feb-2025 23:08 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 16-Jan-2024 18:28 by rmk")
(* ; "Edited 29-Dec-2023 11:50 by rmk")
@@ -1030,8 +1032,9 @@
FATP PC)
(SETQ PC (create PIECE
PLEN _ NCHARS
PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN)
TEXTOBJ)
PCHARLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS)
of RUN)
TEXTOBJ)
PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)
PPARALAST _ (fetch (RUN RUNLAST) of RUN)))
(if (STRINGP RUNSTART)
@@ -1552,18 +1555,18 @@
(AND NIL (\TEDIT.NAMEDTAB.INIT))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7682 14673 (TEDIT.BRAVOFILE? 7692 . 9422) (TEDITFROMBRAVO 9424 . 14671)) (14784 31092 (
\TFBRAVO.GET.USER.CM 14794 . 17974) (\TFBRAVO.USER.CM.LOOKS 17976 . 19469) (\TFBRAVO.READ.USER.CM
19471 . 24094) (\TFBRAVO.INIT.PARALOOKS 24096 . 26205) (\TFBRAVO.INIT.PAGEFORMAT 26207 . 27087) (
\TFBRAVO.GETPARAMS 27089 . 29943) (\TFBRAVO.FIND.LAST.TRAILER 29945 . 31090)) (31134 51832 (
\TFBRAVO.PARSE.PARA 31144 . 35071) (\TFBRAVO.READ.PARALOOKS 35073 . 41963) (\TFBRAVO.CREATE.RUNS 41965
. 43353) (\TFBRAVO.READ.CHARLOOKS 43355 . 48384) (\TFBRAVO.FONT.FROM.CHARLOOKS 48386 . 49933) (
\TFBRAVO.READNUM? 49935 . 51830)) (51869 62910 (\TFBRAVO.HANDLE.HEADING 51879 . 54606) (
\TFBRAVO.PARSE.PROFILE.PARA 54608 . 62908)) (62953 85098 (\TFBRAVO.INSERT.PARA 62963 . 63804) (
\TFBRAVO.INSERT.RUN 63806 . 67108) (\TFBRAVO.SPLIT.PARA 67110 . 74534) (\TFBRAVO.RUN.TABSPEC 74536 .
79403) (\TFBRAVO.INSTALL.PAGEFORMAT 79405 . 85096)) (85099 89242 (\TFBRAVO.ASSERT 85109 . 85639) (
\TEST.CHARACTER.LOOKS 85641 . 87527) (\TEST.PARAGRAPH.LOOKS 87529 . 89240)) (90252 96907 (
\TFBRAVO.ADD.NAMEDTAB 90262 . 93865) (\TFBRAVO.COPY.NAMEDTAB 93867 . 94315) (\TFBRAVO.PUT.NAMEDTAB
94317 . 94597) (\TFBRAVO.GET.NAMEDTAB 94599 . 94976) (\NAMEDTABNYET 94978 . 95138) (\NAMEDTABSIZE
95140 . 95655) (\NAMEDTABPREPRINT 95657 . 95855) (\TEDIT.NAMEDTAB.INIT 95857 . 96905)))))
(FILEMAP (NIL (7665 14656 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14654)) (14767 31183 (
\TFBRAVO.GET.USER.CM 14777 . 17957) (\TFBRAVO.USER.CM.LOOKS 17959 . 19452) (\TFBRAVO.READ.USER.CM
19454 . 24077) (\TFBRAVO.INIT.PARALOOKS 24079 . 26296) (\TFBRAVO.INIT.PAGEFORMAT 26298 . 27178) (
\TFBRAVO.GETPARAMS 27180 . 30034) (\TFBRAVO.FIND.LAST.TRAILER 30036 . 31181)) (31225 51923 (
\TFBRAVO.PARSE.PARA 31235 . 35162) (\TFBRAVO.READ.PARALOOKS 35164 . 42054) (\TFBRAVO.CREATE.RUNS 42056
. 43444) (\TFBRAVO.READ.CHARLOOKS 43446 . 48475) (\TFBRAVO.FONT.FROM.CHARLOOKS 48477 . 50024) (
\TFBRAVO.READNUM? 50026 . 51921)) (51960 63001 (\TFBRAVO.HANDLE.HEADING 51970 . 54697) (
\TFBRAVO.PARSE.PROFILE.PARA 54699 . 62999)) (63044 85378 (\TFBRAVO.INSERT.PARA 63054 . 63895) (
\TFBRAVO.INSERT.RUN 63897 . 67388) (\TFBRAVO.SPLIT.PARA 67390 . 74814) (\TFBRAVO.RUN.TABSPEC 74816 .
79683) (\TFBRAVO.INSTALL.PAGEFORMAT 79685 . 85376)) (85379 89522 (\TFBRAVO.ASSERT 85389 . 85919) (
\TEST.CHARACTER.LOOKS 85921 . 87807) (\TEST.PARAGRAPH.LOOKS 87809 . 89520)) (90532 97187 (
\TFBRAVO.ADD.NAMEDTAB 90542 . 94145) (\TFBRAVO.COPY.NAMEDTAB 94147 . 94595) (\TFBRAVO.PUT.NAMEDTAB
94597 . 94877) (\TFBRAVO.GET.NAMEDTAB 94879 . 95256) (\NAMEDTABNYET 95258 . 95418) (\NAMEDTABSIZE
95420 . 95935) (\NAMEDTABPREPRINT 95937 . 96135) (\TEDIT.NAMEDTAB.INIT 96137 . 97185)))))
STOP

BIN
library/tedit/TEDIT-TFBRAVO.LCOM
View File

Binary file not shown.

142
library/tedit/TEDIT-WINDOW
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Jul-2025 11:55:26" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;861 229641
(FILECREATED "26-Jul-2025 15:45:59" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;862 229373
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
:CHANGES-TO (FNS \TEDIT.SET.WINDOW.EXTENT)
:PREVIOUS-DATE "30-May-2025 12:54:56" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;860)
:PREVIOUS-DATE "21-Jul-2025 11:55:26" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;861)
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -937,7 +937,8 @@
(RETURN MOVINGPOINT])
(\TEDIT.SET.WINDOW.EXTENT
[LAMBDA (TEXTOBJ PANE) (* ; "Edited 1-Dec-2024 11:28 by rmk")
[LAMBDA (TEXTOBJ PANE) (* ; "Edited 26-Jul-2025 15:45 by rmk")
(* ; "Edited 1-Dec-2024 11:28 by rmk")
(* ; "Edited 29-Nov-2024 10:59 by rmk")
(* ; "Edited 17-Nov-2024 18:59 by rmk")
(* ; "Edited 28-Jun-2024 15:11 by rmk")
@@ -960,55 +961,44 @@
(LET ((TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN))
(PHEIGHT (PANEHEIGHT PANE))
(PBOTTOM (PANEBOTTOM PANE))
FIRSTLINE LASTLINE TOPCHAR BOTCHAR EXTHEIGHT EXTBOT YBOT)
(* ;; "First visible line")
(SETQ FIRSTLINE (find L inlines (PANEPREFIX PANE)
suchthat (ILESSP (FGETLD L YBOT)
PHEIGHT)))
(* ;; "Last visible line")
(for L inlines FIRSTLINE while (IGEQ (FGETLD L YBOT)
PBOTTOM) do (SETQ LASTLINE L))
(FIRSTLINE (PANETOPLINE PANE))
(LASTLINE (PANEBOTTOMLINE PANE))
TOPCHAR BOTCHAR EXTHEIGHT EXTBOT YBOT)
(* ;; "Start of first visible line")
(SETQ TOPCHAR (CL:IF FIRSTLINE
(FGETLD FIRSTLINE LCHAR1)
TEXTLEN))
(COND
(LASTLINE
(if LASTLINE
then
(* ;; "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")
(* ;; "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")
(SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLAST)))
(SETQ YBOT (FGETLD LASTLINE YBOT))
else
(* ;; "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.")
(SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLAST)))
(SETQ YBOT (FGETLD LASTLINE YBOT)))
(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.")
(SETQ BOTCHAR TEXTLEN)
(SETQ YBOT PHEIGHT))
[if (AND (IEQP BOTCHAR TEXTLEN)
(IEQP TOPCHAR TEXTLEN))
then (SETQ EXTBOT (SUB1 YBOT)) (* ; "At the bottom of the document")
(SETQ EXTHEIGHT PHEIGHT)
else
(* ;; "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")
(SETQ BOTCHAR TEXTLEN)
(SETQ YBOT PHEIGHT)))
[COND
((AND (IEQP BOTCHAR TEXTLEN)
(IEQP TOPCHAR TEXTLEN)) (* ; "At the bottom of the document")
(SETQ EXTBOT (SUB1 YBOT))
(SETQ EXTHEIGHT PHEIGHT))
(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")
[SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT YBOT)
TEXTLEN)
(IMAX (IDIFFERENCE BOTCHAR TOPCHAR)
1]
(SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT
YBOT)
(IDIFFERENCE TEXTLEN
BOTCHAR))
(IMAX (IDIFFERENCE BOTCHAR TOPCHAR
)
1]
[SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT YBOT)
TEXTLEN)
(IMAX (IDIFFERENCE BOTCHAR TOPCHAR)
1]
(SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT
YBOT)
(IDIFFERENCE TEXTLEN
BOTCHAR))
(IMAX (IDIFFERENCE BOTCHAR
TOPCHAR)
1]
(WINDOWPROP PANE 'EXTENT (create REGION
BOTTOM _ EXTBOT
HEIGHT _ (IMAX 1 EXTHEIGHT)
@@ -3629,36 +3619,36 @@
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
TEDIT.ICON.TITLE.REGION))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 43942 (\TEDIT.WINDOW.CREATE
18007 . 25337) (\TEDIT.WINDOW.GETREGION 25339 . 28829) (\TEDIT.WINDOW.SETUP 28831 . 33161) (
\TEDIT.MINIMAL.WINDOW.SETUP 33163 . 40574) (\TEDIT.CLEARPANE 40576 . 41293) (\TEDIT.FILL.PANES 41295
. 43940)) (43943 67916 (\TEDIT.CURSORMOVEDFN 43953 . 49563) (\TEDIT.CURSOROUTFN 49565 . 50253) (
\TEDIT.ACTIVE.WINDOWP 50255 . 51325) (\TEDIT.EXPANDFN 51327 . 51890) (\TEDIT.MAINW 51892 . 53172) (
\TEDIT.MAINSTREAM 53174 . 53508) (\TEDIT.PRIMARYPANE 53510 . 54280) (\TEDIT.PANELIST 54282 . 54778) (
\TEDIT.NEWREGIONFN 54780 . 57296) (\TEDIT.SET.WINDOW.EXTENT 57298 . 62552) (\TEDIT.SHRINK.ICONCREATE
62554 . 65287) (\TEDIT.SHRINKFN 65289 . 65698) (\TEDIT.PANEREGION 65700 . 67914)) (67948 100994 (
\TEDIT.BUTTONEVENTFN 67958 . 80931) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80933 . 88196) (
\TEDIT.BUTTONEVENTFN.GETOPERATION 88198 . 90040) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90042 . 93712) (
\TEDIT.BUTTONEVENTFN.INACTIVE 93714 . 96144) (\TEDIT.BUTTONEVENTFN.INTITLE 96146 . 97981) (
\TEDIT.COPYINSERTFN 97983 . 99115) (\TEDIT.FOREIGN.COPY 99117 . 100992)) (100995 118237 (
\TEDIT.PANE.SPLIT 101005 . 104953) (\TEDIT.SPLITW 104955 . 112693) (\TEDIT.UNSPLITW 112695 . 116894) (
\TEDIT.LINKPANES 116896 . 117659) (\TEDIT.UNLINKPANE 117661 . 118235)) (119671 120562 (TEDITWINDOWP
119681 . 120560)) (120599 123702 (TEDIT.GETINPUT 120609 . 123052) (\TEDIT.MAKEFILENAME 123054 . 123700
)) (123751 131378 (TEDIT.PROMPTWINDOW 123761 . 124075) (TEDIT.PROMPTPRINT 124077 . 126704) (
TEDIT.PROMPTCLEAR 126706 . 128425) (TEDIT.PROMPTFLASH 128427 . 129685) (\TEDIT.PROMPT.PAGEFULLFN
129687 . 131376)) (131616 142020 (\TEDIT.FILENAME 131626 . 132398) (\TEDIT.DEFAULT.TITLE 132400 .
134779) (\TEDIT.WINDOW.TITLE 134781 . 136950) (\TEDIT.LIKELY.FILENAME 136952 . 139502) (
\TEDIT.UPDATE.TITLE 139504 . 142018)) (142063 154547 (TEDIT.DEACTIVATE.WINDOW 142073 . 147646) (
\TEDIT.RESHAPEFN 147648 . 149733) (\TEDIT.REPAINTFN 149735 . 149959) (\TEDIT.CLOSESPLITS 149961 .
152406) (\TEDIT.CLOSEPANE 152408 . 154545)) (154548 197347 (\TEDIT.SCROLLFN 154558 . 156789) (
\TEDIT.SCROLLCH.TOP 156791 . 158902) (\TEDIT.SCROLLCH.BOTTOM 158904 . 163234) (\TEDIT.SCROLLUP 163236
. 168962) (\TEDIT.TOPLINE.YTOP 168964 . 170633) (\TEDIT.SCROLLDOWN 170635 . 177674) (
\TEDIT.SCROLL.CARET 177676 . 180514) (\TEDIT.VISIBLECARETP 180516 . 182810) (\TEDIT.VISIBLECHARP
182812 . 183903) (\TEDIT.BITMAPLINES 183905 . 187825) (\TEDIT.SETPANE.TOPLINE 187827 . 188439) (
\TEDIT.SHIFTLINES 188441 . 197345)) (197348 208217 (\TEDIT.ONSCREEN? 197358 . 201909) (
\TEDIT.ONSCREEN.REGION 201911 . 205562) (\TEDIT.AFTERMOVEFN 205564 . 206461) (OFFSCREENP 206463 .
208215)) (208259 211073 (\TEDIT.PROCIDLEFN 208269 . 209929) (\TEDIT.PROCENTRYFN 209931 . 210376) (
\TEDIT.PROCEXITFN 210378 . 211071)) (211152 224377 (\TEDIT.DOWNCARET 211162 . 211955) (
\TEDIT.FLASHCARET 211957 . 214068) (\TEDIT.UPCARET 214070 . 215174) (TEDIT.NORMALIZECARET 215176 .
218394) (\TEDIT.SETCARET 218396 . 223747) (\TEDIT.CARET 223749 . 224375)))))
(FILEMAP (NIL (17104 18000 (TEDIT.DEFER.UPDATES 17114 . 17998)) (18001 43946 (\TEDIT.WINDOW.CREATE
18011 . 25341) (\TEDIT.WINDOW.GETREGION 25343 . 28833) (\TEDIT.WINDOW.SETUP 28835 . 33165) (
\TEDIT.MINIMAL.WINDOW.SETUP 33167 . 40578) (\TEDIT.CLEARPANE 40580 . 41297) (\TEDIT.FILL.PANES 41299
. 43944)) (43947 67648 (\TEDIT.CURSORMOVEDFN 43957 . 49567) (\TEDIT.CURSOROUTFN 49569 . 50257) (
\TEDIT.ACTIVE.WINDOWP 50259 . 51329) (\TEDIT.EXPANDFN 51331 . 51894) (\TEDIT.MAINW 51896 . 53176) (
\TEDIT.MAINSTREAM 53178 . 53512) (\TEDIT.PRIMARYPANE 53514 . 54284) (\TEDIT.PANELIST 54286 . 54782) (
\TEDIT.NEWREGIONFN 54784 . 57300) (\TEDIT.SET.WINDOW.EXTENT 57302 . 62284) (\TEDIT.SHRINK.ICONCREATE
62286 . 65019) (\TEDIT.SHRINKFN 65021 . 65430) (\TEDIT.PANEREGION 65432 . 67646)) (67680 100726 (
\TEDIT.BUTTONEVENTFN 67690 . 80663) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80665 . 87928) (
\TEDIT.BUTTONEVENTFN.GETOPERATION 87930 . 89772) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89774 . 93444) (
\TEDIT.BUTTONEVENTFN.INACTIVE 93446 . 95876) (\TEDIT.BUTTONEVENTFN.INTITLE 95878 . 97713) (
\TEDIT.COPYINSERTFN 97715 . 98847) (\TEDIT.FOREIGN.COPY 98849 . 100724)) (100727 117969 (
\TEDIT.PANE.SPLIT 100737 . 104685) (\TEDIT.SPLITW 104687 . 112425) (\TEDIT.UNSPLITW 112427 . 116626) (
\TEDIT.LINKPANES 116628 . 117391) (\TEDIT.UNLINKPANE 117393 . 117967)) (119403 120294 (TEDITWINDOWP
119413 . 120292)) (120331 123434 (TEDIT.GETINPUT 120341 . 122784) (\TEDIT.MAKEFILENAME 122786 . 123432
)) (123483 131110 (TEDIT.PROMPTWINDOW 123493 . 123807) (TEDIT.PROMPTPRINT 123809 . 126436) (
TEDIT.PROMPTCLEAR 126438 . 128157) (TEDIT.PROMPTFLASH 128159 . 129417) (\TEDIT.PROMPT.PAGEFULLFN
129419 . 131108)) (131348 141752 (\TEDIT.FILENAME 131358 . 132130) (\TEDIT.DEFAULT.TITLE 132132 .
134511) (\TEDIT.WINDOW.TITLE 134513 . 136682) (\TEDIT.LIKELY.FILENAME 136684 . 139234) (
\TEDIT.UPDATE.TITLE 139236 . 141750)) (141795 154279 (TEDIT.DEACTIVATE.WINDOW 141805 . 147378) (
\TEDIT.RESHAPEFN 147380 . 149465) (\TEDIT.REPAINTFN 149467 . 149691) (\TEDIT.CLOSESPLITS 149693 .
152138) (\TEDIT.CLOSEPANE 152140 . 154277)) (154280 197079 (\TEDIT.SCROLLFN 154290 . 156521) (
\TEDIT.SCROLLCH.TOP 156523 . 158634) (\TEDIT.SCROLLCH.BOTTOM 158636 . 162966) (\TEDIT.SCROLLUP 162968
. 168694) (\TEDIT.TOPLINE.YTOP 168696 . 170365) (\TEDIT.SCROLLDOWN 170367 . 177406) (
\TEDIT.SCROLL.CARET 177408 . 180246) (\TEDIT.VISIBLECARETP 180248 . 182542) (\TEDIT.VISIBLECHARP
182544 . 183635) (\TEDIT.BITMAPLINES 183637 . 187557) (\TEDIT.SETPANE.TOPLINE 187559 . 188171) (
\TEDIT.SHIFTLINES 188173 . 197077)) (197080 207949 (\TEDIT.ONSCREEN? 197090 . 201641) (
\TEDIT.ONSCREEN.REGION 201643 . 205294) (\TEDIT.AFTERMOVEFN 205296 . 206193) (OFFSCREENP 206195 .
207947)) (207991 210805 (\TEDIT.PROCIDLEFN 208001 . 209661) (\TEDIT.PROCENTRYFN 209663 . 210108) (
\TEDIT.PROCEXITFN 210110 . 210803)) (210884 224109 (\TEDIT.DOWNCARET 210894 . 211687) (
\TEDIT.FLASHCARET 211689 . 213800) (\TEDIT.UPCARET 213802 . 214906) (TEDIT.NORMALIZECARET 214908 .
218126) (\TEDIT.SETCARET 218128 . 223479) (\TEDIT.CARET 223481 . 224107)))))
STOP

BIN
library/tedit/TEDIT-WINDOW.LCOM
View File

Binary file not shown.