Compare commits
3 Commits
rmk166--MO
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
322b2e0fbe | ||
|
a24a4dffc2 | ||
|
b8c0c594a9 |
@@ -1,22 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12 5880
|
||||
(FILECREATED " 7-Mar-2026 22:55:43" {WMEDLEY}<lispusers>VERSIONDEFS.;18 6534
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GETVINFO)
|
||||
|
||||
:PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
|
||||
:PREVIOUS-DATE " 6-Mar-2026 22:47:25" {WMEDLEY}<lispusers>VERSIONDEFS.;17)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT VERSIONDEFSCOMS)
|
||||
|
||||
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(RPAQQ VERSIONDEFSCOMS
|
||||
[(FNS FINDFILEVERSION GETVINFO VERSIONP)
|
||||
(FNS EDV DFV)
|
||||
(PROP ARGNAMES EDV DFV)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA DFV EDV)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(FINDFILEVERSION
|
||||
@@ -119,16 +118,26 @@
|
||||
(CAR VINFO])
|
||||
|
||||
(DFV
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
[NLAMBDA ARGS (* ; "Edited 6-Mar-2026 22:42 by rmk")
|
||||
(* ; "Edited 6-Dec-2024 21:29 by rmk")
|
||||
(* ; "Edited 2-Dec-2024 00:08 by rmk")
|
||||
(SETQ ARGS (MKLIST ARGS))
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST (POP ARGS)
|
||||
NIL
|
||||
(POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS])
|
||||
(LET ((NAME (POP ARGS))) (* ; "If FNS and FUNCTIONS, show both")
|
||||
(CL:WHEN (HASDEF NAME 'FUNCTIONS '?)
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST NAME 'FUNCTIONS (POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS))))
|
||||
(CL:WHEN (HASDEF NAME 'FNS '?)
|
||||
(APPLY (FUNCTION EDV)
|
||||
(LIST NAME 'FNS (POP ARGS)
|
||||
(POP ARGS)
|
||||
(POP ARGS))))])
|
||||
)
|
||||
|
||||
(PUTPROPS EDV ARGNAMES (NAME TYPE FILE VERSION DIRLST . VINFO))
|
||||
|
||||
(PUTPROPS DFV ARGNAMES (NAME FILE VERSION DIRLST . VINFO))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA DFV EDV)
|
||||
@@ -138,6 +147,6 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
|
||||
4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
|
||||
(FILEMAP (NIL (706 4605 (FINDFILEVERSION 716 . 2163) (GETVINFO 2165 . 4288) (VERSIONP 4290 . 4603)) (
|
||||
4606 6230 (EDV 4616 . 5316) (DFV 5318 . 6228)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "25-Feb-2026 15:03:24" {WMEDLEY}<sources>BOOTSTRAP.;69 47041
|
||||
(FILECREATED " 2-Mar-2026 12:03:05" {WMEDLEY}<sources>BOOTSTRAP.;71 47856
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MAKE-DEFINE-FILE-INFO-ENV READ-READER-ENVIRONMENT)
|
||||
:CHANGES-TO (FNS READ-READER-ENVIRONMENT)
|
||||
|
||||
:PREVIOUS-DATE "25-Feb-2026 13:52:00" {WMEDLEY}<sources>BOOTSTRAP.;66)
|
||||
:PREVIOUS-DATE "25-Feb-2026 15:03:24" {WMEDLEY}<sources>BOOTSTRAP.;69)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT BOOTSTRAPCOMS)
|
||||
@@ -800,7 +800,9 @@
|
||||
(TERPRI STREAM)))])
|
||||
|
||||
(READ-READER-ENVIRONMENT
|
||||
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 25-Feb-2026 14:15 by rmk")
|
||||
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 2-Mar-2026 12:03 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 10:49 by rmk")
|
||||
(* ; "Edited 25-Feb-2026 14:15 by rmk")
|
||||
(* ; "Edited 26-Sep-2021 23:31 by rmk:")
|
||||
|
||||
(* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")
|
||||
@@ -809,42 +811,49 @@
|
||||
|
||||
(* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")
|
||||
|
||||
(CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(LET ((START (GETFILEPTR STREAM))
|
||||
ARGS
|
||||
(ENV DEFAULTENV)
|
||||
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF *OLD-INTERLISP-READ-ENVIRONMENT*)))
|
||||
(DECLARE (SPECVARS *READTABLE*))
|
||||
(SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP")
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
(";" (* ; "Assume it's a common lisp file")
|
||||
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
(if (\GETSTREAM STREAM 'INPUT T)
|
||||
then (CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(LET ((START (GETFILEPTR STREAM))
|
||||
ARGS
|
||||
(ENV DEFAULTENV)
|
||||
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF
|
||||
*OLD-INTERLISP-READ-ENVIRONMENT*
|
||||
)))
|
||||
(DECLARE (SPECVARS *READTABLE*))
|
||||
(SETFILEPTR STREAM 0) (* ; "Hope we are RANDACCESSP")
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
(";" (* ; "Assume it's a common lisp file")
|
||||
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
*COMMON-LISP-READ-ENVIRONMENT*
|
||||
))
|
||||
*COMMON-LISP-READ-ENVIRONMENT*)
|
||||
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
))
|
||||
*COMMON-LISP-READ-ENVIRONMENT*)
|
||||
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
*DEFINE-FILE-INFO-ENV*
|
||||
)) (* ;
|
||||
))(* ;
|
||||
"Should we reset the format if we fail?")
|
||||
(READCCODE STREAM)
|
||||
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
|
||||
(if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
|
||||
then
|
||||
(* ;;
|
||||
(READCCODE STREAM)
|
||||
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
|
||||
(if (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
|
||||
then
|
||||
(* ;;
|
||||
"After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
|
||||
|
||||
(SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")")
|
||||
STREAM))
|
||||
(SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS))
|
||||
else (SETFILEPTR STREAM START))
|
||||
(SETQ ARGS (CL:READ-DELIMITED-LIST (CHARCODE ")")
|
||||
STREAM))
|
||||
(SETQ ENV (\DO-DEFINE-FILE-INFO STREAM ARGS))
|
||||
else (SETFILEPTR STREAM START))
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
|
||||
|
||||
(CL:IF (AND RETURNFORM ARGS)
|
||||
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
|
||||
ENV)))
|
||||
DEFAULTENV])
|
||||
(CL:IF (AND RETURNFORM ARGS)
|
||||
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
|
||||
ENV)))
|
||||
DEFAULTENV))
|
||||
else (CL:WITH-OPEN-FILE (STRM (OR (FINDFILE STREAM T)
|
||||
STREAM)
|
||||
:DIRECTION :INPUT)
|
||||
(READ-READER-ENVIRONMENT STRM DEFAULTENV RETURNFORM])
|
||||
|
||||
(MAKE-DEFINE-FILE-INFO-ENV
|
||||
[LAMBDA NIL (* ; "Edited 25-Feb-2026 15:03 by rmk")
|
||||
@@ -969,13 +978,13 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4621 14293 (GETPROP 4631 . 5203) (SETATOMVAL 5205 . 5334) (RPAQQ 5336 . 5389) (RPAQ
|
||||
5391 . 5703) (RPAQ? 5705 . 6075) (MOVD 6077 . 7941) (MOVD? 7943 . 8373) (SELECTQ 8375 . 8562) (
|
||||
SELECTQ1 8564 . 8906) (NCONC1 8908 . 9104) (PUTPROP 9106 . 10590) (PROPNAMES 10592 . 10783) (ADDPROP
|
||||
10785 . 12848) (REMPROP 12850 . 13704) (MEMB 13706 . 13965) (CLOSEF? 13967 . 14291)) (14366 34343 (
|
||||
LOAD 14376 . 15545) (\LOAD-STREAM 15547 . 28034) (FILECREATED 28036 . 29454) (FILECREATED1 29456 .
|
||||
30564) (PRETTYCOMPRINT 30566 . 31051) (BOOTSTRAP-NAMEFIELD 31053 . 32013) (PUTPROPS 32015 . 32383) (
|
||||
DECLARE%: 32385 . 32517) (DECLARE%:1 32519 . 33391) (ROOTFILENAME 33393 . 34341)) (34381 44987 (
|
||||
DEFINE-FILE-INFO 34391 . 34826) (\DO-DEFINE-FILE-INFO 34828 . 38971) (PRINT-READER-ENVIRONMENT 38973
|
||||
. 40725) (READ-READER-ENVIRONMENT 40727 . 43553) (MAKE-DEFINE-FILE-INFO-ENV 43555 . 44985)))))
|
||||
(FILEMAP (NIL (4595 14267 (GETPROP 4605 . 5177) (SETATOMVAL 5179 . 5308) (RPAQQ 5310 . 5363) (RPAQ
|
||||
5365 . 5677) (RPAQ? 5679 . 6049) (MOVD 6051 . 7915) (MOVD? 7917 . 8347) (SELECTQ 8349 . 8536) (
|
||||
SELECTQ1 8538 . 8880) (NCONC1 8882 . 9078) (PUTPROP 9080 . 10564) (PROPNAMES 10566 . 10757) (ADDPROP
|
||||
10759 . 12822) (REMPROP 12824 . 13678) (MEMB 13680 . 13939) (CLOSEF? 13941 . 14265)) (14340 34317 (
|
||||
LOAD 14350 . 15519) (\LOAD-STREAM 15521 . 28008) (FILECREATED 28010 . 29428) (FILECREATED1 29430 .
|
||||
30538) (PRETTYCOMPRINT 30540 . 31025) (BOOTSTRAP-NAMEFIELD 31027 . 31987) (PUTPROPS 31989 . 32357) (
|
||||
DECLARE%: 32359 . 32491) (DECLARE%:1 32493 . 33365) (ROOTFILENAME 33367 . 34315)) (34355 45802 (
|
||||
DEFINE-FILE-INFO 34365 . 34800) (\DO-DEFINE-FILE-INFO 34802 . 38945) (PRINT-READER-ENVIRONMENT 38947
|
||||
. 40699) (READ-READER-ENVIRONMENT 40701 . 44368) (MAKE-DEFINE-FILE-INFO-ENV 44370 . 45800)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
180
sources/FONT
180
sources/FONT
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED " 4-Mar-2026 00:16:13" {WMEDLEY}<sources>FONT.;686 279360
|
||||
(FILECREATED "26-Feb-2026 17:01:47" {WMEDLEY}<sources>FONT.;677 278005
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \SEARCHFONTFILES)
|
||||
:CHANGES-TO (FNS MOVEFONTCHARS)
|
||||
|
||||
:PREVIOUS-DATE " 2-Mar-2026 13:14:53" {WMEDLEY}<sources>FONT.;685)
|
||||
:PREVIOUS-DATE "20-Feb-2026 12:54:44" {WMEDLEY}<sources>FONT.;675)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -38,8 +38,7 @@
|
||||
|
||||
(FNS FONTASCENT FONTDESCENT FONTHEIGHT FONTPROP \AVGCHARWIDTH)
|
||||
(EXPORT (OPTIMIZERS FONTPROP))
|
||||
(FNS FONTDEVICEPROP)
|
||||
(PROP ARGNAMES FONTDEVICEPROP))
|
||||
(FNS FONTDEVICEPROP))
|
||||
(COMS (* ; "Moving character information")
|
||||
(FNS EDITCHAR)
|
||||
(* ; "Should this be on EDITFONT ?")
|
||||
@@ -195,8 +194,7 @@
|
||||
(SYMBOL . SY]
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA FONTCOPY
|
||||
FONTDEVICEPROP])
|
||||
(LAMA FONTCOPY])
|
||||
|
||||
|
||||
|
||||
@@ -1291,34 +1289,23 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FONTDEVICEPROP
|
||||
[LAMBDA NARGS (* ; "Edited 2-Mar-2026 13:14 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 12:22 by rmk")
|
||||
(* ; "Edited 25-Aug-2025 21:23 by rmk")
|
||||
[LAMBDA (FONTDEVICE PROP) (* ; "Edited 25-Aug-2025 21:23 by rmk")
|
||||
|
||||
(* ;; "Returns the value of the PROP property of the FONTDEVICE. E.g. if FONTDEVICE is DISPLAY and PROP is %"FONTCOERCIONS%", returns the value of DISPLAYFONTCOERCIONS ((HELVETICA 1)(HELVETICA 4)...)")
|
||||
|
||||
(CL:WHEN (ILESSP NARGS 2)
|
||||
(ERROR "DEVICE/PROP not specified"))
|
||||
(LET ((FONTDEVICE (ARG NARGS 1))
|
||||
(PROP (ARG NARGS 2))
|
||||
VAR)
|
||||
[if (LITATOM FONTDEVICE)
|
||||
then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE))
|
||||
else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE))
|
||||
(SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE)
|
||||
(FONTPROP FONTDEVICE 'DEVICE)
|
||||
(fetch (FONTSPEC FSDEVICE) of FONTDEVICE))]
|
||||
(CL:UNLESS FONTDEVICE
|
||||
(SETQ FONTDEVICE 'DISPLAY))
|
||||
(SETQ VAR (PACK* FONTDEVICE PROP))
|
||||
(PROG1 (CL:WHEN (BOUNDP VAR)
|
||||
(GETATOMVAL VAR))
|
||||
(CL:WHEN (IGEQ NARGS 3)
|
||||
(SETATOMVAL VAR (ARG NARGS 3))))])
|
||||
[if (LITATOM FONTDEVICE)
|
||||
then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE))
|
||||
else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE))
|
||||
(SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE)
|
||||
(FONTPROP FONTDEVICE 'DEVICE)
|
||||
(fetch (FONTSPEC FSDEVICE) of FONTDEVICE))]
|
||||
(CL:UNLESS FONTDEVICE
|
||||
(SETQ FONTDEVICE 'DISPLAY))
|
||||
(LET ((VAR (PACK* FONTDEVICE PROP)))
|
||||
(CL:WHEN (BOUNDP VAR)
|
||||
(GETATOMVAL VAR])
|
||||
)
|
||||
|
||||
(PUTPROPS FONTDEVICEPROP ARGNAMES (FONTDEVICE PROP NEWVALUE))
|
||||
|
||||
|
||||
|
||||
(* ; "Moving character information")
|
||||
@@ -1563,8 +1550,7 @@
|
||||
NEWDESCENT])
|
||||
|
||||
(MOVEFONTCHARS
|
||||
[LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 1-Mar-2026 09:40 by rmk")
|
||||
(* ; "Edited 26-Feb-2026 16:59 by rmk")
|
||||
[LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 26-Feb-2026 16:59 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 11:07 by rmk")
|
||||
(* ; "Edited 30-Aug-2025 23:20 by rmk")
|
||||
(* ; "Edited 26-Aug-2025 23:10 by rmk")
|
||||
@@ -1596,34 +1582,27 @@
|
||||
then
|
||||
(* ;; "E.g. *UNICODETOMCCS*")
|
||||
|
||||
[MAPHASH PAIRS (FUNCTION (LAMBDA (DCODE SCODE)
|
||||
(CL:UNLESS (AND (EQ DCODE SCODE)
|
||||
(EQ DESTFONT DEFAULTSOURCEFONT))
|
||||
(\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA SCODE
|
||||
[MAPHASH PAIRS (FUNCTION (LAMBDA (VAL KEY)
|
||||
(CL:UNLESS (EQ VAL KEY)
|
||||
(\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA KEY
|
||||
DEFAULTSOURCEFONT)
|
||||
DCODE DESTFONT))]
|
||||
VAL DESTFONT))]
|
||||
else (LET (PAIRINFO)
|
||||
|
||||
(* ;; "Fix/check arguments, and expand out the information for all the source characters, so there is no toe-stepping if there are overlaps.")
|
||||
|
||||
(SETQ PAIRINFO (for P S DCODE in PAIRS
|
||||
collect (CL:WHEN (SMALLP P)
|
||||
(SETQ P (LIST P P)))
|
||||
(SETQ DCODE (CADR P))
|
||||
(CL:UNLESS (CHARCODEP DCODE)
|
||||
(SETQ DCODE (CHARCODE.DECODE DCODE)))
|
||||
(CL:WHEN (AND (EQ DCODE (CHARCODE.DECODE (CAR P)
|
||||
T))
|
||||
(EQ DESTFONT DEFAULTSOURCEFONT))
|
||||
|
||||
(* ;;
|
||||
"Skip the vacuous movement within the same font")
|
||||
|
||||
(GO $$ITERATE))
|
||||
(\INSURECHARSETINFO DESTFONT (\CHARSET DCODE))
|
||||
(LIST (\MOVEFONTCHARS.SOURCEDATA (CAR P)
|
||||
DEFAULTSOURCEFONT)
|
||||
DCODE)))
|
||||
(SETQ PAIRINFO (for P S DCODE in PAIRS collect (CL:WHEN (SMALLP P)
|
||||
(SETQ P (LIST P P)))
|
||||
(SETQ DCODE (CADR P))
|
||||
(CL:UNLESS (CHARCODEP DCODE)
|
||||
(SETQ DCODE (CHARCODE.DECODE
|
||||
DCODE)))
|
||||
(\INSURECHARSETINFO DESTFONT
|
||||
(\CHARSET DCODE))
|
||||
(LIST (\MOVEFONTCHARS.SOURCEDATA
|
||||
(CAR P)
|
||||
DEFAULTSOURCEFONT)
|
||||
DCODE)))
|
||||
|
||||
(* ;; "Install source character information into the destination font. ")
|
||||
|
||||
@@ -2749,8 +2728,7 @@
|
||||
NIL])
|
||||
|
||||
(\SEARCHFONTFILES
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 4-Mar-2026 00:14 by rmk")
|
||||
(* ; "Edited 28-Aug-2025 14:47 by rmk")
|
||||
[LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 14:47 by rmk")
|
||||
(* ; "Edited 25-Aug-2025 10:23 by rmk")
|
||||
(* ; "Edited 23-Aug-2025 12:36 by rmk")
|
||||
(* ; "Edited 21-Jul-2025 08:57 by rmk")
|
||||
@@ -2784,8 +2762,8 @@
|
||||
|
||||
(* ;;
|
||||
"make sure the face, size, and family really match.")
|
||||
when (AND THISFONT (OR (EQ FAMILY '*)
|
||||
(EQ FAMILY (fetch (FONTSPEC FSFAMILY) of THISFONT)))
|
||||
when (AND (OR (EQ FAMILY '*)
|
||||
(EQ FAMILY (fetch (FONTSPEC FSFAMILY) of THISFONT)))
|
||||
(OR (EQ SIZE '*)
|
||||
(EQ SIZE (fetch (FONTSPEC FSSIZE) of THISFONT)))
|
||||
(MATCHFONTFACE FACE (fetch (FONTSPEC FSFACE) of THISFONT))) unless (MEMBER THISFONT
|
||||
@@ -3117,9 +3095,7 @@
|
||||
CHARSETNO ← MAX.SMALLP)
|
||||
|
||||
(RECORD FONTSPEC (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE)
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(LITATOM (CAR DATUM))
|
||||
(FIXP (CADR DATUM])
|
||||
(TYPE? LISTP))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
|
||||
@@ -4514,46 +4490,46 @@
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP)
|
||||
(ADDTOVAR LAMA FONTCOPY)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (11576 21243 (CHARWIDTH 11586 . 12375) (CHARWIDTHY 12377 . 13894) (STRINGWIDTH 13896 .
|
||||
14933) (\CHARWIDTH.DISPLAY 14935 . 15350) (\STRINGWIDTH.DISPLAY 15352 . 15780) (\STRINGWIDTH.GENERIC
|
||||
15782 . 21241)) (21244 27876 (DEFAULTFONT 21254 . 22539) (FONTCLASS 22541 . 24813) (FONTCLASSUNPARSE
|
||||
24815 . 25716) (FONTCLASSCOMPONENT 25718 . 26306) (SETFONTCLASSCOMPONENT 26308 . 26750) (
|
||||
GETFONTCLASSCOMPONENT 26752 . 27874)) (29589 47629 (FONTCREATE 29599 . 32844) (FONTCREATE1 32846 .
|
||||
35461) (FONTCREATE.SLUGFD 35463 . 36967) (\FONT.CHECKARGS1 36969 . 41674) (\FONTCREATE1.NOFN 41676 .
|
||||
41890) (FONTFILEP 41892 . 42780) (\READCHARSET 42782 . 47627)) (47630 54706 (\FONT.CHECKARGS 47640 .
|
||||
54389) (\CHARSET.CHECK 54391 . 54704)) (54707 61318 (COERCEFONTSPEC 54717 . 60629) (
|
||||
COERCEFONTSPEC.TARGETFACE 60631 . 61316)) (63513 64862 (MAKEFONTSPEC 63523 . 64860)) (64863 73040 (
|
||||
COMPLETE.FONT 64873 . 67396) (COMPLETEFONTP 67398 . 68021) (COMPLETE.CHARSET 68023 . 70708) (
|
||||
PRUNESLUGCSINFOS 70710 . 71635) (MONOSPACEFONTP 71637 . 73038)) (73079 81537 (FONTASCENT 73089 . 73473
|
||||
) (FONTDESCENT 73475 . 73960) (FONTHEIGHT 73962 . 74364) (FONTPROP 74366 . 80814) (\AVGCHARWIDTH 80816
|
||||
. 81535)) (82194 83627 (FONTDEVICEPROP 82204 . 83625)) (83744 84598 (EDITCHAR 83754 . 84596)) (84644
|
||||
96834 (GETCHARBITMAP 84654 . 85778) (PUTCHARBITMAP 85780 . 87938) (\GETCHARBITMAP.CSINFO 87940 . 89956
|
||||
) (\PUTCHARBITMAP.CSINFO 89958 . 96832)) (96835 118474 (MOVECHARBITMAP 96845 . 98739) (MOVEFONTCHARS
|
||||
98741 . 103846) (\MOVEFONTCHAR 103848 . 108695) (\MOVEFONTCHARS.SOURCEDATA 108697 . 114812) (
|
||||
\MAKESLUGCHAR 114814 . 117349) (SLUGCHARP.DISPLAY 117351 . 118472)) (119132 130981 (FONTFILES 119142
|
||||
. 120975) (\FINDFONTFILE 120977 . 122954) (\FONTFILENAMES 122956 . 123516) (\FONTFILENAME 123518 .
|
||||
126429) (FONTSPECFROMFILENAME 126431 . 130979)) (130982 167231 (FONTCOPY 130992 . 136075) (FONTP
|
||||
136077 . 136376) (FONTUNPARSE 136378 . 138101) (SETFONTDESCRIPTOR 138103 . 139567) (\STREAMCHARWIDTH
|
||||
139569 . 143580) (\COERCECHARSET 143582 . 146949) (\BUILDSLUGCSINFO 146951 . 150582) (\FONTSYMBOL
|
||||
150584 . 151238) (\DEVICESYMBOL 151240 . 152024) (\FONTFACE 152026 . 159230) (\FONTFACE.COLOR 159232
|
||||
. 166014) (SETFONTCHARENCODING 166016 . 167229)) (167232 187036 (FONTSAVAILABLE 167242 . 172606) (
|
||||
FONTEXISTS? 172608 . 176149) (\SEARCHFONTFILES 176151 . 179365) (FLUSHFONTCACHE 179367 . 181590) (
|
||||
FINDFONTFILES 181592 . 184808) (SORTFONTSPECS 184810 . 187034)) (187037 191152 (MATCHFONTFACE 187047
|
||||
. 187862) (MAKEFONTFACE 187864 . 188898) (FONTFACETOATOM 188900 . 191150)) (191783 192275 (
|
||||
\UNITWIDTHSVECTOR 191793 . 192273)) (207029 209096 (FONTDESCRIPTOR.DEFPRINT 207039 . 208618) (
|
||||
FONTCLASS.DEFPRINT 208620 . 209094)) (212925 215715 (\CREATEKERNELEMENT 212935 . 213293) (
|
||||
\FSETLEFTKERN 213295 . 213786) (\FGETLEFTKERN 213788 . 215713)) (215716 227382 (\CREATEFONT 215726 .
|
||||
218622) (\CREATECHARSET 218624 . 223133) (\INSTALLCHARSETINFO 223135 . 226469) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 226471 . 227380)) (227704 229072 (\FONTRESETCHARWIDTHS 227714 .
|
||||
229070)) (229702 239779 (\CREATEDISPLAYFONT 229712 . 231579) (\CREATECHARSET.DISPLAY 231581 . 237296)
|
||||
(\FONTEXISTS?.DISPLAY 237298 . 239777)) (239780 254785 (STRIKEFONT.FILEP 239790 . 240678) (
|
||||
STRIKEFONT.GETCHARSET 240680 . 246274) (WRITESTRIKEFONTFILE 246276 . 251189) (STRIKECSINFO 251191 .
|
||||
254783)) (254816 271149 (MAKEBOLD.CHARSET 254826 . 258481) (MAKEBOLD.CHAR 258483 . 260235) (
|
||||
MAKEITALIC.CHARSET 260237 . 263916) (MAKEITALIC.CHAR 263918 . 266264) (\SFMAKEBOLD 266266 . 268492) (
|
||||
\SFMAKEITALIC 268494 . 271147)) (271150 275174 (\SFMAKEROTATEDFONT 271160 . 272394) (\SFROTATECSINFO
|
||||
272396 . 273071) (\SFROTATEFONTCHARACTERS 273073 . 273457) (\SFROTATECSINFOOFFSETS 273459 . 275172)) (
|
||||
275175 276349 (\SFMAKECOLOR 275185 . 276347)))))
|
||||
(FILEMAP (NIL (11429 21096 (CHARWIDTH 11439 . 12228) (CHARWIDTHY 12230 . 13747) (STRINGWIDTH 13749 .
|
||||
14786) (\CHARWIDTH.DISPLAY 14788 . 15203) (\STRINGWIDTH.DISPLAY 15205 . 15633) (\STRINGWIDTH.GENERIC
|
||||
15635 . 21094)) (21097 27729 (DEFAULTFONT 21107 . 22392) (FONTCLASS 22394 . 24666) (FONTCLASSUNPARSE
|
||||
24668 . 25569) (FONTCLASSCOMPONENT 25571 . 26159) (SETFONTCLASSCOMPONENT 26161 . 26603) (
|
||||
GETFONTCLASSCOMPONENT 26605 . 27727)) (29442 47482 (FONTCREATE 29452 . 32697) (FONTCREATE1 32699 .
|
||||
35314) (FONTCREATE.SLUGFD 35316 . 36820) (\FONT.CHECKARGS1 36822 . 41527) (\FONTCREATE1.NOFN 41529 .
|
||||
41743) (FONTFILEP 41745 . 42633) (\READCHARSET 42635 . 47480)) (47483 54559 (\FONT.CHECKARGS 47493 .
|
||||
54242) (\CHARSET.CHECK 54244 . 54557)) (54560 61171 (COERCEFONTSPEC 54570 . 60482) (
|
||||
COERCEFONTSPEC.TARGETFACE 60484 . 61169)) (63366 64715 (MAKEFONTSPEC 63376 . 64713)) (64716 72893 (
|
||||
COMPLETE.FONT 64726 . 67249) (COMPLETEFONTP 67251 . 67874) (COMPLETE.CHARSET 67876 . 70561) (
|
||||
PRUNESLUGCSINFOS 70563 . 71488) (MONOSPACEFONTP 71490 . 72891)) (72932 81390 (FONTASCENT 72942 . 73326
|
||||
) (FONTDESCENT 73328 . 73813) (FONTHEIGHT 73815 . 74217) (FONTPROP 74219 . 80667) (\AVGCHARWIDTH 80669
|
||||
. 81388)) (82047 82955 (FONTDEVICEPROP 82057 . 82953)) (83001 83855 (EDITCHAR 83011 . 83853)) (83901
|
||||
96091 (GETCHARBITMAP 83911 . 85035) (PUTCHARBITMAP 85037 . 87195) (\GETCHARBITMAP.CSINFO 87197 . 89213
|
||||
) (\PUTCHARBITMAP.CSINFO 89215 . 96089)) (96092 117372 (MOVECHARBITMAP 96102 . 97996) (MOVEFONTCHARS
|
||||
97998 . 102744) (\MOVEFONTCHAR 102746 . 107593) (\MOVEFONTCHARS.SOURCEDATA 107595 . 113710) (
|
||||
\MAKESLUGCHAR 113712 . 116247) (SLUGCHARP.DISPLAY 116249 . 117370)) (118030 129879 (FONTFILES 118040
|
||||
. 119873) (\FINDFONTFILE 119875 . 121852) (\FONTFILENAMES 121854 . 122414) (\FONTFILENAME 122416 .
|
||||
125327) (FONTSPECFROMFILENAME 125329 . 129877)) (129880 166129 (FONTCOPY 129890 . 134973) (FONTP
|
||||
134975 . 135274) (FONTUNPARSE 135276 . 136999) (SETFONTDESCRIPTOR 137001 . 138465) (\STREAMCHARWIDTH
|
||||
138467 . 142478) (\COERCECHARSET 142480 . 145847) (\BUILDSLUGCSINFO 145849 . 149480) (\FONTSYMBOL
|
||||
149482 . 150136) (\DEVICESYMBOL 150138 . 150922) (\FONTFACE 150924 . 158128) (\FONTFACE.COLOR 158130
|
||||
. 164912) (SETFONTCHARENCODING 164914 . 166127)) (166130 185807 (FONTSAVAILABLE 166140 . 171504) (
|
||||
FONTEXISTS? 171506 . 175047) (\SEARCHFONTFILES 175049 . 178136) (FLUSHFONTCACHE 178138 . 180361) (
|
||||
FINDFONTFILES 180363 . 183579) (SORTFONTSPECS 183581 . 185805)) (185808 189923 (MATCHFONTFACE 185818
|
||||
. 186633) (MAKEFONTFACE 186635 . 187669) (FONTFACETOATOM 187671 . 189921)) (190554 191046 (
|
||||
\UNITWIDTHSVECTOR 190564 . 191044)) (205689 207756 (FONTDESCRIPTOR.DEFPRINT 205699 . 207278) (
|
||||
FONTCLASS.DEFPRINT 207280 . 207754)) (211585 214375 (\CREATEKERNELEMENT 211595 . 211953) (
|
||||
\FSETLEFTKERN 211955 . 212446) (\FGETLEFTKERN 212448 . 214373)) (214376 226042 (\CREATEFONT 214386 .
|
||||
217282) (\CREATECHARSET 217284 . 221793) (\INSTALLCHARSETINFO 221795 . 225129) (
|
||||
\INSTALLCHARSETINFO.CHARENCODING 225131 . 226040)) (226364 227732 (\FONTRESETCHARWIDTHS 226374 .
|
||||
227730)) (228362 238439 (\CREATEDISPLAYFONT 228372 . 230239) (\CREATECHARSET.DISPLAY 230241 . 235956)
|
||||
(\FONTEXISTS?.DISPLAY 235958 . 238437)) (238440 253445 (STRIKEFONT.FILEP 238450 . 239338) (
|
||||
STRIKEFONT.GETCHARSET 239340 . 244934) (WRITESTRIKEFONTFILE 244936 . 249849) (STRIKECSINFO 249851 .
|
||||
253443)) (253476 269809 (MAKEBOLD.CHARSET 253486 . 257141) (MAKEBOLD.CHAR 257143 . 258895) (
|
||||
MAKEITALIC.CHARSET 258897 . 262576) (MAKEITALIC.CHAR 262578 . 264924) (\SFMAKEBOLD 264926 . 267152) (
|
||||
\SFMAKEITALIC 267154 . 269807)) (269810 273834 (\SFMAKEROTATEDFONT 269820 . 271054) (\SFROTATECSINFO
|
||||
271056 . 271731) (\SFROTATEFONTCHARACTERS 271733 . 272117) (\SFROTATECSINFOOFFSETS 272119 . 273832)) (
|
||||
273835 275009 (\SFMAKECOLOR 273845 . 275007)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Mar-2026 22:52:59" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;252 61298
|
||||
(FILECREATED "14-Feb-2026 00:39:34" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;250 60733
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MEDLEYFONT.FILENAME MEDLEYFONT.READ.FONT MEDLEYFONT.READ.VERIFIEDFONT)
|
||||
:CHANGES-TO (FNS MEDLEYFONT.GETCHARSET MEDLEYFONT.READ.CHARSET)
|
||||
|
||||
:PREVIOUS-DATE "14-Feb-2026 00:39:34" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;250)
|
||||
:PREVIOUS-DATE "23-Jan-2026 15:10:16" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;249)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS)
|
||||
@@ -280,14 +280,14 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.READ.FONT
|
||||
[LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 2-Mar-2026 20:40 by rmk")
|
||||
(* ; "Edited 20-Jan-2026 22:31 by rmk")
|
||||
[LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 20-Jan-2026 22:31 by rmk")
|
||||
(* ; "Edited 31-Aug-2025 14:42 by rmk")
|
||||
(* ; "Edited 15-Jul-2025 20:20 by rmk")
|
||||
(* ; "Edited 9-Jul-2025 00:06 by rmk")
|
||||
(* ; "Edited 6-Jul-2025 11:45 by rmk")
|
||||
(CL:WHEN FONT
|
||||
(SETQ FONT (FONTCREATE FONT)))
|
||||
(SETQ FONT (CL:IF FONT
|
||||
(FONTCREATE FONT)
|
||||
(create FONTDESCRIPTOR)))
|
||||
(SETQ FILE (MEDLEYFONT.FILENAME FILE FONT))
|
||||
(SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS)))
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
|
||||
@@ -516,16 +516,13 @@
|
||||
(bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR])
|
||||
|
||||
(MEDLEYFONT.READ.VERIFIEDFONT
|
||||
[LAMBDA (STREAM FONT) (* ; "Edited 2-Mar-2026 20:40 by rmk")
|
||||
(* ; "Edited 20-Jan-2026 22:31 by rmk")
|
||||
[LAMBDA (STREAM FONT) (* ; "Edited 20-Jan-2026 22:31 by rmk")
|
||||
(* ; "Edited 2-Sep-2025 23:52 by rmk")
|
||||
(* ; "Edited 12-Aug-2025 17:57 by rmk")
|
||||
(* ; "Edited 10-Jun-2025 20:57 by rmk")
|
||||
(* ; "Edited 21-May-2025 22:55 by rmk")
|
||||
(* ; "Edited 19-May-2025 17:42 by rmk")
|
||||
(* ; "Edited 16-May-2025 10:28 by rmk")
|
||||
(CL:UNLESS FONT
|
||||
(SETQ FONT (create FONTDESCRIPTOR)))
|
||||
(LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)))
|
||||
(for P VAL in FONTPROPS do (SETQ VAL (CADR P))
|
||||
(SELECTQ (CAR P)
|
||||
@@ -850,9 +847,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEYFONT.FILENAME
|
||||
[LAMBDA (FILE FONT CHARSET EXTENSION DIRECTORY) (* ; "Edited 2-Mar-2026 22:45 by rmk")
|
||||
(* ; "Edited 1-Mar-2026 01:07 by rmk")
|
||||
(* ; "Edited 23-Jan-2026 15:10 by rmk")
|
||||
[LAMBDA (FILE FONT CHARSET EXTENSION DIRECTORY) (* ; "Edited 23-Jan-2026 15:10 by rmk")
|
||||
(* ; "Edited 20-Jan-2026 17:39 by rmk")
|
||||
(* ; "Edited 7-Oct-2025 11:50 by rmk")
|
||||
(* ; "Edited 4-Sep-2025 08:48 by rmk")
|
||||
@@ -860,9 +855,7 @@
|
||||
(* ; "Edited 25-May-2025 21:25 by rmk")
|
||||
(* ; "Edited 19-May-2025 17:42 by rmk")
|
||||
(* ; "Edited 16-May-2025 14:09 by rmk")
|
||||
(LET [(FONTSPEC (if (type? FONTSPEC FONT)
|
||||
then (\FONT.CHECKARGS FONT)
|
||||
else (FONTPROP FONT 'SPEC]
|
||||
(LET [(FONTSPEC (AND FONT (\FONT.CHECKARGS FONT NIL NIL NIL NIL T]
|
||||
(CL:UNLESS EXTENSION (* ;
|
||||
"EXTENSION may be needed for DIRECTORY below")
|
||||
(SETQ EXTENSION (OR (FILENAMEFIELD FILE 'EXTENSION)
|
||||
@@ -931,11 +924,11 @@
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2176 16925 (MEDLEYFONT.WRITE.FONT 2186 . 7241) (MEDLEYFONT.GETCHARSET 7243 . 11384) (
|
||||
MEDLEYFONT.CHARSET? 11386 . 12855) (MEDLEYFONT.GETFILEPROP 12857 . 14957) (MEDLEYFONT.FILEP 14959 .
|
||||
16923)) (16951 39873 (MEDLEYFONT.READ.FONT 16961 . 21550) (MEDLEYFONT.READ.CHARSET 21552 . 27267) (
|
||||
MEDLEYFONT.READ.ITEM 27269 . 33418) (MEDLEYFONT.PEEK.ITEM 33420 . 34282) (MEDLEYFONT.READ.FONTPROPS
|
||||
34284 . 34749) (MEDLEYFONT.READ.VERIFIEDFONT 34751 . 39871)) (39899 57736 (MEDLEYFONT.WRITE.CHARSET
|
||||
39909 . 44471) (MEDLEYFONT.WRITE.ITEM 44473 . 53526) (MEDLEYFONT.WRITE.FONTPROPS 53528 . 57081) (
|
||||
MEDLEYFONT.WRITE.HEADER 57083 . 57734)) (57737 60413 (MEDLEYFONT.FILENAME 57747 . 60411)))))
|
||||
(FILEMAP (NIL (2152 16901 (MEDLEYFONT.WRITE.FONT 2162 . 7217) (MEDLEYFONT.GETCHARSET 7219 . 11360) (
|
||||
MEDLEYFONT.CHARSET? 11362 . 12831) (MEDLEYFONT.GETFILEPROP 12833 . 14933) (MEDLEYFONT.FILEP 14935 .
|
||||
16899)) (16927 39618 (MEDLEYFONT.READ.FONT 16937 . 21473) (MEDLEYFONT.READ.CHARSET 21475 . 27190) (
|
||||
MEDLEYFONT.READ.ITEM 27192 . 33341) (MEDLEYFONT.PEEK.ITEM 33343 . 34205) (MEDLEYFONT.READ.FONTPROPS
|
||||
34207 . 34672) (MEDLEYFONT.READ.VERIFIEDFONT 34674 . 39616)) (39644 57481 (MEDLEYFONT.WRITE.CHARSET
|
||||
39654 . 44216) (MEDLEYFONT.WRITE.ITEM 44218 . 53271) (MEDLEYFONT.WRITE.FONTPROPS 53273 . 56826) (
|
||||
MEDLEYFONT.WRITE.HEADER 56828 . 57479)) (57482 59848 (MEDLEYFONT.FILENAME 57492 . 59846)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user