github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-10 01:19:10 +00:00
Code Issues Projects Releases Wiki Activity

Better control over source of fonts

Browse Source
This commit is contained in:
rmkaplan
2026-04-17 14:34:36 -07:00
parent 8e61761434
commit ef5012f9dd
6 changed files with 262 additions and 217 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
library/IMPORTFONTS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
(FILECREATED " 5-Apr-2026 14:27:30" {WMEDLEY}<library>IMPORTFONTS.;94 59200
(FILECREATED "16-Apr-2026 22:39:37" {WMEDLEY}<library>IMPORTFONTS.;98 60135
:EDIT-BY rmk
:CHANGES-TO (FNS IMPORTFONTS IMPORTFONTS.DIRECTORY FAKEFACE)
:CHANGES-TO (FNS LEGACYDISPLAYFONT)
:PREVIOUS-DATE " 5-Apr-2026 11:51:28" {WMEDLEY}<library>IMPORTFONTS.;92)
:PREVIOUS-DATE "15-Apr-2026 22:10:41" {WMEDLEY}<library>IMPORTFONTS.;97)
(PRETTYCOMPRINT IMPORTFONTSCOMS)
@@ -29,6 +29,7 @@
(IMPORTFONTS
[LAMBDA (PHASE FONTSPECS DEVICE FROMDIRECTORY TODIRECTORY IMPORTFN NODRIBBLE)
(* ; "Edited 11-Apr-2026 10:55 by rmk")
(* ; "Edited 5-Apr-2026 14:22 by rmk")
(* ; "Edited 3-Apr-2026 08:15 by rmk")
(* ; "Edited 1-Apr-2026 08:25 by rmk")
@@ -61,7 +62,8 @@
(IMPORTFONTS.CONTEXT PHASE FROMDIRECTORY TODIRECTORY DEVICE))
(IMPORTFONTS.CLEAR PHASE FONTSPECS TODIRECTORY DEVICE)
(SETQ FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS FROMDIRECTORY DEVICE))
(CL:WHEN (AND (CDR FONTSPECS)
(CL:WHEN (AND (IGEQ (LENGTH FONTSPECS)
5)
(NOT NODRIBBLE)) (* ;
 "Put all the dribbles together one up")
[DRIBBLE (PSEUDOFILENAME (PACKFILENAME 'BODY
@@ -195,7 +197,8 @@
'REGION]))])
(FONT.TO.MCCS
[LAMBDA (FONT) (* ; "Edited 10-Mar-2026 00:23 by rmk")
[LAMBDA (FONT) (* ; "Edited 11-Apr-2026 15:43 by rmk")
(* ; "Edited 10-Mar-2026 00:23 by rmk")
(* ; "Edited 7-Mar-2026 12:55 by rmk")
(* ; "Edited 1-Mar-2026 13:43 by rmk")
(* ; "Edited 7-Oct-2025 17:13 by rmk")
@@ -212,20 +215,20 @@
(LET [(PAIRS (MCCSMAPPAIRS (FONTPROP FONT 'CHARENCODING]
(CL:WHEN PAIRS
(MOVEFONTCHARS PAIRS FONT FONT)
(replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL)
(* ;; "Keep the map function even for coerced MCCS fonts--can still be used for code conversion (e.g. Tedit file updating) ")
[replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (MCCSMAPFN (FONTPROP FONT
'CHARENCODING]
(replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL)
(CL:WHEN (MEMB (FONTPROP FONT 'CHARENCODING)
'(GACHA XCCS$ ALTOTEXT PALATINO UNICODE))
'(GACHA XCCS$ ALTOTEXT PALATINO UNICODE HIPPO CYRILLIC))
(replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with 'MCCS)
(* ; "These fonts made it all the way")
(CHARSETPROP (\GETCHARSETINFO FONT 0)
'CSCHARENCODING
'MCCS))
T)])
FONT)])
(IMPORTFONTS.FONTSPECS
[LAMBDA (PHASE FONTSPECS FROMDIRECTORY DEVICE) (* ; "Edited 4-Apr-2026 11:41 by rmk")
@@ -678,7 +681,9 @@
(IMPORTFONTS 'IMPORT FONTSPECS 'DISPLAY NIL NIL (FUNCTION LEGACYDISPLAYFONT])
(LEGACYDISPLAYFONT
[LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 31-Mar-2026 15:01 by rmk")
[LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 16-Apr-2026 22:37 by rmk")
(* ; "Edited 12-Apr-2026 13:22 by rmk")
(* ; "Edited 31-Mar-2026 15:01 by rmk")
(* ; "Edited 28-Mar-2026 09:27 by rmk")
(* ;; "Loads legacy display fonts (ac or strike format, gacha, terminal, helevetica...) from FROMDIRECTORY. If NIL, the current directory")
@@ -691,9 +696,9 @@
FROMDIRECTORY)
`(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS OLDVALUE]
(for CSNO CSINFO (FONT ← (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC 255)) from 0 to 255
do [SETQ CSINFO (\READCHARSET FONTSPEC CSNO FONT '((AC ACFONT.FILEP ACFONT.GETCHARSET)
(STRIKE STRIKEFONT.FILEP
STRIKEFONT.GETCHARSET]
do (SETQ CSINFO (\READCHARSET FONT CSNO '((AC ACFONT.FILEP ACFONT.GETCHARSET)
(STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET))
FROMDIRECTORY))
(* ;; "NIL means empty")
@@ -746,22 +751,28 @@
(DEFINEQ
(PEF
[LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 30-Mar-2026 09:14 by rmk")
[LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Apr-2026 19:32 by rmk")
(* ; "Edited 30-Mar-2026 09:14 by rmk")
(* ; "Edited 25-Mar-2026 00:11 by rmk")
(* ; "Edited 22-Mar-2026 00:19 by rmk")
(* ; "Edited 16-Mar-2026 08:43 by rmk")
(* ; "Edited 13-Mar-2026 10:33 by rmk")
(CL:UNLESS CHARSET (SETQ CHARSET 0))
(if (type? FONTSPEC FONTSPEC)
then (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T))
else (SETQ FONTSPEC (FONTSPECFROMFILENAME FONTSPEC)))
(LET* ((DIR (IMPORTFONTS.DIRECTORY FONTSPEC DIRECTORY (IMPORTFONTS.SUBDIR PHASE)))
(FONTFILE (MEDLEYFONT.FILENAME FONTSPEC DIR))
TITLETAG CHARSETNAME)
(if (NLSETQ (MEDLEYFONT.FILEP FONTFILE))
then (SETQ CHARSET (OR (CHARSET.DECODE CHARSET)
0))
(SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS)
(SETQ CHARSET (if (EQ CHARSET T)
then (for C in (MEDLEYFONT.GETFILEPROP FONTFILE 'CHARSETS)
unless (OR (KANJICHARSETP C)
(CHINESECHARSETP C)) collect C)
elseif (CHARSET.DECODE CHARSET)
else 0))
(if (LISTP CHARSET)
then (for C in CHARSET do (PEF PHASE FONTSPEC C DIRECTORY T))
elseif (NLSETQ (MEDLEYFONT.FILEP FONTFILE))
then (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS)
'MCCS
(L-CASE PHASE T)))
(SETQ CHARSETNAME (CHARSET.ENCODE CHARSET))
@@ -892,15 +903,15 @@
(FILESLOAD EDITFONT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1215 32446 (IMPORTFONTS 1225 . 12900) (FONT.TO.MCCS 12902 . 15025) (
IMPORTFONTS.FONTSPECS 15027 . 22493) (IMPORTFONTS.CONTEXT 22495 . 26086) (IMPORTFONTS.NOCACHE 26088 .
26339) (IMPORTFONTS.DIRECTORY 26341 . 28506) (IMPORTFONTS.CLEAR 28508 . 31075) (IMPORTFONTS.SUBDIR
31077 . 31825) (IMPORTFONTS.DIRSIZE 31827 . 32444)) (32447 35871 (IMPORTFONTS.AVAILABLE 32457 . 33072)
(IMPORTFONTS.EXISTS? 33074 . 33680) (IMPORTFONTS.DEPLOY 33682 . 35869)) (35872 42467 (FAKEFACE 35882
. 39619) (FAKEFACE.FROMFILE 39621 . 41777) (FAKEFACE.FROMFONT 41779 . 42465)) (42468 45798 (
IMPORTFONTS.PHASES 42478 . 43219) (MISSINGFACE 43221 . 45796)) (45842 47607 (IMPORT.DISPLAY 45852 .
46175) (LEGACYDISPLAYFONT 46177 . 47605)) (47656 49870 (IPF 47666 . 48433) (IPFSIZES 48435 . 49868)) (
49871 55607 (PEF 49881 . 51945) (AEF 51947 . 52691) (IEF 52693 . 53296) (MEF 53298 . 53899) (CEF 53901
. 54506) (FEF 54508 . 55327) (EFCLOSE 55329 . 55605)) (55608 59155 (SHOWCHARS 55618 . 57648) (
CSSOURCE 57650 . 58363) (FONTDEFFONTS 58365 . 59153)))))
(FILEMAP (NIL (1190 32701 (IMPORTFONTS 1200 . 13028) (FONT.TO.MCCS 13030 . 15280) (
IMPORTFONTS.FONTSPECS 15282 . 22748) (IMPORTFONTS.CONTEXT 22750 . 26341) (IMPORTFONTS.NOCACHE 26343 .
26594) (IMPORTFONTS.DIRECTORY 26596 . 28761) (IMPORTFONTS.CLEAR 28763 . 31330) (IMPORTFONTS.SUBDIR
31332 . 32080) (IMPORTFONTS.DIRSIZE 32082 . 32699)) (32702 36126 (IMPORTFONTS.AVAILABLE 32712 . 33327)
(IMPORTFONTS.EXISTS? 33329 . 33935) (IMPORTFONTS.DEPLOY 33937 . 36124)) (36127 42722 (FAKEFACE 36137
. 39874) (FAKEFACE.FROMFILE 39876 . 42032) (FAKEFACE.FROMFONT 42034 . 42720)) (42723 46053 (
IMPORTFONTS.PHASES 42733 . 43474) (MISSINGFACE 43476 . 46051)) (46097 48043 (IMPORT.DISPLAY 46107 .
46430) (LEGACYDISPLAYFONT 46432 . 48041)) (48092 50306 (IPF 48102 . 48869) (IPFSIZES 48871 . 50304)) (
50307 56542 (PEF 50317 . 52880) (AEF 52882 . 53626) (IEF 53628 . 54231) (MEF 54233 . 54834) (CEF 54836
. 55441) (FEF 55443 . 56262) (EFCLOSE 56264 . 56540)) (56543 60090 (SHOWCHARS 56553 . 58583) (
CSSOURCE 58585 . 59298) (FONTDEFFONTS 59300 . 60088)))))
STOP

BIN
library/IMPORTFONTS.LCOM
View File

Binary file not shown.