From b7458b24be0bb058cbf624c3a0545b3431ab9b68 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Mon, 22 Feb 2021 18:09:07 -0800 Subject: [PATCH] Restore fontprofile (#200) * restore FONTPROFILE and PATCH * extra (dup) version --- sources/FONTPROFILE | 1 + sources/FONTPROFILE.~1~ | 1 + sources/FONTPROFILEPATCH | 1 + sources/FONTPROFILEPATCH.LCOM | Bin 0 -> 10893 bytes 4 files changed, 3 insertions(+) create mode 100644 sources/FONTPROFILE create mode 100644 sources/FONTPROFILE.~1~ create mode 100644 sources/FONTPROFILEPATCH create mode 100644 sources/FONTPROFILEPATCH.LCOM diff --git a/sources/FONTPROFILE b/sources/FONTPROFILE new file mode 100644 index 00000000..23f0bb6a --- /dev/null +++ b/sources/FONTPROFILE @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "28-Jun-99 22:10:46" {DSK}medley3.5>sources>FONTPROFILE.;2 29960 changes to%: (VARS FONTPROFILECOMS) (ALISTS (FONTDEFS NS) (FONTDEFS BIGGERNS)) previous date%: " 9-Jul-91 18:38:04" {DSK}medley3.5>sources>FONTPROFILE.;1) (* ; " Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT FONTPROFILECOMS) (RPAQQ FONTPROFILECOMS ( (* ;; "FONT") (ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER NS BIGGERNS)) (ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)) [VARS (FONTVARS '( (* ;; "standard size fonts. Assumes only DEFAULTFONT set") (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD)) (* ; "default BOLD") (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC)) (LITTLEFONT DEFAULTFONT) (* ; " should usually be smaller") (TINYFONT LITTLEFONT) (* ; "and this one smaller still") (BIGFONT BOLDFONT) (* ; "should be bigger still") (TEXTFONT DEFAULTFONT) (* ; "default for text") (TEXTBOLDFONT BOLDFONT) (* ; "default for bold text") (* ;; "") (* ;; "Fonts for window system, processes") (* ;; "") (MENUFONT DEFAULTFONT T) (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD)) (* ; "if not supplied") (INTERRUPTMENUFONT DEFAULTFONT T) (* ; "used by control-B") (DEFAULTICONFONT MENUFONT) (* ; "for shrinking windows") (BACKTRACEFONT TINYFONT T) (* ; " for backtrace in debugger") (WINDOWTITLEFONT MENUFONT) ((WINDOWTITLEFONT WINDOWTITLEFONT) NIL) (* ; " used for titles of all windows") (* ;; "") (* ;; "Fonts for Exec") (* ;; "") (PROMPTFONT LITTLEFONT) (* ; "for printing out prompts") (INPUTFONT BOLDFONT) (* ; "for user typein in Exec") (PRINTOUTFONT DEFAULTFONT) (* ; " for intermediate typin in Exec") (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT)) (VALUEFONT DEFAULTFONT) (* ;  " for printing out values returned in Exec") (* ;; "") (* ;; "Fonts for prettyprinting") (* ;; "") (COMMENTFONT LITTLEFONT) (* ; "for comments ") (PRETTYCOMFONT BOLDFONT) (* ; " for words being defined") (CLISPFONT BOLDFONT) (* ; " for keywords & CLISP") (SYSTEMFONT DEFAULTFONT) (* ; " for %"system%" words(?)") (LAMBDAFONT BIGFONT) (* ; "for words being defined") (USERFONT BOLDFONT) (* ; " for %"user%" defined words")] (P (MOVD? 'NILL 'WINDOWTITLEFONT)) (FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE) (INITVARS (FONTESCAPECHAR (CHARACTER 6)) (FONTFNS) (FONTWORDS)) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (FONTSET 'STANDARD] (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS) (FNS FONTMAPARRAY) (INITVARS (\FONTMAPCACHE)) (P (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL)))) (* ;; "FONT") (ADDTOVAR FONTDEFS [HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24) NIL (TERMINAL 8)) (BOLDFONT 2 (MODERN 24 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 18 MRR) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 36 BRR) NIL (MODERN 10 BRR)) (TEXTFONT 5 (CLASSIC 24) NIL (CLASSIC 10)) (TEXTBOLDFONT 7 (CLASSIC 24 BRR) NIL (CLASSIC 10 BRR] [BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18) NIL (TERMINAL 8)) (TEXTFONT 5 (CLASSIC 18) NIL (CLASSIC 10)) (BOLDFONT 2 (MODERN 18 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 12 MRR) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 24 BRR) NIL (MODERN 10 BRR)) (TEXTBOLDFONT 7 (CLASSIC 18 BRR) NIL (CLASSIC 10 BRR] [MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14) NIL (TERMINAL 8)) (BOLDFONT 2 (MODERN 14 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 10) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 18) NIL (MODERN 10 BRR)) (TEXTFONT 5 (CLASSIC 14) NIL (CLASSIC 10)) (TEXTBOLDFONT 7 (CLASSIC 14 BRR) NIL (CLASSIC 10 BRR] [STANDARD (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (FONTPROFILE (DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) (ITALICFONT 1 (HELVETICA 10 MIR) (GACHA 8 MIR) (MODERN 8 MIR)) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR)) (TINYFONT 6 (GACHA 8) (GACHA 6) (TERMINAL 6)) (BIGFONT 4 (HELVETICA 12 BRR) NIL (MODERN 10 BRR)) (MENUFONT 5 (HELVETICA 10)) (COMMENTFONT 6 (HELVETICA 10) (HELVETICA 8) (MODERN 8)) (TEXTFONT 7 (TIMESROMAN 10) NIL (CLASSIC 10] [BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12) NIL (TERMINAL 8)) (ITALICFONT 1 (HELVETICA 12 MIR) (GACHA 8 MIR) (MODERN 8 MIR)) (BOLDFONT 2 (HELVETICA 12 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (HELVETICA 10) (HELVETICA 6 MIR) (MODERN 8 MIR)) (TINYFONT 6 (GACHA 10) (GACHA 6) (TERMINAL 6)) (BIGFONT 4 (HELVETICA 14 BRR) NIL (MODERN 10 BRR)) (MENUFONT 5 (HELVETICA 12)) (COMMENTFONT 6 (HELVETICA 12) (HELVETICA 8) (MODERN 8)) (TEXTFONT 7 (TIMESROMAN 12) NIL (CLASSIC 10] [NS (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (COMMENTLINELENGTH 116 . 126) (FIRSTCOL . 60) (PRETTYLCOM . 25) (FONTESCAPECHAR . %) (FONTPROFILE (DEFAULTFONT 1 (TERMINAL 10) (TERMINAL 8) (TERMINAL 8)) (ITALICFONT 1 (MODERN 10 BIR) (MODERN 8 BIR) (MODERN 8 BIR)) (BOLDFONT 2 (MODERN 10 BRR) (MODERN 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 8) (MODERN 6 MIR) (MODERN 8 MIR)) (BIGFONT 4 (MODERN 12 BRR) (MODERN 10 BRR) (MODERN 10 BRR] [BIGGERNS (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (COMMENTLINELENGTH 116 . 126) (FIRSTCOL . 60) (PRETTYLCOM . 25) (FONTESCAPECHAR . %) (FONTPROFILE (DEFAULTFONT 1 (TERMINAL 12) (TERMINAL 8) (TERMINAL 8)) (ITALICFONT 1 (MODERN 12 BIR) (MODERN 8 BIR) (MODERN 8 BIR)) (BOLDFONT 2 (MODERN 12 BRR) (MODERN 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 10) (MODERN 6 MIR) (MODERN 8 MIR)) (BIGFONT 4 (MODERN 14 BRR) (MODERN 10 BRR) (MODERN 10 BRR]) (ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu) (RPAQQ FONTVARS ( (* ;; "standard size fonts. Assumes only DEFAULTFONT set") (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD)) (* ; "default BOLD") (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC)) (LITTLEFONT DEFAULTFONT) (* ; " should usually be smaller") (TINYFONT LITTLEFONT) (* ; "and this one smaller still") (BIGFONT BOLDFONT) (* ; "should be bigger still") (TEXTFONT DEFAULTFONT) (* ; "default for text") (TEXTBOLDFONT BOLDFONT) (* ; "default for bold text") (* ;; "") (* ;; "Fonts for window system, processes") (* ;; "") (MENUFONT DEFAULTFONT T) (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD)) (* ; "if not supplied") (INTERRUPTMENUFONT DEFAULTFONT T) (* ; "used by control-B") (DEFAULTICONFONT MENUFONT) (* ; "for shrinking windows") (BACKTRACEFONT TINYFONT T) (* ; " for backtrace in debugger") (WINDOWTITLEFONT MENUFONT) ((WINDOWTITLEFONT WINDOWTITLEFONT) NIL) (* ; " used for titles of all windows") (* ;; "") (* ;; "Fonts for Exec") (* ;; "") (PROMPTFONT LITTLEFONT) (* ; "for printing out prompts") (INPUTFONT BOLDFONT) (* ; "for user typein in Exec") (PRINTOUTFONT DEFAULTFONT) (* ; " for intermediate typin in Exec") (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT)) (VALUEFONT DEFAULTFONT) (* ;  " for printing out values returned in Exec") (* ;; "") (* ;; "Fonts for prettyprinting") (* ;; "") (COMMENTFONT LITTLEFONT) (* ; "for comments ") (PRETTYCOMFONT BOLDFONT) (* ; " for words being defined") (CLISPFONT BOLDFONT) (* ; " for keywords & CLISP") (SYSTEMFONT DEFAULTFONT) (* ; " for %"system%" words(?)") (LAMBDAFONT BIGFONT) (* ; "for words being defined") (USERFONT BOLDFONT) (* ; " for %"user%" defined words"))) (MOVD? 'NILL 'WINDOWTITLEFONT) (DEFINEQ (FONTSET [LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds") (COND [NAME (LET [(TEM (FASSOC NAME FONTDEFS)) (OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY] (OR TEM (ERROR NAME "not a defined font configuration")) (* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.") (for X in FONTVARS when (AND (CL:SYMBOLP (CAR X)) (NEQ (CAR X) '*) (NEQ (CAR X) (CADR X))) do (SETTOPVAL (CAR X))) [MAPC (CDR TEM) (FUNCTION (LAMBDA (X) (/SETTOPVAL (CAR X) (CDR X] [PROG (BASICCLASSES) (for X in FONTPROFILE do (PROG (SEEN (NAME (CAR X)) (FONTS X)) LP [COND ((MEMB (CAR FONTS) SEEN) (ERROR "Circular font profile specification" X)) (T (push SEEN (CAR FONTS] [SETQ FONTS (CDR (COND ((OR (NULL (CADR FONTS)) (LISTP (CADR FONTS))) (*) (* ;  "This skips over the now-defunct NIL or list-of-escape sequence") (CDR FONTS)) (T FONTS] (COND ((OR (NLISTP FONTS) (LITATOM (CAR FONTS)))(* ;  "Indirect thru another's font spec") (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) ((NIL DEFAULTFONT) (* ;  "Don't let DEFAULTFONT loop thru itself") (AND (NOT (MEMB 'DEFAULTFONT SEEN )) 'DEFAULTFONT)) (CAR FONTS)) FONTPROFILE)) (GO LP))) (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* ;  "Now we have a font class datastructure") )) (AND NAME (/SETTOPVAL NAME FONTS)) (* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.") )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] [for X in FONTVARS when (NEQ (CAR X) '*) do (COND ((LISTP (CAR X)) (EVAL (CAR X))) [(CADDR X) (SET (CAR X) (FONTCREATE (OR (GETTOPVAL (CAR X)) (EVAL (CADR X)) DEFAULTFONT) NIL NIL NIL 'DISPLAY] (T (OR (GETTOPVAL (CAR X)) (AND (CADR X) (SET (CAR X) (EVAL (CADR X] (CL:WHEN CHANGE-WINDOWS? (CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY)) (for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X)) do (DSPFONT DEFAULTFONT X))) (DSPFONT WINDOWTITLEFONT WindowTitleDisplayStream) (SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT))) (MAPC CACHEDMENUS 'SET) [for W in (OPENWINDOWS) do [COND [(OR (EQ (WINDOWPROP W 'RESHAPEFN) 'DONT) (WINDOWPROP W 'MAINWINDOW] (T (* ;;  "don't reshape if can't or if this window is attached to another.") (SHAPEW W (WINDOWREGION W] (COND ((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN) (FUNCTION \TEDIT.PROCIDLEFN)) (WINDOWPROP W 'REPAINTFN)) (REDISPLAYW W]) (* ;; "Set the new font profile name, and return the old one, so he can restore later.") (PROG1 FONTNAME (SETQ FONTNAME NAME] (T (* ;  "He passed in NIL, so return font profile name in effect.") FONTNAME]) (FONTPROFILE [LAMBDA (PROFILE) (* lmm "10-Sep-86 12:33") [PROG (BASICCLASSES) (for X in PROFILE do (PROG (SEEN (NAME (CAR X)) (FONTS X)) LP [COND ((MEMB (CAR FONTS) SEEN) (ERROR "Circular font profile specification" X)) (T (push SEEN (CAR FONTS] [SETQ FONTS (CDR (COND ((OR (NULL (CADR FONTS)) (LISTP (CADR FONTS))) (* ; "This skips over the now-defunct NIL or list-of-escape sequence") (CDR FONTS)) (T FONTS] (COND ((OR (NLISTP FONTS) (LITATOM (CAR FONTS))) (* Indirect thru another's font spec) (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) ((NIL DEFAULTFONT) (* Don't let DEFAULTFONT loop thru itself) (AND (NOT (MEMB 'DEFAULTFONT SEEN)) 'DEFAULTFONT)) (CAR FONTS)) PROFILE)) (GO LP))) (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* Now we have a font class datastructure) )) (AND NAME (/SETATOMVAL NAME FONTS)) (* NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.) )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] T]) (FONTPROFILE.ADDDEVICE [LAMBDA (NEWDEVICE OLDDEVICE) (* ; "Edited 3-Mar-93 14:46 by rmk:") (* ;; "Fills in all fontprofile specifications so that an entry for NEWDEVICE is present for each fontclass. Nothing is changed if the entry is already there, otherwise the specification for the class currently provided for OLDDEVICE will be used for NEWDEVICE.") (DECLARE (USEDFREE FONTDEFS FONTNAME)) (SETQ NEWDEVICE (U-CASE NEWDEVICE)) (SETQ OLDDEVICE (U-CASE OLDDEVICE)) [FOR FD IN FONTDEFS DO (FOR FC OLDSPEC IN (CDR (ASSOC 'FONTPROFILE (CDR FD))) UNLESS (LITATOM (CADR FC)) DO (SETQ FC (CDR FC)) (* ; "Skip over name") (CL:WHEN [SETQ OLDSPEC (SELECTQ OLDDEVICE (DISPLAY (CADR FC)) (INTERPRESS (CADDDR FC)) (PRESS (CADDR FC)) (CADR (ASSOC OLDDEVICE (CDDDDR FC] [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] (* ;  "Fill in NIL's for missing DISPLAY, PRESS, or INTERPRESS") [SELECTQ NEWDEVICE (DISPLAY (OR (CAR FC) (RPLACA FC OLDSPEC))) (INTERPRESS (OR (CADDR FC) (RPLACA [PROGN [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] (OR (CDR FC) (CDR (RPLACD FC (CONS] OLDSPEC))) (PRESS (OR (CADDR FC) (RPLACA [OR (CDR FC) (CDR (RPLACD FC (CONS] OLDSPEC))) (OR (CADR (ASSOC NEWDEVICE (CDDDR FC))) (PROGN (PROGN [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] (PUSH (CDR FC) (LIST NEWDEVICE OLDSPEC])] (FONTSET FONTNAME]) ) (RPAQ? FONTESCAPECHAR (CHARACTER 6)) (RPAQ? FONTFNS ) (RPAQ? FONTWORDS ) (DECLARE%: DONTEVAL@LOAD DOCOPY (FONTSET 'STANDARD) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS) ) (DEFINEQ (FONTMAPARRAY [LAMBDA (FONTCLASSES) (* lmm "28-Sep-86 14:23") (* ;; "Makes a font array from a font-mapping list of fontclasses. The array provides a fast map from font# to font classes/descriptors. This function caches the last array. If IMAGETYPES is given, then the FD's are pre-computed for the imagetypes it. Otherwise, the first use of the fontclass for that imagetype would cause the fontcreate to be done.") (PROG (FA (MAXFONT 0) (MINFONT 100)) [COND ((NULL \FONTMAPCACHE)) ((OR (NULL FONTCLASSES) (EQUAL FONTCLASSES (CAR \FONTMAPCACHE))) (RETURN (CDR \FONTMAPCACHE] [for F PRETTYFONT# in FONTCLASSES do (SETQ PRETTYFONT# (fetch (FONTCLASS PRETTYFONT#) of F)) (COND ((IGREATERP PRETTYFONT# MAXFONT) (SETQ MAXFONT PRETTYFONT#))) (COND ((ILESSP PRETTYFONT# 1) (ERROR "Invalid font number" PRETTYFONT# F)) ((ILESSP PRETTYFONT# MINFONT) (SETQ MINFONT PRETTYFONT#] (SETQ FA (ARRAY MAXFONT)) (for F in FONTCLASSES do (SETA FA (fetch (FONTCLASS PRETTYFONT#) of F) F)) (for I from 1 to MAXFONT unless (ELT FA I) do (SETA FA I (ELT FA MINFONT))) (SETQ \FONTMAPCACHE (CONS (COPY FONTCLASSES) FA)) (RETURN FA]) ) (RPAQ? \FONTMAPCACHE ) (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL) (PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999)) (DECLARE%: DONTCOPY (FILEMAP (NIL (16000 27584 (FONTSET 16010 . 22351) (FONTPROFILE 22353 . 24702) (FONTPROFILE.ADDDEVICE 24704 . 27582)) (27820 29719 (FONTMAPARRAY 27830 . 29717))))) STOP \ No newline at end of file diff --git a/sources/FONTPROFILE.~1~ b/sources/FONTPROFILE.~1~ new file mode 100644 index 00000000..0d47afa2 --- /dev/null +++ b/sources/FONTPROFILE.~1~ @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 9-Jul-91 18:38:04" |{PELE:MV:ENVOS}SOURCES>FONTPROFILE.;3| 25066 changes to%: (VARS FONTPROFILECOMS) previous date%: "16-May-90 18:00:27" |{PELE:MV:ENVOS}SOURCES>FONTPROFILE.;2|) (* ; " Copyright (c) 1986, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT FONTPROFILECOMS) (RPAQQ FONTPROFILECOMS ( (* ;; "FONT") (ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER)) (ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)) [VARS (FONTVARS '( (* ;; "standard size fonts. Assumes only DEFAULTFONT set") (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD)) (* ; "default BOLD") (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC)) (LITTLEFONT DEFAULTFONT) (* ; " should usually be smaller") (TINYFONT LITTLEFONT) (* ; "and this one smaller still") (BIGFONT BOLDFONT) (* ; "should be bigger still") (TEXTFONT DEFAULTFONT) (* ; "default for text") (TEXTBOLDFONT BOLDFONT) (* ; "default for bold text") (* ;; "") (* ;; "Fonts for window system, processes") (* ;; "") (MENUFONT DEFAULTFONT T) (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD)) (* ; "if not supplied") (INTERRUPTMENUFONT DEFAULTFONT T) (* ; "used by control-B") (DEFAULTICONFONT MENUFONT) (* ; "for shrinking windows") (BACKTRACEFONT TINYFONT T) (* ; " for backtrace in debugger") (WINDOWTITLEFONT MENUFONT) ((WINDOWTITLEFONT WINDOWTITLEFONT) NIL) (* ; " used for titles of all windows") (* ;; "") (* ;; "Fonts for Exec") (* ;; "") (PROMPTFONT LITTLEFONT) (* ; "for printing out prompts") (INPUTFONT BOLDFONT) (* ; "for user typein in Exec") (PRINTOUTFONT DEFAULTFONT) (* ; " for intermediate typin in Exec") (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT)) (VALUEFONT DEFAULTFONT) (* ;  " for printing out values returned in Exec") (* ;; "") (* ;; "Fonts for prettyprinting") (* ;; "") (COMMENTFONT LITTLEFONT) (* ; "for comments ") (PRETTYCOMFONT BOLDFONT) (* ; " for words being defined") (CLISPFONT BOLDFONT) (* ; " for keywords & CLISP") (SYSTEMFONT DEFAULTFONT) (* ; " for %"system%" words(?)") (LAMBDAFONT BIGFONT) (* ; "for words being defined") (USERFONT BOLDFONT) (* ; " for %"user%" defined words")] (P (MOVD? 'NILL 'WINDOWTITLEFONT)) (FNS FONTSET FONTPROFILE) (INITVARS (FONTESCAPECHAR (CHARACTER 6)) (FONTFNS) (FONTWORDS)) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (FONTSET 'STANDARD] (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS) (FNS FONTMAPARRAY) (INITVARS (\FONTMAPCACHE)) (P (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL)))) (* ;; "FONT") (ADDTOVAR FONTDEFS [HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24) NIL (TERMINAL 8)) (BOLDFONT 2 (MODERN 24 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 18 MRR) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 36 BRR) NIL (MODERN 10 BRR)) (TEXTFONT 5 (CLASSIC 24) NIL (CLASSIC 10)) (TEXTBOLDFONT 7 (CLASSIC 24 BRR) NIL (CLASSIC 10 BRR] [BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18) NIL (TERMINAL 8)) (TEXTFONT 5 (CLASSIC 18) NIL (CLASSIC 10)) (BOLDFONT 2 (MODERN 18 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 12 MRR) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 24 BRR) NIL (MODERN 10 BRR)) (TEXTBOLDFONT 7 (CLASSIC 18 BRR) NIL (CLASSIC 10 BRR] [MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14) NIL (TERMINAL 8)) (BOLDFONT 2 (MODERN 14 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 10) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 18) NIL (MODERN 10 BRR)) (TEXTFONT 5 (CLASSIC 14) NIL (CLASSIC 10)) (TEXTBOLDFONT 7 (CLASSIC 14 BRR) NIL (CLASSIC 10 BRR] [STANDARD (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (FONTPROFILE (DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) (ITALICFONT 1 (HELVETICA 10 MIR) (GACHA 8 MIR) (MODERN 8 MIR)) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR)) (TINYFONT 6 (GACHA 8) (GACHA 6) (TERMINAL 6)) (BIGFONT 4 (HELVETICA 12 BRR) NIL (MODERN 10 BRR)) (MENUFONT 5 (HELVETICA 10)) (COMMENTFONT 6 (HELVETICA 10) (HELVETICA 8) (MODERN 8)) (TEXTFONT 7 (TIMESROMAN 10) NIL (CLASSIC 10] [BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12) NIL (TERMINAL 8)) (ITALICFONT 1 (HELVETICA 12 MIR) (GACHA 8 MIR) (MODERN 8 MIR)) (BOLDFONT 2 (HELVETICA 12 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (HELVETICA 10) (HELVETICA 6 MIR) (MODERN 8 MIR)) (TINYFONT 6 (GACHA 10) (GACHA 6) (TERMINAL 6)) (BIGFONT 4 (HELVETICA 14 BRR) NIL (MODERN 10 BRR)) (MENUFONT 5 (HELVETICA 12)) (COMMENTFONT 6 (HELVETICA 12) (HELVETICA 8) (MODERN 8)) (TEXTFONT 7 (TIMESROMAN 12) NIL (CLASSIC 10]) (ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu) (RPAQQ FONTVARS ( (* ;; "standard size fonts. Assumes only DEFAULTFONT set") (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD)) (* ; "default BOLD") (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC)) (LITTLEFONT DEFAULTFONT) (* ; " should usually be smaller") (TINYFONT LITTLEFONT) (* ; "and this one smaller still") (BIGFONT BOLDFONT) (* ; "should be bigger still") (TEXTFONT DEFAULTFONT) (* ; "default for text") (TEXTBOLDFONT BOLDFONT) (* ; "default for bold text") (* ;; "") (* ;; "Fonts for window system, processes") (* ;; "") (MENUFONT DEFAULTFONT T) (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD)) (* ; "if not supplied") (INTERRUPTMENUFONT DEFAULTFONT T) (* ; "used by control-B") (DEFAULTICONFONT MENUFONT) (* ; "for shrinking windows") (BACKTRACEFONT TINYFONT T) (* ; " for backtrace in debugger") (WINDOWTITLEFONT MENUFONT) ((WINDOWTITLEFONT WINDOWTITLEFONT) NIL) (* ; " used for titles of all windows") (* ;; "") (* ;; "Fonts for Exec") (* ;; "") (PROMPTFONT LITTLEFONT) (* ; "for printing out prompts") (INPUTFONT BOLDFONT) (* ; "for user typein in Exec") (PRINTOUTFONT DEFAULTFONT) (* ; " for intermediate typin in Exec") (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT)) (VALUEFONT DEFAULTFONT) (* ;  " for printing out values returned in Exec") (* ;; "") (* ;; "Fonts for prettyprinting") (* ;; "") (COMMENTFONT LITTLEFONT) (* ; "for comments ") (PRETTYCOMFONT BOLDFONT) (* ; " for words being defined") (CLISPFONT BOLDFONT) (* ; " for keywords & CLISP") (SYSTEMFONT DEFAULTFONT) (* ; " for %"system%" words(?)") (LAMBDAFONT BIGFONT) (* ; "for words being defined") (USERFONT BOLDFONT) (* ; " for %"user%" defined words"))) (MOVD? 'NILL 'WINDOWTITLEFONT) (DEFINEQ (FONTSET [LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds") (COND [NAME (LET [(TEM (FASSOC NAME FONTDEFS)) (OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY] (OR TEM (ERROR NAME "not a defined font configuration")) (* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.") (for X in FONTVARS when (AND (CL:SYMBOLP (CAR X)) (NEQ (CAR X) '*) (NEQ (CAR X) (CADR X))) do (SETTOPVAL (CAR X))) [MAPC (CDR TEM) (FUNCTION (LAMBDA (X) (/SETTOPVAL (CAR X) (CDR X] [PROG (BASICCLASSES) (for X in FONTPROFILE do (PROG (SEEN (NAME (CAR X)) (FONTS X)) LP [COND ((MEMB (CAR FONTS) SEEN) (ERROR "Circular font profile specification" X)) (T (push SEEN (CAR FONTS] [SETQ FONTS (CDR (COND ((OR (NULL (CADR FONTS)) (LISTP (CADR FONTS))) (*) (* ;  "This skips over the now-defunct NIL or list-of-escape sequence") (CDR FONTS)) (T FONTS] (COND ((OR (NLISTP FONTS) (LITATOM (CAR FONTS)))(* ;  "Indirect thru another's font spec") (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) ((NIL DEFAULTFONT) (* ;  "Don't let DEFAULTFONT loop thru itself") (AND (NOT (MEMB 'DEFAULTFONT SEEN )) 'DEFAULTFONT)) (CAR FONTS)) FONTPROFILE)) (GO LP))) (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* ;  "Now we have a font class datastructure") )) (AND NAME (/SETTOPVAL NAME FONTS)) (* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.") )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] [for X in FONTVARS when (NEQ (CAR X) '*) do (COND ((LISTP (CAR X)) (EVAL (CAR X))) [(CADDR X) (SET (CAR X) (FONTCREATE (OR (GETTOPVAL (CAR X)) (EVAL (CADR X)) DEFAULTFONT) NIL NIL NIL 'DISPLAY] (T (OR (GETTOPVAL (CAR X)) (AND (CADR X) (SET (CAR X) (EVAL (CADR X] (CL:WHEN CHANGE-WINDOWS? (CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY)) (for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X)) do (DSPFONT DEFAULTFONT X))) (DSPFONT WINDOWTITLEFONT WindowTitleDisplayStream) (SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT))) (MAPC CACHEDMENUS 'SET) [for W in (OPENWINDOWS) do [COND [(OR (EQ (WINDOWPROP W 'RESHAPEFN) 'DONT) (WINDOWPROP W 'MAINWINDOW] (T (* ;;  "don't reshape if can't or if this window is attached to another.") (SHAPEW W (WINDOWREGION W] (COND ((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN) (FUNCTION \TEDIT.PROCIDLEFN)) (WINDOWPROP W 'REPAINTFN)) (REDISPLAYW W]) (* ;; "Set the new font profile name, and return the old one, so he can restore later.") (PROG1 FONTNAME (SETQ FONTNAME NAME] (T (* ;  "He passed in NIL, so return font profile name in effect.") FONTNAME]) (FONTPROFILE [LAMBDA (PROFILE) (* lmm "10-Sep-86 12:33") [PROG (BASICCLASSES) (for X in PROFILE do (PROG (SEEN (NAME (CAR X)) (FONTS X)) LP [COND ((MEMB (CAR FONTS) SEEN) (ERROR "Circular font profile specification" X)) (T (push SEEN (CAR FONTS] [SETQ FONTS (CDR (COND ((OR (NULL (CADR FONTS)) (LISTP (CADR FONTS))) (* ; "This skips over the now-defunct NIL or list-of-escape sequence") (CDR FONTS)) (T FONTS] (COND ((OR (NLISTP FONTS) (LITATOM (CAR FONTS))) (* Indirect thru another's font spec) (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) ((NIL DEFAULTFONT) (* Don't let DEFAULTFONT loop thru itself) (AND (NOT (MEMB 'DEFAULTFONT SEEN)) 'DEFAULTFONT)) (CAR FONTS)) PROFILE)) (GO LP))) (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* Now we have a font class datastructure) )) (AND NAME (/SETATOMVAL NAME FONTS)) (* NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.) )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] T]) ) (RPAQ? FONTESCAPECHAR (CHARACTER 6)) (RPAQ? FONTFNS ) (RPAQ? FONTWORDS ) (DECLARE%: DONTEVAL@LOAD DOCOPY (FONTSET 'STANDARD) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS) ) (DEFINEQ (FONTMAPARRAY [LAMBDA (FONTCLASSES) (* lmm "28-Sep-86 14:23") (* ;; "Makes a font array from a font-mapping list of fontclasses. The array provides a fast map from font# to font classes/descriptors. This function caches the last array. If IMAGETYPES is given, then the FD's are pre-computed for the imagetypes it. Otherwise, the first use of the fontclass for that imagetype would cause the fontcreate to be done.") (PROG (FA (MAXFONT 0) (MINFONT 100)) [COND ((NULL \FONTMAPCACHE)) ((OR (NULL FONTCLASSES) (EQUAL FONTCLASSES (CAR \FONTMAPCACHE))) (RETURN (CDR \FONTMAPCACHE] [for F PRETTYFONT# in FONTCLASSES do (SETQ PRETTYFONT# (fetch (FONTCLASS PRETTYFONT#) of F)) (COND ((IGREATERP PRETTYFONT# MAXFONT) (SETQ MAXFONT PRETTYFONT#))) (COND ((ILESSP PRETTYFONT# 1) (ERROR "Invalid font number" PRETTYFONT# F)) ((ILESSP PRETTYFONT# MINFONT) (SETQ MINFONT PRETTYFONT#] (SETQ FA (ARRAY MAXFONT)) (for F in FONTCLASSES do (SETA FA (fetch (FONTCLASS PRETTYFONT#) of F) F)) (for I from 1 to MAXFONT unless (ELT FA I) do (SETA FA I (ELT FA MINFONT))) (SETQ \FONTMAPCACHE (CONS (COPY FONTCLASSES) FA)) (RETURN FA]) ) (RPAQ? \FONTMAPCACHE ) (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL) (PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991)) (DECLARE%: DONTCOPY (FILEMAP (NIL (13991 22695 (FONTSET 14001 . 20342) (FONTPROFILE 20344 . 22693)) (22931 24830 ( FONTMAPARRAY 22941 . 24828))))) STOP \ No newline at end of file diff --git a/sources/FONTPROFILEPATCH b/sources/FONTPROFILEPATCH new file mode 100644 index 00000000..5704dd91 --- /dev/null +++ b/sources/FONTPROFILEPATCH @@ -0,0 +1 @@ +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "12-Mar-93 11:02:28" {DSK}medley2.0>patches>FONTPROFILEPATCH.;4 30621 changes to%: (ALISTS (FONTDEFS HUGE) (FONTDEFS BIG) (FONTDEFS MEDIUM) (FONTDEFS STANDARD) (FONTDEFS BIGGER) (FONTDEFS BIGGERNS) (FONTDEFS NS)) previous date%: "11-Mar-93 11:51:49" {DSK}medley2.0>patches>FONTPROFILEPATCH.;3) (* ; " Copyright (c) 1993 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT FONTPROFILEPATCHCOMS) (RPAQQ FONTPROFILEPATCHCOMS ( (* ;; "FONT") (ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER BIGGERNS NS)) (ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)) [VARS (FONTVARS '( (* ;; "standard size fonts. Assumes only DEFAULTFONT set") (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD)) (* ; "default BOLD") (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC)) (LITTLEFONT DEFAULTFONT) (* ; " should usually be smaller") (TINYFONT LITTLEFONT) (* ; "and this one smaller still") (BIGFONT BOLDFONT) (* ; "should be bigger still") (TEXTFONT DEFAULTFONT) (* ; "default for text") (TEXTBOLDFONT BOLDFONT) (* ; "default for bold text") (* ;; "") (* ;; "Fonts for window system, processes") (* ;; "") (MENUFONT DEFAULTFONT T) (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD)) (* ; "if not supplied") (INTERRUPTMENUFONT DEFAULTFONT T) (* ; "used by control-B") (DEFAULTICONFONT MENUFONT) (* ; "for shrinking windows") (BACKTRACEFONT TINYFONT T) (* ; " for backtrace in debugger") (WINDOWTITLEFONT MENUFONT) ((WINDOWTITLEFONT WINDOWTITLEFONT) NIL) (* ; " used for titles of all windows") (* ;; "") (* ;; "Fonts for Exec") (* ;; "") (PROMPTFONT LITTLEFONT) (* ; "for printing out prompts") (INPUTFONT BOLDFONT) (* ; "for user typein in Exec") (PRINTOUTFONT DEFAULTFONT) (* ; " for intermediate typin in Exec") (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT)) (VALUEFONT DEFAULTFONT) (* ;  " for printing out values returned in Exec") (* ;; "") (* ;; "Fonts for prettyprinting") (* ;; "") (COMMENTFONT LITTLEFONT) (* ; "for comments ") (PRETTYCOMFONT BOLDFONT) (* ; " for words being defined") (CLISPFONT BOLDFONT) (* ; " for keywords & CLISP") (SYSTEMFONT DEFAULTFONT) (* ; " for %"system%" words(?)") (LAMBDAFONT BIGFONT) (* ; "for words being defined") (USERFONT BOLDFONT) (* ; " for %"user%" defined words")] (P (MOVD? 'NILL 'WINDOWTITLEFONT)) (FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE) (INITVARS (FONTESCAPECHAR (CHARACTER 6)) (FONTFNS) (FONTWORDS)) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (FONTSET 'STANDARD] (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS) (FNS FONTMAPARRAY) (INITVARS (\FONTMAPCACHE)) (P (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL)))) (* ;; "FONT") (ADDTOVAR FONTDEFS [HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24) NIL (TERMINAL 8)) (BOLDFONT 2 (MODERN 24 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 18 MRR) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 36 BRR) NIL (MODERN 10 BRR)) (TEXTFONT 5 (CLASSIC 24) NIL (CLASSIC 10)) (TEXTBOLDFONT 7 (CLASSIC 24 BRR) NIL (CLASSIC 10 BRR] [BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18) NIL (TERMINAL 8)) (TEXTFONT 5 (CLASSIC 18) NIL (CLASSIC 10)) (BOLDFONT 2 (MODERN 18 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 12 MRR) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 24 BRR) NIL (MODERN 10 BRR)) (TEXTBOLDFONT 7 (CLASSIC 18 BRR) NIL (CLASSIC 10 BRR] [MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14) NIL (TERMINAL 8)) (BOLDFONT 2 (MODERN 14 BRR) NIL (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 10) NIL (MODERN 8 MIR)) (BIGFONT 4 (MODERN 18) NIL (MODERN 10 BRR)) (TEXTFONT 5 (CLASSIC 14) NIL (CLASSIC 10)) (TEXTBOLDFONT 7 (CLASSIC 14 BRR) NIL (CLASSIC 10 BRR] [STANDARD (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (FONTPROFILE (DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) (ITALICFONT 1 (HELVETICA 10 MIR) (GACHA 8 MIR) (MODERN 8 MIR)) (BOLDFONT 2 (HELVETICA 10 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (HELVETICA 8) (HELVETICA 6 MIR) (MODERN 8 MIR)) (TINYFONT 6 (GACHA 8) (GACHA 6) (TERMINAL 6)) (BIGFONT 4 (HELVETICA 12 BRR) NIL (MODERN 10 BRR)) (MENUFONT 5 (HELVETICA 10)) (COMMENTFONT 6 (HELVETICA 10) (HELVETICA 8) (MODERN 8)) (TEXTFONT 7 (TIMESROMAN 10) NIL (CLASSIC 10] [BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12) NIL (TERMINAL 8)) (ITALICFONT 1 (HELVETICA 12 MIR) (GACHA 8 MIR) (MODERN 8 MIR)) (BOLDFONT 2 (HELVETICA 12 BRR) (HELVETICA 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (HELVETICA 10) (HELVETICA 6 MIR) (MODERN 8 MIR)) (TINYFONT 6 (GACHA 10) (GACHA 6) (TERMINAL 6)) (BIGFONT 4 (HELVETICA 14 BRR) NIL (MODERN 10 BRR)) (MENUFONT 5 (HELVETICA 12)) (COMMENTFONT 6 (HELVETICA 12) (HELVETICA 8) (MODERN 8)) (TEXTFONT 7 (TIMESROMAN 12) NIL (CLASSIC 10] [BIGGERNS (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (COMMENTLINELENGTH 116 . 126) (FIRSTCOL . 60) (PRETTYLCOM . 25) (FONTESCAPECHAR . %) (FONTPROFILE (DEFAULTFONT 1 (TERMINAL 12) (TERMINAL 8) (TERMINAL 8)) (ITALICFONT 1 (MODERN 12 BIR) (MODERN 8 BIR) (MODERN 8 BIR)) (BOLDFONT 2 (MODERN 12 BRR) (MODERN 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 10) (MODERN 6 MIR) (MODERN 8 MIR)) (BIGFONT 4 (MODERN 14 BRR) (MODERN 10 BRR) (MODERN 10 BRR] [NS (FONTCHANGEFLG . ALL) (FILELINELENGTH . 102) (COMMENTLINELENGTH 116 . 126) (FIRSTCOL . 60) (PRETTYLCOM . 25) (FONTESCAPECHAR . %) (FONTPROFILE (DEFAULTFONT 1 (TERMINAL 10) (TERMINAL 8) (TERMINAL 8)) (ITALICFONT 1 (MODERN 10 BIR) (MODERN 8 BIR) (MODERN 8 BIR)) (BOLDFONT 2 (MODERN 10 BRR) (MODERN 8 BRR) (MODERN 8 BRR)) (LITTLEFONT 3 (MODERN 8) (MODERN 6 MIR) (MODERN 8 MIR)) (BIGFONT 4 (MODERN 12 BRR) (MODERN 10 BRR) (MODERN 10 BRR]) (ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu) (RPAQQ FONTVARS ( (* ;; "standard size fonts. Assumes only DEFAULTFONT set") (BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD)) (* ; "default BOLD") (ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC)) (LITTLEFONT DEFAULTFONT) (* ; " should usually be smaller") (TINYFONT LITTLEFONT) (* ; "and this one smaller still") (BIGFONT BOLDFONT) (* ; "should be bigger still") (TEXTFONT DEFAULTFONT) (* ; "default for text") (TEXTBOLDFONT BOLDFONT) (* ; "default for bold text") (* ;; "") (* ;; "Fonts for window system, processes") (* ;; "") (MENUFONT DEFAULTFONT T) (BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD)) (* ; "if not supplied") (INTERRUPTMENUFONT DEFAULTFONT T) (* ; "used by control-B") (DEFAULTICONFONT MENUFONT) (* ; "for shrinking windows") (BACKTRACEFONT TINYFONT T) (* ; " for backtrace in debugger") (WINDOWTITLEFONT MENUFONT) ((WINDOWTITLEFONT WINDOWTITLEFONT) NIL) (* ; " used for titles of all windows") (* ;; "") (* ;; "Fonts for Exec") (* ;; "") (PROMPTFONT LITTLEFONT) (* ; "for printing out prompts") (INPUTFONT BOLDFONT) (* ; "for user typein in Exec") (PRINTOUTFONT DEFAULTFONT) (* ; " for intermediate typin in Exec") (TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT)) (VALUEFONT DEFAULTFONT) (* ;  " for printing out values returned in Exec") (* ;; "") (* ;; "Fonts for prettyprinting") (* ;; "") (COMMENTFONT LITTLEFONT) (* ; "for comments ") (PRETTYCOMFONT BOLDFONT) (* ; " for words being defined") (CLISPFONT BOLDFONT) (* ; " for keywords & CLISP") (SYSTEMFONT DEFAULTFONT) (* ; " for %"system%" words(?)") (LAMBDAFONT BIGFONT) (* ; "for words being defined") (USERFONT BOLDFONT) (* ; " for %"user%" defined words"))) (MOVD? 'NILL 'WINDOWTITLEFONT) (DEFINEQ (FONTSET [LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds") (COND [NAME (LET [(TEM (FASSOC NAME FONTDEFS)) (OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY] (OR TEM (ERROR NAME "not a defined font configuration")) (* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.") (for X in FONTVARS when (AND (CL:SYMBOLP (CAR X)) (NEQ (CAR X) '*) (NEQ (CAR X) (CADR X))) do (SETTOPVAL (CAR X))) [MAPC (CDR TEM) (FUNCTION (LAMBDA (X) (/SETTOPVAL (CAR X) (CDR X] [PROG (BASICCLASSES) (for X in FONTPROFILE do (PROG (SEEN (NAME (CAR X)) (FONTS X)) LP [COND ((MEMB (CAR FONTS) SEEN) (ERROR "Circular font profile specification" X)) (T (push SEEN (CAR FONTS] [SETQ FONTS (CDR (COND ((OR (NULL (CADR FONTS)) (LISTP (CADR FONTS))) (*) (* ;  "This skips over the now-defunct NIL or list-of-escape sequence") (CDR FONTS)) (T FONTS] (COND ((OR (NLISTP FONTS) (LITATOM (CAR FONTS)))(* ;  "Indirect thru another's font spec") (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) ((NIL DEFAULTFONT) (* ;  "Don't let DEFAULTFONT loop thru itself") (AND (NOT (MEMB 'DEFAULTFONT SEEN )) 'DEFAULTFONT)) (CAR FONTS)) FONTPROFILE)) (GO LP))) (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* ;  "Now we have a font class datastructure") )) (AND NAME (/SETTOPVAL NAME FONTS)) (* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.") )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] [for X in FONTVARS when (NEQ (CAR X) '*) do (COND ((LISTP (CAR X)) (EVAL (CAR X))) [(CADDR X) (SET (CAR X) (FONTCREATE (OR (GETTOPVAL (CAR X)) (EVAL (CADR X)) DEFAULTFONT) NIL NIL NIL 'DISPLAY] (T (OR (GETTOPVAL (CAR X)) (AND (CADR X) (SET (CAR X) (EVAL (CADR X] (CL:WHEN CHANGE-WINDOWS? (CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY)) (for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X)) do (DSPFONT DEFAULTFONT X))) (DSPFONT WINDOWTITLEFONT WindowTitleDisplayStream) (SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT))) (MAPC CACHEDMENUS 'SET) [for W in (OPENWINDOWS) do [COND [(OR (EQ (WINDOWPROP W 'RESHAPEFN) 'DONT) (WINDOWPROP W 'MAINWINDOW] (T (* ;;  "don't reshape if can't or if this window is attached to another.") (SHAPEW W (WINDOWREGION W] (COND ((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN) (FUNCTION \TEDIT.PROCIDLEFN)) (WINDOWPROP W 'REPAINTFN)) (REDISPLAYW W]) (* ;; "Set the new font profile name, and return the old one, so he can restore later.") (PROG1 FONTNAME (SETQ FONTNAME NAME] (T (* ;  "He passed in NIL, so return font profile name in effect.") FONTNAME]) (FONTPROFILE [LAMBDA (PROFILE) (* lmm "10-Sep-86 12:33") [PROG (BASICCLASSES) (for X in PROFILE do (PROG (SEEN (NAME (CAR X)) (FONTS X)) LP [COND ((MEMB (CAR FONTS) SEEN) (ERROR "Circular font profile specification" X)) (T (push SEEN (CAR FONTS] [SETQ FONTS (CDR (COND ((OR (NULL (CADR FONTS)) (LISTP (CADR FONTS))) (* ;  "This skips over the now-defunct NIL or list-of-escape sequence") (CDR FONTS)) (T FONTS] (COND ((OR (NLISTP FONTS) (LITATOM (CAR FONTS))) (* Indirect thru another's font spec) (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) ((NIL DEFAULTFONT) (* Don't let DEFAULTFONT loop thru  itself) (AND (NOT (MEMB 'DEFAULTFONT SEEN)) 'DEFAULTFONT)) (CAR FONTS)) PROFILE)) (GO LP))) (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* Now we have a font class  datastructure) )) (AND NAME (/SETATOMVAL NAME FONTS)) (* NIL for the class-name means just establish the font-correspondences but  don't connect them up with a pretty class name.) )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] T]) (FONTPROFILE.ADDDEVICE [LAMBDA (NEWDEVICE OLDDEVICE) (* ; "Edited 3-Mar-93 14:46 by rmk:") (* ;; "Fills in all fontprofile specifications so that an entry for NEWDEVICE is present for each fontclass. Nothing is changed if the entry is already there, otherwise the specification for the class currently provided for OLDDEVICE will be used for NEWDEVICE.") (DECLARE (USEDFREE FONTDEFS FONTNAME)) (SETQ NEWDEVICE (U-CASE NEWDEVICE)) (SETQ OLDDEVICE (U-CASE OLDDEVICE)) [FOR FD IN FONTDEFS DO (FOR FC OLDSPEC IN (CDR (ASSOC 'FONTPROFILE (CDR FD))) UNLESS (LITATOM (CADR FC)) DO (SETQ FC (CDR FC)) (* ; "Skip over name") (CL:WHEN [SETQ OLDSPEC (SELECTQ OLDDEVICE (DISPLAY (CADR FC)) (INTERPRESS (CADDDR FC)) (PRESS (CADDR FC)) (CADR (ASSOC OLDDEVICE (CDDDDR FC] [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] (* ;  "Fill in NIL's for missing DISPLAY, PRESS, or INTERPRESS") [SELECTQ NEWDEVICE (DISPLAY (OR (CAR FC) (RPLACA FC OLDSPEC))) (INTERPRESS (OR (CADDR FC) (RPLACA [PROGN [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] (OR (CDR FC) (CDR (RPLACD FC (CONS] OLDSPEC))) (PRESS (OR (CADDR FC) (RPLACA [OR (CDR FC) (CDR (RPLACD FC (CONS] OLDSPEC))) (OR (CADR (ASSOC NEWDEVICE (CDDDR FC))) (PROGN (PROGN [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] [SETQ FC (OR (CDR FC) (CDR (RPLACD FC (CONS] (PUSH (CDR FC) (LIST NEWDEVICE OLDSPEC])] (FONTSET FONTNAME]) ) (RPAQ? FONTESCAPECHAR (CHARACTER 6)) (RPAQ? FONTFNS ) (RPAQ? FONTWORDS ) (DECLARE%: DONTEVAL@LOAD DOCOPY (FONTSET 'STANDARD) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS) ) (DEFINEQ (FONTMAPARRAY [LAMBDA (FONTCLASSES) (* lmm "28-Sep-86 14:23") (* ;; "Makes a font array from a font-mapping list of fontclasses. The array provides a fast map from font# to font classes/descriptors. This function caches the last array. If IMAGETYPES is given, then the FD's are pre-computed for the imagetypes it. Otherwise, the first use of the fontclass for that imagetype would cause the fontcreate to be done.") (PROG (FA (MAXFONT 0) (MINFONT 100)) [COND ((NULL \FONTMAPCACHE)) ((OR (NULL FONTCLASSES) (EQUAL FONTCLASSES (CAR \FONTMAPCACHE))) (RETURN (CDR \FONTMAPCACHE] [for F PRETTYFONT# in FONTCLASSES do (SETQ PRETTYFONT# (fetch (FONTCLASS PRETTYFONT#) of F)) (COND ((IGREATERP PRETTYFONT# MAXFONT) (SETQ MAXFONT PRETTYFONT#))) (COND ((ILESSP PRETTYFONT# 1) (ERROR "Invalid font number" PRETTYFONT# F)) ((ILESSP PRETTYFONT# MINFONT) (SETQ MINFONT PRETTYFONT#] (SETQ FA (ARRAY MAXFONT)) (for F in FONTCLASSES do (SETA FA (fetch (FONTCLASS PRETTYFONT#) of F) F)) (for I from 1 to MAXFONT unless (ELT FA I) do (SETA FA I (ELT FA MINFONT))) (SETQ \FONTMAPCACHE (CONS (COPY FONTCLASSES) FA)) (RETURN FA]) ) (RPAQ? \FONTMAPCACHE ) (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL) (PUTPROPS FONTPROFILEPATCH COPYRIGHT ("Xerox Corporation" 1993)) (DECLARE%: DONTCOPY (FILEMAP (NIL (16158 27897 (FONTSET 16168 . 22509) (FONTPROFILE 22511 . 25015) (FONTPROFILE.ADDDEVICE 25017 . 27895)) (28133 30403 (FONTMAPARRAY 28143 . 30401))))) STOP \ No newline at end of file diff --git a/sources/FONTPROFILEPATCH.LCOM b/sources/FONTPROFILEPATCH.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..df5b65550e3248ca1333e5ef53d87b513f5c90c7 GIT binary patch literal 10893 zcmcIqTWllOdFD{-OA^dh+TAQ{p*4=_Y(g24!Wmw4ap2X69En5mW^%OLi|d#xQY%Ij zDew~Srf41#_$evSCJvm7fuIJ8AP5pjyICMe3+Swv}Pspys~C8Arl+;n#CHDg8xo+(Kiv86F2Wl10T_>BC(Wf~EOJD4bGA_L%`V27VJyYWC3E2< zS!1Wjnqcu*$~4&KcD-|_*=PEodu545E$Gm#vM3!63a_&4#+p5&tXG^hby=`8&PGAq zsk&A%V^uQh9+1}T3U+j#uGlJ8RWPh(*j}&sjaGNq=Nf@X5yMc3aZP^f;qaZWpM ze1}f{lj+Td}H6I-R$wRh!<#*>!vx ztd!3{JJv?t#WKcRyTBZ5r?XaZ&7Q3}#Z0MIy^6hL`mBCln ztV)&MnJjIkvv#In7dQAuoC%t)MlW&Lc-{snc?MCAcJ?hWU=TunB{&KlX zkDsNF!`kJksfpag!)GsM_vf`+S|h&v=>GJ&#&I6~dcC2ohqXulqwNJpcBj8~{;=2xYwzLz ziN6nr-)c;}FL)=56I$a(Lgq*JUp(Z3cx1L8{pNFg{q4h|#u;9I>;9$v9~X*z_j4q| zTlwjKDZF1OisM}*@g}}~@bOOmr+E(K?aOl)FIpcSXeno0QI8&6e4fY&?SMk)yBBNI zwZ9bT?N>Oh+6BJ+{pL%DwHFRTf2ZAQc#3-ruC;xq5e{qjquRPyKRgeW@;499 zjkDcSm(WRK@d zlbqkbUE*Rtdhl1J$v_#uDor-{Yr#aq#yr?da^u4L-qRr|^%u2E%bS-DCqvOxY=Kpf zDXQhXb)&|Tiwo>cr&!&n*ut$@a={qinUAw-)+*ZoPa#ryNLB1Lr&MIgozrH6AxdB#WB~m9)7ivO~ct zTa}7+gPExm`wB$&Br!pXr00nVC2XD*?7|9S9;_>sQiU0bl(!XIR1tC5fC`Qypv`%O zIm%6P0ro+iblf>;Htl4Pb4cq6R{S*|8O&mFW5M4y z7m~qqLfMZeIcu+uGSf_r?7N;8Mv>~^+VcZNLy zB`S)P-K#1ISxlOIiZEPHd5k{zMmR#;ck{&Dp1H6uxH??Xt%hZ0?2bb;iWK*kqn%| z7%?D%MpRlJuJBBCIX_ZX$;9y|wD5@S=By0r`86kP%iaKqBaaker@8r7=?fv5;Z>d& ze-6y+yIu28SJ5w!kW|xWnD*j1EfiknY4di-65rvssbcI;lVw9(m)Y>;@YKr_&cwsN z;EMhqmqSi!H^aQzeg7czAGz@FEU(=C;4ruUvPiq{<-+0p&nqv&?_wtmdfKfI4?;i5 zg&%%4*Vx{ke(^B;yJZjm$A>xX!MAejFYMnHRPKKPNZNxP75b)v3CN;EMy=(*udBcS zm?geo`{0WDLZxzZd3}3&Iv0j4PWZ;b$CpCUq=MgLS|E7<^yj+rX{1uC^bc9^)iC+0^fbT5T1vbsS5-@*S$g5uV4-1 z3TLqJWv~L>L6H8)F$&go{!IQr53*rgMUVL=ZGZ#s=n&w)cwP%>UvD?2E`)27KVAOe za&1!k;}2?+;mPHxm!Damc&J~@au>L{yuYfw`7AlizlWat>+DDWQ26am;iC_DpH#^6 zNPX8SeDwXojl=cut^I!`r#hF*OAG-)h4_E7J5%B3O6QAzc<@TD;dM&CDxJ@XEW#-r zmd@||=hx2f|Mx}VvbpKa$s7-Hw6&%34V085)eZ{}F=nIjHR9fP%zH6!cwvpC&dV08 zxTwZIijuD#iq%vC7q`wg>g|@7UOU6x+sz)`c!cWHr9v466#X)E=vk28weW%xdZlc= z@y4+)Sv2}8d+jwAAN>eq1hRFtvG*Nsc-Jw>2-&l246ZT8lq9BC2lxTL5Cz0Pj76LTwC`=?hopnM!nZy z{nj^|yzcbpnAPtOcX3bacG~wwQeeM1p!2ODD-lI;RpS;@6J?b1VEU?+rt6$o5zY(= z1XZyJ3SE8J9xz7RMAC7gwDjYNj?mNv7AKo`TzOqlWRd(>f4e(uH`uU0thaHf+bF`j zcp?X2QP(N*$YTK!4^fXmJ#4VuB4zkEtUqYA+guaQ8kbpWMDp|4fz9pKojc85fZ^KL zU5=tk344sFWvkm`gXUeXY(kLaxw;5j@{xKZgxg&lP+|#(BoX>YlQ zWBq&mL38)Z)Rb&C`~7C$2aeDaT?fbIWW<+b@n7=0J9hv**b@dHu@oT%)^BaG4*H$` zaBr{OYBq=+&!?4*vg?yk^uzg*g7nC+kM`*HJqAA?^t$cY6+-qvoped0Nl62*xLWDd z{q0_>v(xI_@y^eWyMpPBTY;PMllpF;`}*YyyNwtd^y-^U8mTmzw})g=;wyUn;GV4T zJ@Rf0b_SvDU6(`vu!bWrz+~0K^1%2cbl6eO#p%HRVWKD(~r1xgtV~- zWei9e-63yFclQQdAx^QpArPg@Nf8MPQbNLedrjy8|0H9b=gpFbsMt;7axH>kvxmu6 z3&STOGD-ur&nZftEDB3jM>3Bt--(=--w-A{iP^~cko1SpX|FjL_Ncp7L=SYvpVTnH zY-j*6Jw=Tw7$pI=7K%Dv!5G5rHYwr=(JwIE&4QzN?kS?O+iUcZm&hpIHGojlG-u>! zz5-ONo#wrFIN}!>ha?oedZUUV(RlEV7~@Jrg#VQYoucEFK0cGPt7%;HF+8h4x%jlw80NARrwnSKPCW2bD^)TyBSdyVi&e2P z9;7QMUALF>B`bp!PkeL)DUUpatncECYx&ZOl^652F@Y6nhz8u5v-gfDd&SXHj5c|A z2LYgrs$IsBgx;bC?tyW1kx5J%=g}B0(hLxTKTP}302>J!*%>K@%RDa5#v((fii;2~ zxR_#KJb-C~Zjw$gD#XaSl5tn^bQYaD6Sst;aMhEzEJ{;bp#o_NnULv7AOQ`D=Y zXBfC%A4Us)aon%<4V2I1XJ@f^>1%x2ta7IZS=O`S-C^!|)!Yk7W zA3UC7`VkJ$5$%D6U!{{2f|$rU=|FtBVZRL$A-%Ek$`Azj)>C;u^+>b4V8^G);2(8rGF!OHsXspAB$BgA%+)xZYT3D_uPh zvUdKO?K){f!j+bOqY*R^x_qVkkuDX9wvp=wZaad_Ev0OEzATf$34W{xG)UH9h0zcf zV4T0-5vF`meW6q8X?gv?WsVC=W)Em1o-wWU-S?O<@=uhuqeWlG98r%@ia9)zs)OxUr8W0{w(c;0dVY z2m}2C@&wuh&~hqOH(knOBSpR`8s0pRuwy0(0+}Rec64lCdDh$Z6UtA{cQF-oB4RQIfRP|C4ha0QmkKG9T9jCD>J>pg|3p8mM8o-Dpp)G$~% zajK_B_>fFanl_e4_Ux13gi~uJUnG&>uoU>S#^{q5++{7GpY*v1lad