Compare commits
3 Commits
medley-240
...
mth5--Japa
| Author | SHA1 | Date | |
|---|---|---|---|
|
5007a40c4f | ||
|
|
39ee2ecb5d | ||
|
|
a90b7ed73d |
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12 258100
|
||||
(FILECREATED "28-Jan-2024 19:48:39" {LIB}POSTSCRIPTSTREAM.;4 261407
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS POSTSCRIPTFILEP)
|
||||
:CHANGES-TO (FNS READ-ADOBE-GLYPH-FILE)
|
||||
(VARS POSTSCRIPTSTREAMCOMS)
|
||||
(FILES UNICODE)
|
||||
|
||||
:PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
|
||||
:PREVIOUS-DATE "21-Nov-2023 17:06:12" {LIB}POSTSCRIPTSTREAM.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
|
||||
@@ -17,7 +19,7 @@
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
|
||||
(INITRECORDS \POSTSCRIPTDATA)
|
||||
(FNS POSTSCRIPT.INIT)
|
||||
(FNS POSTSCRIPT.INIT READ-ADOBE-GLYPH-FILE)
|
||||
(ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
|
||||
(PSC . TEXT)
|
||||
(PSF . BINARY)
|
||||
@@ -68,6 +70,8 @@
|
||||
(COMS
|
||||
(* ;; "Character-output, plus special-cases:")
|
||||
|
||||
(FILES (SYSLOAD)
|
||||
UNICODE)
|
||||
(FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG
|
||||
\POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN
|
||||
\POSTSCRIPT.ACCENTPAIR)
|
||||
@@ -481,6 +485,65 @@
|
||||
IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC)))
|
||||
(SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255))
|
||||
(\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*])
|
||||
|
||||
(READ-ADOBE-GLYPH-FILE
|
||||
[LAMBDA (FILESPEC) (* ; "Edited 28-Jan-2024 19:46 by mth")
|
||||
|
||||
(* ;; "Read the file of PostScript glyphs as provided by Adobe at ")
|
||||
|
||||
(* ;; " https://github.com/adobe-type-tools/agl-aglfn/glyphlist.txt")
|
||||
|
||||
(* ;; " The file is assumed to be local. (i.e., this does not fetch the file from github.com)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "The file format is:")
|
||||
|
||||
(* ;; "Comment lines begin with #, ignore these lines (as well as blank lines)")
|
||||
|
||||
(* ;; "Glyph lines consist of two semicolon delimited fields")
|
||||
|
||||
(* ;; " (1) glyph name -- upper/lowercase letters and digits")
|
||||
|
||||
(* ;; " (2) Unicode scalar value -- four uppercase hexadecimal digits")
|
||||
|
||||
(* ;; "* Note that some entries have multiple Unicode values. ")
|
||||
|
||||
(* ;; " These are cases of a single glyph name for composite character. ")
|
||||
|
||||
(* ;; " These must be handled separately. ")
|
||||
|
||||
(* ;;
|
||||
" (It might work just to ignore them as the composite characters may just work separately.)")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Result is a list of (glyph-name-string Unicode-values)")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILESPEC :DIRECTION :INPUT :EXTERNAL-FORMAT :UTF-8-RAW)
|
||||
(bind LINE NAME CODE SPLIT START [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE]
|
||||
while (AND (SETQ LINE (CL:READ-LINE STREAM NIL NIL))
|
||||
(SETQ LINE (CL:STRING-TRIM " " LINE)))
|
||||
when (SETQ START (STRPOSL SEPBITTABLE LINE 1 T))
|
||||
unless [OR (STREQUAL LINE "")
|
||||
(EQ (CHARCODE %#)
|
||||
(NTHCHARCODE LINE START))
|
||||
(NOT (SETQ SPLIT (STRPOS ";" LINE]
|
||||
collect (* (PROGN (SETQ NAME
|
||||
(CL:STRING-RIGHT-TRIM " "
|
||||
(SUBSTRING LINE START
|
||||
(SUB1 SPLIT)))) (SETQ CODE
|
||||
(HEXNUM? (SUBSTRING LINE
|
||||
(ADD1 SPLIT)))) (LIST CODE NAME)))
|
||||
(CONS (PROG1 (CL:STRING-RIGHT-TRIM " " (SUBSTRING LINE START (SUB1 SPLIT)))
|
||||
(SETQ START (ADD1 SPLIT)))
|
||||
(bind END while [SETQ END (OR (STRPOSL SEPBITTABLE LINE START)
|
||||
(ADD1 (NCHARS LINE]
|
||||
collect [HEXNUM? (SUBSTRING LINE START (SUB1 END)
|
||||
(CONSTANT (CONCAT]
|
||||
repeatwhile (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T))
|
||||
(NEQ (CHARCODE %#)
|
||||
(NTHCHARCODE LINE START])
|
||||
)
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT)
|
||||
@@ -3071,6 +3134,9 @@
|
||||
|
||||
(* ;; "Character-output, plus special-cases:")
|
||||
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
UNICODE)
|
||||
(DEFINEQ
|
||||
|
||||
(\POSTSCRIPT.CHANGECHARSET
|
||||
@@ -4382,39 +4448,40 @@
|
||||
|
||||
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
|
||||
)
|
||||
(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 .
|
||||
32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
|
||||
PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
|
||||
PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
|
||||
POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
|
||||
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622
|
||||
74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
|
||||
POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
|
||||
POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE
|
||||
81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
|
||||
POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND
|
||||
94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
|
||||
POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024)
|
||||
(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719)
|
||||
(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
|
||||
\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 .
|
||||
126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 .
|
||||
133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 .
|
||||
142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 .
|
||||
147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
|
||||
\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
|
||||
(\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 .
|
||||
160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
|
||||
. 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 .
|
||||
167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC
|
||||
168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
|
||||
\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 .
|
||||
180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
|
||||
\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
|
||||
\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC
|
||||
199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
|
||||
205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 .
|
||||
206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 .
|
||||
254985)))))
|
||||
(FILEMAP (NIL (22342 32527 (POSTSCRIPT.INIT 22352 . 29444) (READ-ADOBE-GLYPH-FILE 29446 . 32525)) (
|
||||
33507 68291 (PSCFONT.READFONT 33517 . 35425) (PSCFONT.SPELLFILE 35427 . 36005) (PSCFONT.COERCEFILE
|
||||
36007 . 37579) (PSCFONTFROMCACHE.SPELLFILE 37581 . 38566) (PSCFONTFROMCACHE.COERCEFILE 38568 . 40220)
|
||||
(PSCFONT.WRITEFONT 40222 . 41237) (READ-AFM-FILE 41239 . 47110) (CONVERT-AFM-FILES 47112 . 48324) (
|
||||
POSTSCRIPT.GETFONTID 48326 . 49721) (POSTSCRIPT.FONTCREATE 49723 . 62122) (
|
||||
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62124 . 64521) (POSTSCRIPT.FONTSAVAILABLE 64523 . 68289)) (68846
|
||||
77992 (OPENPOSTSCRIPTSTREAM 68856 . 77658) (CLOSEPOSTSCRIPTSTREAM 77660 . 77990)) (78037 84329 (
|
||||
POSTSCRIPT.HARDCOPYW 78047 . 81396) (POSTSCRIPT.TEDIT 81398 . 81878) (POSTSCRIPT.TEXT 81880 . 82171) (
|
||||
POSTSCRIPTFILEP 82173 . 83280) (MAKEEPSFILE 83282 . 84327)) (84330 129216 (POSTSCRIPT.BITMAPSCALE
|
||||
84340 . 86796) (POSTSCRIPT.CLOSESTRING 86798 . 87332) (POSTSCRIPT.ENDPAGE 87334 . 88205) (
|
||||
POSTSCRIPT.OUTSTR 88207 . 89228) (POSTSCRIPT.PUTBITMAPBYTES 89230 . 97701) (POSTSCRIPT.PUTCOMMAND
|
||||
97703 . 98752) (POSTSCRIPT.SET-FAKE-LANDSCAPE 98754 . 104202) (POSTSCRIPT.SHOWACCUM 104204 . 106442) (
|
||||
POSTSCRIPT.STARTPAGE 106444 . 109023) (\POSTSCRIPTTAB 109025 . 109896) (\PS.BOUTFIXP 109898 . 111248)
|
||||
(\PS.SCALEHACK 111250 . 114079) (\PS.SCALEREGION 114081 . 114641) (\SCALEDBITBLT.PSC 114643 . 118943)
|
||||
(\SETPOS.PSC 118945 . 119407) (\SETXFORM.PSC 119409 . 121228) (\STRINGWIDTH.PSC 121230 . 121684) (
|
||||
\SWITCHFONTS.PSC 121686 . 127843) (\TERPRI.PSC 127845 . 129214)) (129251 184971 (\BITBLT.PSC 129261 .
|
||||
129814) (\BLTSHADE.PSC 129816 . 134098) (\CHARWIDTH.PSC 134100 . 134867) (\CREATECHARSET.PSC 134869 .
|
||||
136567) (\DRAWARC.PSC 136569 . 139049) (\DRAWCIRCLE.PSC 139051 . 141460) (\DRAWCURVE.PSC 141462 .
|
||||
145483) (\DRAWELLIPSE.PSC 145485 . 147962) (\DRAWLINE.PSC 147964 . 150314) (\DRAWPOINT.PSC 150316 .
|
||||
150904) (\DRAWPOLYGON.PSC 150906 . 154020) (\DSPBOTTOMMARGIN.PSC 154022 . 154587) (
|
||||
\DSPCLIPPINGREGION.PSC 154589 . 156032) (\DSPCOLOR.PSC 156034 . 156875) (\DSPFONT.PSC 156877 . 161087)
|
||||
(\DSPLEFTMARGIN.PSC 161089 . 161658) (\DSPLINEFEED.PSC 161660 . 162236) (\DSPPUSHSTATE.PSC 162238 .
|
||||
164001) (\DSPPOPSTATE.PSC 164003 . 166512) (\DSPRESET.PSC 166514 . 167160) (\DSPRIGHTMARGIN.PSC 167162
|
||||
. 167734) (\DSPROTATE.PSC 167736 . 168759) (\DSPSCALE.PSC 168761 . 169692) (\DSPSCALE2.PSC 169694 .
|
||||
170513) (\DSPSPACEFACTOR.PSC 170515 . 171487) (\DSPTOPMARGIN.PSC 171489 . 172206) (\DSPTRANSLATE.PSC
|
||||
172208 . 174782) (\DSPXPOSITION.PSC 174784 . 175383) (\DSPYPOSITION.PSC 175385 . 175957) (
|
||||
\FILLCIRCLE.PSC 175959 . 178605) (\FILLPOLYGON.PSC 178607 . 182523) (\FIXLINELENGTH.PSC 182525 .
|
||||
184019) (\MOVETO.PSC 184021 . 184772) (\NEWPAGE.PSC 184774 . 184969)) (185065 208217 (
|
||||
\POSTSCRIPT.CHANGECHARSET 185075 . 185879) (\POSTSCRIPT.OUTCHARFN 185881 . 198738) (
|
||||
\POSTSCRIPT.PRINTSLUG 198740 . 200707) (\POSTSCRIPT.SPECIALOUTCHARFN 200709 . 203141) (\UPDATE.PSC
|
||||
203143 . 204366) (\POSTSCRIPT.ACCENTFN 204368 . 205310) (\POSTSCRIPT.ACCENTPAIR 205312 . 208215)) (
|
||||
208315 209960 (\PSC.SPACEDISP 208325 . 208604) (\PSC.SPACEWID 208606 . 209225) (\PSC.SYMBOLS 209227 .
|
||||
209958)) (210069 213060 (\POSTSCRIPT.NSHASH 210079 . 213058)) (257535 258249 (POSTSCRIPTSEND 257545 .
|
||||
258247)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
178
library/UNICODE
178
library/UNICODE
@@ -1,18 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Jan-2024 10:58:06" {WMEDLEY}<library>UNICODE.;212 72240
|
||||
(FILECREATED "26-Jan-2024 14:19:50" {LIB}UNICODE.;4 72688
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS NUTF8CODEBYTES)
|
||||
:CHANGES-TO (FNS MAKE-UNICODE-FORMATS MAKE-UNICODE-TRANSLATION-TABLES SHOWCHARS
|
||||
READ-UNICODE-MAPPING-FILENAMES)
|
||||
(VARS UNICODECOMS)
|
||||
|
||||
:PREVIOUS-DATE " 5-Jan-2024 17:25:29" {WMEDLEY}<library>UNICODE.;211)
|
||||
:PREVIOUS-DATE " 8-Jan-2024 10:58:06" {LIB}UNICODE.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNICODECOMS)
|
||||
|
||||
(RPAQQ UNICODECOMS
|
||||
[(COMS
|
||||
((COMS
|
||||
(* ;; "External formats")
|
||||
|
||||
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
|
||||
@@ -61,7 +63,7 @@
|
||||
XCCSSTRING)
|
||||
(FNS \UTF8.FETCHCODE)
|
||||
(FNS SHOWCHARS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
|
||||
[DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
|
||||
EXPORTS.ALL)
|
||||
|
||||
(* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")
|
||||
@@ -70,7 +72,9 @@
|
||||
(MAX-ALIST-LENGTH 10)
|
||||
(N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE))
|
||||
(TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE)))
|
||||
(TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE])
|
||||
(TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE]
|
||||
(PROP (FILETYPE)
|
||||
UNICODE)))
|
||||
|
||||
|
||||
|
||||
@@ -528,16 +532,19 @@
|
||||
(DEFINEQ
|
||||
|
||||
(READ-UNICODE-MAPPING-FILENAMES
|
||||
[LAMBDA (FILESPEC DIRS) (* ; "Edited 5-Jan-2024 17:24 by rmk")
|
||||
[LAMBDA (FILESPEC DIRS) (* ; "Edited 26-Jan-2024 14:02 by mth")
|
||||
(* ; "Edited 5-Jan-2024 17:24 by rmk")
|
||||
(* ; "Edited 5-Aug-2020 15:59 by kaplan")
|
||||
(* ; "Edited 4-Aug-2020 17:31 by rmk:")
|
||||
(DECLARE (USEDFREE UNICODEDIRECTORIES XCCS-SET-NAMES))
|
||||
(CL:UNLESS DIRS (SETQ DIRS UNICODEDIRECTORIES))
|
||||
(FOR F X CSI INSIDE FILESPEC JOIN
|
||||
(* ;;
|
||||
"Last case hopes to pick up tables that are gruped together in a subdirectory (e.g. JIS)")
|
||||
|
||||
(OR (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT)
|
||||
T DIRS)
|
||||
(OR (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION
|
||||
'TXT)
|
||||
T DIRS))
|
||||
(for D inside DIRS
|
||||
when (SETQ D (FILDIR (PACKFILENAME 'NAME
|
||||
(CONCAT "XCCS-*=" F)
|
||||
@@ -876,7 +883,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-UNICODE-TRANSLATION-TABLES
|
||||
[LAMBDA (MAPPING LTORVAR RTOLVAR) (* ; "Edited 21-Aug-2021 13:12 by rmk:")
|
||||
[LAMBDA (MAPPING LTORVAR RTOLVAR) (* ; "Edited 21-Aug-2021 13:12 by rmk:")
|
||||
(* ; "Edited 17-Aug-2020 08:46 by rmk:")
|
||||
|
||||
(* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.")
|
||||
@@ -902,7 +909,7 @@
|
||||
(* ;; "")
|
||||
|
||||
(* ;;
|
||||
"An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")
|
||||
"An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -918,75 +925,67 @@
|
||||
(* ;; "The left-to-right direction (into Unicode). We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte). The second loop converts long alists into arrays.")
|
||||
|
||||
[FOR M LEFTC RBASE RCODES IN MAPPING EACHTIME (SETQ RCODES (CDR M))
|
||||
(SETQ RBASE (CAR RCODES))
|
||||
(SETQ RBASE (CAR RCODES))
|
||||
UNLESS (IGEQ RBASE MISSINGCODE) DO (SETQ LEFTC (CAR M))
|
||||
|
||||
(* ;;
|
||||
"(CDR RCODES) contains combiners on the base")
|
||||
(* ;; "(CDR RCODES) contains combiners on the base")
|
||||
|
||||
(CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
|
||||
(CL:IF (CDR RCODES)
|
||||
RCODES
|
||||
RBASE))
|
||||
(CL:SVREF LTORARRAY (LRSH LEFTC
|
||||
TRANSLATION-SHIFT
|
||||
]
|
||||
(CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
|
||||
(CL:IF (CDR RCODES)
|
||||
RCODES
|
||||
RBASE))
|
||||
(CL:SVREF LTORARRAY (LRSH LEFTC
|
||||
TRANSLATION-SHIFT]
|
||||
(FOR I CSA FROM 0 TO (SUB1 N-TRANSLATION-SEGMENTS)
|
||||
WHEN (IGREATERP (LENGTH (CL:SVREF LTORARRAY I))
|
||||
MAX-ALIST-LENGTH)
|
||||
DO
|
||||
MAX-ALIST-LENGTH) DO
|
||||
(* ;; "Leave it alone if the alist is short")
|
||||
|
||||
(* ;; "Leave it alone if the alist is short")
|
||||
|
||||
(SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
|
||||
(FOR P IN (CL:SVREF LTORARRAY I)
|
||||
DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
|
||||
TRANSLATION-MASK))
|
||||
(CDR P)))
|
||||
(CL:SETF (CL:SVREF LTORARRAY I)
|
||||
CSA))
|
||||
(SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE
|
||||
:INITIAL-ELEMENT NIL))
|
||||
(FOR P IN (CL:SVREF LTORARRAY I)
|
||||
DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
|
||||
TRANSLATION-MASK))
|
||||
(CDR P)))
|
||||
(CL:SETF (CL:SVREF LTORARRAY I)
|
||||
CSA))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.")
|
||||
|
||||
(FOR M LEFTC RBASE RCOMBINERS PREV IN MAPPING EACHTIME (SETQ RBASE (CADR M))
|
||||
(SETQ RCOMBINERS (CDDR M))
|
||||
(SETQ RCOMBINERS (CDDR M))
|
||||
UNLESS (OR (IGEQ RBASE MISSINGCODE)
|
||||
RCOMBINERS) DO
|
||||
RCOMBINERS) DO
|
||||
(* ;;
|
||||
"Have we already seen an explicit mapping from right to left?")
|
||||
|
||||
(* ;;
|
||||
"Have we already seen an explicit mapping from right to left?")
|
||||
|
||||
(SETQ LEFTC (CAR M))
|
||||
[SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
|
||||
(CL:SVREF RTOLARRAY (LRSH RBASE
|
||||
TRANSLATION-SHIFT
|
||||
]
|
||||
(IF (NULL PREV)
|
||||
THEN (CL:PUSH (CONS (LOGAND RBASE
|
||||
TRANSLATION-MASK)
|
||||
LEFTC)
|
||||
(CL:SVREF RTOLARRAY (LRSH RBASE
|
||||
TRANSLATION-SHIFT
|
||||
)))
|
||||
ELSEIF (IGREATERP (CDR PREV)
|
||||
LEFTC)
|
||||
THEN (RPLACD PREV LEFTC)))
|
||||
(SETQ LEFTC (CAR M))
|
||||
[SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
|
||||
(CL:SVREF RTOLARRAY (LRSH RBASE
|
||||
TRANSLATION-SHIFT]
|
||||
(IF (NULL PREV)
|
||||
THEN (CL:PUSH (CONS (LOGAND RBASE TRANSLATION-MASK)
|
||||
LEFTC)
|
||||
(CL:SVREF RTOLARRAY (LRSH RBASE
|
||||
TRANSLATION-SHIFT)))
|
||||
ELSEIF (IGREATERP (CDR PREV)
|
||||
LEFTC)
|
||||
THEN (RPLACD PREV LEFTC)))
|
||||
(FOR I CSA FROM 0 TO (SUB1 N-TRANSLATION-SEGMENTS)
|
||||
WHEN (IGREATERP (LENGTH (CL:SVREF RTOLARRAY I))
|
||||
MAX-ALIST-LENGTH)
|
||||
DO
|
||||
MAX-ALIST-LENGTH) DO
|
||||
(* ;; "Long list, make an array")
|
||||
|
||||
(* ;; "Long list, make an array")
|
||||
|
||||
(SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
|
||||
(FOR P IN (CL:SVREF RTOLARRAY I)
|
||||
DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
|
||||
TRANSLATION-MASK))
|
||||
(CDR P)))
|
||||
(CL:SETF (CL:SVREF RTOLARRAY I)
|
||||
CSA))
|
||||
(SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE
|
||||
:INITIAL-ELEMENT NIL))
|
||||
(FOR P IN (CL:SVREF RTOLARRAY I)
|
||||
DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P)
|
||||
TRANSLATION-MASK))
|
||||
(CDR P)))
|
||||
(CL:SETF (CL:SVREF RTOLARRAY I)
|
||||
CSA))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -1285,14 +1284,15 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SHOWCHARS
|
||||
[LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 1-Aug-2020 09:27 by rmk:")
|
||||
[LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 26-Jan-2024 14:18 by mth")
|
||||
(* ; "Edited 1-Aug-2020 09:27 by rmk:")
|
||||
(RESETFORM (DSPFONT (OR FONT '(CLASSIC 12))
|
||||
T)
|
||||
(CL:WHEN (AND (SMALLP FROMCHAR)
|
||||
(NOT TOCHAR))
|
||||
|
||||
(* ;;
|
||||
"If a small number, assume it's an octal (in decimal) character set, no need for string quotes")
|
||||
"If a small number, assume it's an octal (in decimal) character set, no need for string quotes")
|
||||
|
||||
(SETQ TOCHAR (CONCAT FROMCHAR "," 376))
|
||||
(SETQ FROMCHAR (CONCAT FROMCHAR "," 41)))
|
||||
@@ -1302,16 +1302,16 @@
|
||||
(SETQ TOCHAR (CL:IF TOCHAR
|
||||
(CHARCODE.DECODE TOCHAR)
|
||||
FROMCHAR)))
|
||||
(FOR C FROM FROMCHAR TO TOCHAR UNLESS (AND (IGEQ (LOGAND C 255)
|
||||
127)
|
||||
(ILEQ (LOGAND C 255)
|
||||
(PLUS 128 33)))
|
||||
DO (PRINTOUT T .P2 (CONCAT (OCTALSTRING (LRSH CODE 8))
|
||||
","
|
||||
(OCTALSTRING (LOGAND CODE 255)))
|
||||
10
|
||||
(CHARACTER C)
|
||||
T])
|
||||
(for C from FROMCHAR to TOCHAR unless (AND (IGEQ (LOGAND C 255)
|
||||
127)
|
||||
(ILEQ (LOGAND C 255)
|
||||
(PLUS 128 33)))
|
||||
do (PRINTOUT T .P2 (CONCAT (OCTALSTRING (LRSH C 8))
|
||||
","
|
||||
(OCTALSTRING (LOGAND C 255)))
|
||||
10
|
||||
(CHARACTER C)
|
||||
T])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1338,17 +1338,19 @@
|
||||
(TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE)))
|
||||
)
|
||||
)
|
||||
|
||||
(PUTPROPS UNICODE FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3950 18041 (UTF8.OUTCHARFN 3960 . 6791) (UTF8.INCCODEFN 6793 . 12283) (UTF8.PEEKCCODEFN
|
||||
12285 . 17059) (\UTF8.BACKCCODEFN 17061 . 18039)) (18042 21823 (UTF16BE.OUTCHARFN 18052 . 18876) (
|
||||
UTF16BE.INCCODEFN 18878 . 19777) (UTF16BE.PEEKCCODEFN 19779 . 20850) (\UTF16BE.BACKCCODEFN 20852 .
|
||||
21821)) (21853 24134 (MAKE-UNICODE-FORMATS 21863 . 24132)) (24231 25537 (UNICODE.UNMAPPED 24241 .
|
||||
25535)) (25538 26214 (XCCS-UTF8-AFTER-OPEN 25548 . 26212)) (27670 28019 (XTOUCODE 27680 . 27848) (
|
||||
UTOXCODE 27850 . 28017)) (28059 44757 (READ-UNICODE-MAPPING-FILENAMES 28069 . 30519) (
|
||||
READ-UNICODE-MAPPING 30521 . 33497) (WRITE-UNICODE-MAPPING 33499 . 37249) (WRITE-UNICODE-INCLUDED
|
||||
37251 . 41973) (WRITE-UNICODE-MAPPING-HEADER 41975 . 43223) (WRITE-UNICODE-MAPPING-FILENAME 43225 .
|
||||
44755)) (48071 56550 (MAKE-UNICODE-TRANSLATION-TABLES 48081 . 56548)) (57055 68253 (UTF-8.VALIDATE
|
||||
57065 . 60067) (HEXSTRING 60069 . 61230) (UTF8HEXSTRING 61232 . 63437) (NUTF8CODEBYTES 63439 . 64392)
|
||||
(NUTF8STRINGBYTES 64394 . 64875) (XTOUSTRING 64877 . 67888) (XCCSSTRING 67890 . 68251)) (68254 70058 (
|
||||
\UTF8.FETCHCODE 68264 . 70056)) (70059 71528 (SHOWCHARS 70069 . 71526)))))
|
||||
(FILEMAP (NIL (4111 18202 (UTF8.OUTCHARFN 4121 . 6952) (UTF8.INCCODEFN 6954 . 12444) (UTF8.PEEKCCODEFN
|
||||
12446 . 17220) (\UTF8.BACKCCODEFN 17222 . 18200)) (18203 21984 (UTF16BE.OUTCHARFN 18213 . 19037) (
|
||||
UTF16BE.INCCODEFN 19039 . 19938) (UTF16BE.PEEKCCODEFN 19940 . 21011) (\UTF16BE.BACKCCODEFN 21013 .
|
||||
21982)) (22014 24295 (MAKE-UNICODE-FORMATS 22024 . 24293)) (24392 25698 (UNICODE.UNMAPPED 24402 .
|
||||
25696)) (25699 26375 (XCCS-UTF8-AFTER-OPEN 25709 . 26373)) (27831 28180 (XTOUCODE 27841 . 28009) (
|
||||
UTOXCODE 28011 . 28178)) (28220 45174 (READ-UNICODE-MAPPING-FILENAMES 28230 . 30936) (
|
||||
READ-UNICODE-MAPPING 30938 . 33914) (WRITE-UNICODE-MAPPING 33916 . 37666) (WRITE-UNICODE-INCLUDED
|
||||
37668 . 42390) (WRITE-UNICODE-MAPPING-HEADER 42392 . 43640) (WRITE-UNICODE-MAPPING-FILENAME 43642 .
|
||||
45172)) (48488 56912 (MAKE-UNICODE-TRANSLATION-TABLES 48498 . 56910)) (57417 68615 (UTF-8.VALIDATE
|
||||
57427 . 60429) (HEXSTRING 60431 . 61592) (UTF8HEXSTRING 61594 . 63799) (NUTF8CODEBYTES 63801 . 64754)
|
||||
(NUTF8STRINGBYTES 64756 . 65237) (XTOUSTRING 65239 . 68250) (XCCSSTRING 68252 . 68613)) (68616 70420 (
|
||||
\UTF8.FETCHCODE 68626 . 70418)) (70421 71931 (SHOWCHARS 70431 . 71929)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user