(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 6-Sep-2021 19:11:32"  {DSK}kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;4 30288 changes to%: (ALISTS (FONTDEFS BIGGERNS)) previous date%: " 6-Sep-2021 15:52:13" {DSK}kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;2) (* ; " Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation. ") (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)) (MENUFONT 5 (MODERN 10)) (COMMENTFONT 6 (MODERN 8) (MODERN 6 MIR) (MODERN 8 MIR] [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)) (MENUFONT 5 (MODERN 12)) (COMMENTFONT 6 (MODERN 10) (MODERN 8 MIR) (MODERN 10 MIR]) (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 2021)) (DECLARE%: DONTCOPY (FILEMAP (NIL (16323 27907 (FONTSET 16333 . 22674) (FONTPROFILE 22676 . 25025) (FONTPROFILE.ADDDEVICE 25027 . 27905)) (28143 30042 (FONTMAPARRAY 28153 . 30040))))) STOP