(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