(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED " 1-Jul-88 17:33:24" {ERIS}<VANMELLE>LISP>LISPUSERS>NSDISPLAYSIZES.;2
 4380   

      changes to%:  (VARS NSDISPLAYSIZESCOMS) (FNS VKBD.FIX.FONT)

      previous date%: "14-Dec-87 14:56:11" {ERIS}<VANMELLE>LISP>LISPUSERS>NSDISPLAYSIZES.;1)


(* "
Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT NSDISPLAYSIZESCOMS)

(RPAQQ NSDISPLAYSIZESCOMS ((FNS NSDISPLAYSIZE NS\FONTFILENAME NS\FONTFILENAME.OLD PURGENSFONTS) (ADDVARS (NSFONTFAMILIES CLASSIC MODERN TERMINAL OPTIMA TITAN)) (COMS (* ; "VirtualKeyboard font needs adjusting so that real Classic 12 still appears") (FNS VKBD.FIX.FONT) (DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (RECLOOK (QUOTE KEYBOARDCONFIGURATION)) (LOADDEF (QUOTE KEYBOARDCONFIGURATION) (QUOTE RECORDS) (QUOTE VIRTUALKEYBOARDS)))))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD? (QUOTE \FONTFILENAME) (QUOTE OLD\FONTFILENAME)) (MOVD (QUOTE NS\FONTFILENAME) (QUOTE \FONTFILENAME)) (MOVD? (QUOTE \FONTFILENAME.OLD) (QUOTE OLD\FONTFILENAME.OLD)) (MOVD (QUOTE NS\FONTFILENAME.OLD) (QUOTE \FONTFILENAME.OLD)) (PURGENSFONTS) (VKBD.FIX.FONT)))))
(DEFINEQ

(NSDISPLAYSIZE

(LAMBDA (FAMILY SIZE FACE EXTENSION) (* ; "Edited 15-Jan-87 15:22 by bvm:") (* ;; "Returns size that we would prefer to see the font of requested family, size, face, extension.  Used to make bigger ns display fonts than you would get by default.") (DECLARE (GLOBALVARS DISPLAYFONTEXTENSIONS NSFONTFAMILIES)) (OR (COND ((CL:MEMBER FAMILY NSFONTFAMILIES :TEST (QUOTE STRING-EQUAL)) (AND (CL:MEMBER EXTENSION DISPLAYFONTEXTENSIONS :TEST (QUOTE STRING-EQUAL)) (SELECTQ SIZE (12 (COND ((STRING-EQUAL FAMILY (QUOTE TERMINAL)) (* ; "Until Terminal 14 exists") 12) (T 14))) (10 12) (8 10) (6 8) NIL))) ((STRING-EQUAL FAMILY (QUOTE SYMBOL)) (* ; "Allow for appropriate NS size on Interpress printing, even tho display fonts don't exist") 10)) SIZE))
)

(NS\FONTFILENAME

(LAMBDA (FAMILY SIZE FACE EXTENSION CHARACTERSET) (* ; "Edited 15-Jan-87 15:23 by bvm:") (OLD\FONTFILENAME FAMILY (NSDISPLAYSIZE FAMILY SIZE FACE EXTENSION) FACE EXTENSION CHARACTERSET))
)

(NS\FONTFILENAME.OLD

(LAMBDA (FAMILY SIZE FACE EXTENSION CHARACTERSET) (* ; "Edited 15-Jan-87 15:29 by bvm:") (OLD\FONTFILENAME.OLD FAMILY (NSDISPLAYSIZE FAMILY SIZE FACE EXTENSION) FACE EXTENSION CHARACTERSET))
)

(PURGENSFONTS

(LAMBDA (TYPES) (* ; "Edited 14-Dec-87 14:53 by bvm:") (/SETTOPVAL (QUOTE \FONTSINCORE) (for ENTRY in \FONTSINCORE bind BADTYPES TMP collect (SETQ BADTYPES (if (AND (MEMB (CAR ENTRY) NSFONTFAMILIES) (OR (NULL TYPES) (EQMEMB (QUOTE NS) TYPES))) then (CONS (QUOTE DISPLAY) TYPES) else (MKLIST TYPES))) (CONS (CAR ENTRY) (for SIZES in (CDR ENTRY) when (SETQ TMP (if (AND (NULL TYPES) (> (CAR SIZES) 12)) then (* ; "Only have to get rid of sizes smaller than 14") (CDR SIZES) else (for FACE in (CDR SIZES) when (SETQ TMP (for ROT in (CDR FACE) when (SETQ TMP (for DEV in (CDR ROT) collect DEV unless (MEMB (CAR DEV) BADTYPES))) collect (CONS (CAR ROT) TMP))) collect (CONS (CAR FACE) TMP)))) collect (CONS (CAR SIZES) TMP))))))
)
)

(ADDTOVAR NSFONTFAMILIES CLASSIC MODERN TERMINAL OPTIMA TITAN)



(* ; "VirtualKeyboard font needs adjusting so that real Classic 12 still appears")


(DEFINEQ

(VKBD.FIX.FONT

(LAMBDA (NEWFONT) (* ; "Edited  1-Jul-88 16:55 by bvm") (* ;; "Change the VirtualKeyboard's configuration definitions to use NEWFONT (default Classic 10).  The original font is Classic 12, but with NSDISPLAYSIZES loaded, that coerces to Classic 14, so we have to fool it by setting it back a notch.") (OR NEWFONT (SETQ NEWFONT (QUOTE (CLASSIC 10)))) (for X in (LISTP (EVALV (QUOTE VKBD.CONFIGURATIONS))) do (replace (KEYBOARDCONFIGURATION KEYBOARDDISPLAYFONT) of X with NEWFONT)))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY 

(OR (RECLOOK (QUOTE KEYBOARDCONFIGURATION)) (LOADDEF (QUOTE KEYBOARDCONFIGURATION) (QUOTE RECORDS) (QUOTE VIRTUALKEYBOARDS)))
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(MOVD? (QUOTE \FONTFILENAME) (QUOTE OLD\FONTFILENAME))

(MOVD (QUOTE NS\FONTFILENAME) (QUOTE \FONTFILENAME))

(MOVD? (QUOTE \FONTFILENAME.OLD) (QUOTE OLD\FONTFILENAME.OLD))

(MOVD (QUOTE NS\FONTFILENAME.OLD) (QUOTE \FONTFILENAME.OLD))

(PURGENSFONTS)

(VKBD.FIX.FONT)
)
(PUTPROPS NSDISPLAYSIZES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1195 3143 (NSDISPLAYSIZE 1205 . 1966) (NS\FONTFILENAME 1968 . 2177) (
NS\FONTFILENAME.OLD 2179 . 2396) (PURGENSFONTS 2398 . 3141)) (3299 3812 (VKBD.FIX.FONT 3309 . 3810))))
)
STOP