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

(FILECREATED " 2-Sep-87 16:59:45" {ERIS}<VANMELLE>LISP>NSDISPLAYSIZES.;3
 3123   

      changes to%:  (FNS PURGENSFONTS)

      previous date%: "24-Apr-87 14:35:38" {ERIS}<VANMELLE>LISP>NSDISPLAYSIZES.;2)


(* "
Copyright (c) 1985, 1986, 1987 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)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (PURGENSFONTS) (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)))))
)
(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  2-Sep-87 16:59 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 TYPES)) (CONS (CAR ENTRY) (for SIZES in (CDR ENTRY) when (SETQ TMP (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)
(DECLARE%: DONTEVAL@LOAD DOCOPY 
(PURGENSFONTS)
(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))
)
(PUTPROPS NSDISPLAYSIZES COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (857 2677 (NSDISPLAYSIZE 867 . 1628) (NS\FONTFILENAME 1630 . 1839) (NS\FONTFILENAME.OLD 
1841 . 2058) (PURGENSFONTS 2060 . 2675)))))
STOP