diff options
Diffstat (limited to 'lisp/international/fontset.el')
| -rw-r--r-- | lisp/international/fontset.el | 1159 |
1 files changed, 695 insertions, 464 deletions
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 6a8ab89bb6e..c0e9a5582a4 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -6,8 +6,11 @@ ;; 2005, 2006, 2007 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021 +;; Copyright (C) 2003, 2006 +;; National Institute of Advanced Industrial Science and Technology (AIST) +;; Registration Number H13PRO009 -;; Keywords: mule, multilingual, fontset +;; Keywords: mule, i18n, fontset ;; This file is part of GNU Emacs. @@ -30,361 +33,574 @@ ;;; Code: +;; Setup font-encoding-alist for all known encodings. + +(setq font-encoding-alist + '(("iso8859-1$" . iso-8859-1) + ("iso8859-2$" . iso-8859-2) + ("iso8859-3$" . iso-8859-3) + ("iso8859-4$" . iso-8859-4) + ("iso8859-5$" . iso-8859-5) + ("iso8859-6$" . iso-8859-6) + ("iso8859-7$" . iso-8859-7) + ("iso8859-8$" . iso-8859-8) + ("iso8859-9$" . iso-8859-9) + ("iso8859-10$" . iso-8859-10) + ("iso8859-11$" . iso-8859-11) + ("iso8859-13$" . iso-8859-13) + ("iso8859-14$" . iso-8859-14) + ("iso8859-15$" . iso-8859-15) + ("gb2312.1980" . chinese-gb2312) + ("gbk" . chinese-gbk) + ("gb18030" . gb18030) + ("jisx0208.1978" . japanese-jisx0208-1978) + ("jisx0208" . japanese-jisx0208) + ("jisx0201" . jisx0201) + ("jisx0212" . japanese-jisx0212) + ("ksc5601.1987" . korean-ksc5601) + ("cns11643.1992.*1" . chinese-cns11643-1) + ("cns11643.1992.*2" . chinese-cns11643-2) + ("cns11643.1992.*3" . chinese-cns11643-3) + ("cns11643.1992.*4" . chinese-cns11643-4) + ("cns11643.1992.*5" . chinese-cns11643-5) + ("cns11643.1992.*6" . chinese-cns11643-6) + ("cns11643.1992.*7" . chinese-cns11643-7) + ("cns11643.92p1-0" . chinese-cns11643-1) + ("cns11643.92p2-0" . chinese-cns11643-2) + ("cns11643.92p3-0" . chinese-cns11643-3) + ("cns11643.92p4-0" . chinese-cns11643-4) + ("cns11643.92p5-0" . chinese-cns11643-5) + ("cns11643.92p6-0" . chinese-cns11643-6) + ("cns11643.92p7-0" . chinese-cns11643-7) + ("big5" . big5) + ("sisheng_cwnn" . chinese-sisheng) + ("viscii" . viscii) + ("tis620" . tis620-2533) + ("microsoft-cp1251" . windows-1251) + ("koi8-r" . koi8-r) + ("mulearabic-0" . arabic-digit) + ("mulearabic-1" . arabic-1-column) + ("mulearabic-2" . arabic-2-column) + ("muleipa" . ipa) + ("ethiopic-unicode" . (unicode-bmp . ethiopic)) + ("is13194-devanagari" . indian-is13194) + ("Devanagari-CDAC" . devanagari-cdac) + ("Sanskrit-CDAC" . sanskrit-cdac) + ("Bengali-CDAC" . bengali-cdac) + ("Assamese-CDAC" . assamese-cdac) + ("Punjabi-CDAC" . punjabi-cdac) + ("Gujarati-CDAC" . gujarati-cdac) + ("Oriya-CDAC" . oriya-cdac) + ("Tamil-CDAC" . tamil-cdac) + ("Telugu-CDAC" . telugu-cdac) + ("Kannada-CDAC" . kannada-cdac) + ("Malayalam-CDAC" . malayalam-cdac) + ("Devanagari-Akruti" . devanagari-akruti) + ("Bengali-Akruti" . bengali-akruti) + ("Punjabi-Akruti" . punjabi-akruti) + ("Gujarati-Akruti" . gujarati-akruti) + ("Oriya-Akruti" . oriya-akruti) + ("Tamil-Akruti" . tamil-akruti) + ("Telugu-Akruti" . telugu-akruti) + ("Kannada-Akruti" . kannada-akruti) + ("Malayalam-Akruti" . malayalam-akruti) + ("muleindian-2" . indian-2-column) + ("muleindian-1" . indian-1-column) + ("mulelao-1" . mule-lao) + ("muletibetan-2" . tibetan) + ("muletibetan-1" . tibetan-1-column) + ("jisx0213.2000-1" . japanese-jisx0213-1) + ("jisx0213.2000-2" . japanese-jisx0213-2) + ("jisx0213.2004-1" . japanese-jisx0213.2004-1) + ("abobe-symbol" . symbol) + ("iso10646-1$" . (unicode-bmp . nil)) + ("iso10646.indian-1" . (unicode-bmp . nil)))) + +(setq script-representative-chars + '((latin ?A ?Z ?a ?z) + (greek #x3A9) + (coptic #x3E2) + (cyrillic #x42F) + (armenian #x531) + (hebrew #x5D0) + (arabic #x628) + (syriac #x710) + (thaana #x78C) + (devanagari #x915) + (bengali #x995) + (gurmukhi #xA15) + (gujarati #xA95) + (oriya #xB15) + (tamil #xB95) + (telugu #xC15) + (kannada #xC95) + (malayalam #xD15) + (sinhala #xD95) + (thai #xE17) + (lao #xEA5) + (tibetan #xF40) + (myanmar #x1000) + (georgian #x10D3) + (ethiopic #x1208) + (cherokee #x13B6) + (canadian-aboriginal #x14C0) + (ogham #x168F) + (runic #x16A0) + (khmer #x1780) + (mongolian #x1826) + (braille #x2800) + (ideographic-description #x2FF0) + (cjk-misc #x300E) + (kana #x304B) + (bopomofo #x3105) + (kanbun #x319D) + (han #x5B57) + (yi #xA288) + (hangul #xAC00))) + +(setq otf-script-alist + '((arab . arabic) + (armn . armenian) + (bali . balinese) + (beng . bengali) + (bopo . bopomofo) + (brai . braille) + (bugi . buginese) + (buhd . buhid) + (byzm . byzantine-musical-symbol) + (cans . canadian_aboliginal) + (cher . cherokee) + (copt . coptic) + (xsux . cuneiform) + (cyrl . cyrillic) + (cprt . cypriot) + (dsrt . deseret) + (deva . devanagari) + (ethi . ethiopic) + (geor . georgian) + (glag . glagolitic) + (goth . gothic) + (grek . greek) + (gujr . gujarati) + (guru . gurmukhi) + (hani . han) + (hang . hangul) + (hano . hanunoo) + (hebr . hebrew) + (kana . kana) + (knda . kannada) + (khar . kharoshthi) + (khmr . khmer) + (lao . lao) + (latn . latin) + (limb . limbu) + (linb . linear_b) + (mlym . malayalam) + (math . mathematical) + (mong . mongolian) + (musc . musical-symbol) + (mymr . myanmar) + (nko . nko) + (ogam . ogham) + (ital . old_italic) + (xpeo . old_persian) + (orya . oriya) + (osma . osmanya) + (phag . phags-pa) + (phnx . phoenician) + (runr . runic) + (shaw . shavian) + (sinh . sinhala) + (sylo . syloti_nagri) + (syrc . syriac) + (tglg . tagalog) + (tagb . tagbanwa) + (taml . tamil) + (tale . tai_le) + (telu . telugu) + (thaa . thaana) + (thai . thai) + (tibt . tibetan) + (tfng . tifinagh) + (ugar . ugaritic) + (yi . yi))) + ;; Set standard fontname specification of characters in the default -;; fontset to find an appropriate font for each charset. This is used -;; to generate a font name for a fontset if the fontset doesn't -;; specify a font name for a specific character. The specification -;; has the form (FAMILY . REGISTRY). FAMILY may be nil, in which -;; case, the family name of default face is used. If REGISTRY +;; fontset to find an appropriate font for each script/charset. The +;; specification has the form ((SCRIPT FONT-SPEC ...) ...), where +;; FONT-SPEC is: +;; a vector [ FAMILY WEIGHT SLANT ADSTYLE REGISTRY ], +;; or a cons (FAMILY . REGISTRY), +;; or a string FONT-NAME. +;; +;; FAMILY, WEIGHT, SLANT, and ADSTYLE may be nil, in which case, the +;; the corresponding name of default face is used. If REGISTRY ;; contains a character `-', the string before that is embedded in ;; `CHARSET_REGISTRY' field, and the string after that is embedded in ;; `CHARSET_ENCODING' field. If it does not contain `-', the whole ;; string is embedded in `CHARSET_REGISTRY' field, and a wild card -;; character `*' is embedded in `CHARSET_ENCODING' field. The -;; REGISTRY for ASCII characters are predefined as "ISO8859-1". +;; character `*' is embedded in `CHARSET_ENCODING' field. +;; +;; SCRIPT is a symbol that appears as an element of the char table +;; `char-script-table'. SCRIPT may be a charset specifying the range +;; of characters. (defun setup-default-fontset () "Setup the default fontset." - (dolist (elt - `((latin-iso8859-1 . (nil . "ISO8859-1")) - (latin-iso8859-2 . (nil . "ISO8859-2")) - (latin-iso8859-3 . (nil . "ISO8859-3")) - (latin-iso8859-4 . (nil . "ISO8859-4")) - ;; Setting "*" family is for a workaround of the problem - ;; that a font of wrong size is preferred if the font - ;; family matches with a requested one. - (thai-tis620 . ("*" . "TIS620")) - (greek-iso8859-7 . (nil . "ISO8859-7")) - (arabic-iso8859-6 . (nil . "ISO8859-6")) - (hebrew-iso8859-8 . (nil . "ISO8859-8")) - (katakana-jisx0201 . (nil . "JISX0201")) - (latin-jisx0201 . (nil . "JISX0201")) - (cyrillic-iso8859-5 . (nil . "ISO8859-5")) - (latin-iso8859-9 . (nil . "ISO8859-9")) - (japanese-jisx0208-1978 . (nil . "JISX0208.1978")) - (chinese-gb2312 . (nil . "GB2312.1980")) - (japanese-jisx0208 . (nil . "JISX0208.1990")) - (korean-ksc5601 . (nil . "KSC5601.1989")) - (japanese-jisx0212 . (nil . "JISX0212")) - (chinese-cns11643-1 . (nil . "CNS11643.1992-1")) - (chinese-cns11643-2 . (nil . "CNS11643.1992-2")) - (chinese-cns11643-3 . (nil . "CNS11643.1992-3")) - (chinese-cns11643-4 . (nil . "CNS11643.1992-4")) - (chinese-cns11643-5 . (nil . "CNS11643.1992-5")) - (chinese-cns11643-6 . (nil . "CNS11643.1992-6")) - (chinese-cns11643-7 . (nil . "CNS11643.1992-7")) - (chinese-big5-1 . (nil . "Big5")) - (chinese-big5-2 . (nil . "Big5")) - (chinese-sisheng . (nil . "sisheng_cwnn")) - (vietnamese-viscii-lower . (nil . "VISCII1.1")) - (vietnamese-viscii-upper . (nil . "VISCII1.1")) - (arabic-digit . (nil . "MuleArabic-0")) - (arabic-1-column . (nil . "MuleArabic-1")) - (arabic-2-column . (nil . "MuleArabic-2")) - (ipa . (nil . "MuleIPA")) - (ethiopic . (nil . "Ethiopic-Unicode")) - (ascii-right-to-left . (nil . "ISO8859-1")) - (indian-is13194 . (nil . "IS13194-Devanagari")) - (indian-2-column . (nil . "MuleIndian-2")) - (lao . (nil . "MuleLao-1")) - (tibetan . ("proportional" . "MuleTibetan-2")) - (tibetan-1-column . (nil . "MuleTibetan-1")) - (latin-iso8859-14 . (nil . "ISO8859-14")) - (latin-iso8859-15 . (nil . "ISO8859-15")) - (mule-unicode-0100-24ff . (nil . "ISO10646-1")) - (mule-unicode-2500-33ff . (nil . "ISO10646-1")) - (mule-unicode-e000-ffff . (nil . "ISO10646-1")) - (japanese-jisx0213-1 . (nil . "JISX0213.2000-1")) - (japanese-jisx0213-2 . (nil . "JISX0213.2000-2")) - ;; unicode - ((,(decode-char 'ucs #x0900) . ,(decode-char 'ucs #x097F)) - . (nil . "ISO10646.indian-1")) - ;; Indian CDAC - (,(indian-font-char-range 'cdac:dv-ttsurekh) - . (nil . "Devanagari-CDAC")) - (,(indian-font-char-range 'cdac:sd-ttsurekh) - . (nil . "Sanskrit-CDAC")) - (,(indian-font-char-range 'cdac:bn-ttdurga) - . (nil . "Bengali-CDAC")) - (,(indian-font-char-range 'cdac:as-ttdurga) - . (nil . "Assamese-CDAC")) - (,(indian-font-char-range 'cdac:pn-ttamar) - . (nil . "Punjabi-CDAC")) - (,(indian-font-char-range 'cdac:gj-ttavantika) - . (nil . "Gujarati-CDAC")) - (,(indian-font-char-range 'cdac:or-ttsarala) - . (nil . "Oriya-CDAC")) - (,(indian-font-char-range 'cdac:tm-ttvalluvar) - . (nil . "Tamil-CDAC")) - (,(indian-font-char-range 'cdac:tl-tthemalatha) - . (nil . "Telugu-CDAC")) - (,(indian-font-char-range 'cdac:kn-ttuma) - . (nil . "Kannada-CDAC")) - (,(indian-font-char-range 'cdac:ml-ttkarthika) - . (nil . "Malayalam-CDAC")) - ;; Indian AKRUTI - (,(indian-font-char-range 'akruti:dev) - . (nil . "Devanagari-Akruti")) - (,(indian-font-char-range 'akruti:bng) - . (nil . "Bengali-Akruti")) - (,(indian-font-char-range 'akruti:pnj) - . (nil . "Punjabi-Akruti")) - (,(indian-font-char-range 'akruti:guj) - . (nil . "Gujarati-Akruti")) - (,(indian-font-char-range 'akruti:ori) - . (nil . "Oriya-Akruti")) - (,(indian-font-char-range 'akruti:tml) - . (nil . "Tamil-Akruti")) - (,(indian-font-char-range 'akruti:tlg) - . (nil . "Telugu-Akruti")) - (,(indian-font-char-range 'akruti:knd) - . (nil . "Kannada-Akruti")) - (,(indian-font-char-range 'akruti:mal) - . (nil . "Malayalam-Akruti")) - )) - (set-fontset-font "fontset-default" (car elt) (cdr elt)))) - -;; Set arguments in `font-encoding-alist' (which see). -(defun set-font-encoding (pattern charset encoding) + (new-fontset + "fontset-default" + '(;; for each script + (latin (nil . "ISO8859-1") + (nil . "ISO8859-2") + (nil . "ISO8859-3") + (nil . "ISO8859-4") + (nil . "ISO8859-9") + (nil . "ISO8859-10") + (nil . "ISO8859-13") + (nil . "ISO8859-14") + (nil . "ISO8859-15") + (nil . "VISCII1.1-1")) + + (thai (nil . "TIS620*") + (nil . "ISO8859-11")) + + (devanagari (nil . "iso10646.indian-1")) + + (lao (nil . "MuleLao-1")) + + (tai-viet ("TaiViet" . "iso10646-1")) + + ;; both for script and charset. + (tibetan (nil . "muletibetan-2")) + + ;; both for script and charset. + (ethiopic (nil . "ethiopic-unicode")) + + (greek (nil . "ISO8859-7")) + + (cyrillic (nil . "ISO8859-5") + (nil . "microsoft-cp1251") + (nil . "koi8-r")) + + (arabic (nil . "MuleArabic-0") + (nil . "MuleArabic-1") + (nil . "MuleArabic-2") + (nil . "ISO8859-6")) + + (hebrew (nil . "ISO8859-8")) + + (kana (nil . "JISX0208*") + (nil . "GB2312.1980-0") + (nil . "KSC5601.1987*") + (nil . "JISX0201*") + (nil . "JISX0213.2000-1") + (nil . "JISX0213.2004-1")) + + (bopomofo (nil . "sisheng_cwnn-0")) + + (han (nil . "GB2312.1980-0") + (nil . "JISX0208*") + (nil . "JISX0212*") + (nil . "big5*") + (nil . "KSC5601.1987*") + (nil . "CNS11643.1992-1") + (nil . "CNS11643.1992-2") + (nil . "CNS11643.1992-3") + (nil . "CNS11643.1992-4") + (nil . "CNS11643.1992-5") + (nil . "CNS11643.1992-6") + (nil . "CNS11643.1992-7") + (nil . "gbk-0") + (nil . "gb18030") + (nil . "JISX0213.2000-1") + (nil . "JISX0213.2000-2") + (nil . "JISX0213.2004-1")) + + (cjk-misc (nil . "GB2312.1980-0") + (nil . "JISX0208*") + (nil . "JISX0212*") + (nil . "big5*") + (nil . "KSC5601.1987*") + (nil . "CNS11643.1992-1") + (nil . "CNS11643.1992-2") + (nil . "CNS11643.1992-3") + (nil . "CNS11643.1992-4") + (nil . "CNS11643.1992-5") + (nil . "CNS11643.1992-6") + (nil . "CNS11643.1992-7") + (nil . "gbk-0") + (nil . "gb18030") + (nil . "JISX0213.2000-1") + (nil . "JISX0213.2000-2")) + + (hangul (nil . "KSC5601.1987-0")) + + ;; for each charset + (ascii (nil . "ISO8859-1")) + (arabic-digit ("*" . "MuleArabic-0")) + (arabic-1-column ("*" . "MuleArabic-1")) + (arabic-2-column ("*" . "MuleArabic-2")) + (indian-is13194 (nil . "is13194-devanagari")) + (indian-1-column ("*" . "muleindian-2")) + ;; Indian CDAC + (devanagari-cdac (nil . "Devanagari-CDAC")) + (sanskrit-cdac (nil . "Sanskrit-CDAC")) + (bengali-cdac (nil . "Bengali-CDAC")) + (assamese-cdac (nil . "Assamese-CDAC")) + (punjabi-cdac (nil . "Punjabi-CDAC")) + (gujarati-cdac (nil . "Gujarati-CDAC")) + (oriya-cdac (nil . "Oriya-CDAC")) + (tamil-cdac (nil . "Tamil-CDAC")) + (telugu-cdac (nil . "Telugu-CDAC")) + (kannada-cdac (nil . "Kannada-CDAC")) + (malayalam-cdac (nil . "Malayalam-CDAC")) + ;; Indian AKRUTI + (devanagari-akruti (nil . "Devanagari-Akruti")) + (bengali-akruti (nil . "Bengali-Akruti")) + (punjabi-akruti (nil . "Punjabi-Akruti")) + (gujarati-akruti (nil . "Gujarati-Akruti")) + (oriya-akruti (nil . "Oriya-Akruti")) + (tamil-akruti (nil . "Tamil-Akruti")) + (telugu-akruti (nil . "Telugu-Akruti")) + (kannada-akruti (nil . "Kannada-Akruti")) + (malayalam-akruti (nil . "Malayalam-Akruti")) + ;;(devanagari-glyph ("altsys-dv_ttsurekh" . "devanagari-cdac")) + ;;(malayalam-glyph ("altsys-ml_ttkarthika" . "malayalam-cdac")) + (ipa (nil . "MuleIPA-1")) + + ;; Fallback fonts + (nil (nil . "gb2312.1980") + (nil . "gbk-0") + (nil . "gb18030") + (nil . "jisx0208") + (nil . "ksc5601.1987") + (nil . "CNS11643.1992-1") + (nil . "CNS11643.1992-2") + (nil . "CNS11643.1992-3") + (nil . "CNS11643.1992-4") + (nil . "CNS11643.1992-5") + (nil . "CNS11643.1992-6") + (nil . "CNS11643.1992-7") + (nil . "big5") + (nil . "jisx0213.2000-1") + (nil . "jisx0213.2004-1") + (nil . "jisx0212")) + )) + + ;; Append Unicode fonts. + ;; This may find fonts with more variants (bold, italic) but which + ;; don't cover many characters. + (set-fontset-font "fontset-default" nil + '(nil . "iso10646-1") nil 'append) + ;; These may find fonts that cover many characters but with fewer + ;; variants. + (set-fontset-font "fontset-default" nil + '("gnu-unifont" . "iso10646-1") nil 'append) + (set-fontset-font "fontset-default" nil + '("mutt-clearlyu" . "iso10646-1") nil 'append)) + +;; These are the registered registries/encodings from +;; ftp://ftp.x.org/pub/DOCS/registry 2001/06/01 + +;; Name Reference +;; ---- --------- +;; "DEC" [27] +;; registry prefix +;; "DEC.CNS11643.1986-2" [53] +;; CNS11643 2-plane using the encoding +;; suggested in that standard +;; "DEC.DTSCS.1990-2" [54] +;; DEC Taiwan Supplemental Character Set +;; "fujitsu.u90x01.1991-0" [87] +;; "fujitsu.u90x03.1991-0" [87] +;; "GB2312.1980-0" [39],[12] +;; China (PRC) Hanzi, GL encoding +;; "GB2312.1980-1" [39] +;; (deprecated) +;; China (PRC) Hanzi, GR encoding +;; "HP-Arabic8" [36] +;; HPARABIC8 8-bit character set +;; "HP-East8" [36] +;; HPEAST8 8-bit character set +;; "HP-Greek8" [36] +;; HPGREEK8 8-bit character set +;; "HP-Hebrew8" [36] +;; HPHEBREW8 8-bit character set +;; "HP-Japanese15" [36] +;; HPJAPAN15 15-bit characer set, +;; modified from industry defacto +;; standard Shift-JIS +;; "HP-Kana8" [36] +;; HPKANA8 8-bit character set +;; "HP-Korean15" [36] +;; HPKOREAN15 15-bit character set +;; "HP-Roman8" [36] +;; HPROMAN8 8-bit character set +;; "HP-SChinese15" [36] +;; HPSCHINA15 15-bit character set for +;; support of Simplified Chinese +;; "HP-TChinese15" [36] +;; HPTCHINA15 15-bit character set for +;; support of Traditional Chinese +;; "HP-Turkish8" [36] +;; HPTURKISH8 8-bit character set +;; "IPSYS" [59] +;; registry prefix +;; "IPSYS.IE-1" [59] +;; "ISO2022"<REG>"-"<ENC> [44] +;; "ISO646.1991-IRV" [107] +;; ISO 646 International Reference Version +;; "ISO8859-1" [15],[12] +;; ISO Latin alphabet No. 1 +;; "ISO8859-2" [15],[12] +;; ISO Latin alphabet No. 2 +;; "ISO8859-3" [15],[12] +;; ISO Latin alphabet No. 3 +;; "ISO8859-4" [15],[12] +;; ISO Latin alphabet No. 4 +;; "ISO8859-5" [15],[12] +;; ISO Latin/Cyrillic alphabet +;; "ISO8859-6" [15],[12] +;; ISO Latin/Arabic alphabet +;; "ISO8859-7" [15],[12] +;; ISO Latin/Greek alphabet +;; "ISO8859-8" [15],[12] +;; ISO Latin/Hebrew alphabet +;; "ISO8859-9" [15],[12] +;; ISO Latin alphabet No. 5 +;; "ISO8859-10" [15],[12] +;; ISO Latin alphabet No. 6 +;; "ISO8859-13" [15],[12] +;; ISO Latin alphabet No. 7 +;; "ISO8859-14" [15],[12] +;; ISO Latin alphabet No. 8 +;; "ISO8859-15" [15],[12] +;; ISO Latin alphabet No. 9 +;; "FCD8859-15" [7] +;; (deprecated) +;; ISO Latin alphabet No. 9, Final Committee Draft +;; "ISO10646-1" [133] +;; Unicode Universal Multiple-Octet Coded Character Set +;; "ISO10646-MES" [133] +;; (deprecated) +;; Unicode Minimum European Subset +;; "JISX0201.1976-0" [38],[12] +;; 8-Bit Alphanumeric-Katakana Code +;; "JISX0208.1983-0" [40],[12] +;; Japanese Graphic Character Set, +;; GL encoding +;; "JISX0208.1990-0" [71] +;; Japanese Graphic Character Set, +;; GL encoding +;; "JISX0208.1983-1" [40] +;; (deprecated) +;; Japanese Graphic Character Set, +;; GR encoding +;; "JISX0212.1990-0" [72] +;; Supplementary Japanese Graphic Character Set, +;; GL encoding +;; "KOI8-R" [119] +;; Cyrillic alphabet +;; "KSC5601.1987-0" [41],[12] +;; Korean Graphic Character Set, +;; GL encoding +;; "KSC5601.1987-1" [41] +;; (deprecated) +;; Korean Graphic Character Set, +;; GR encoding +;; "omron_CNS11643-0" [45] +;; "omron_CNS11643-1" [45] +;; "omron_BIG5-0" [45] +;; "omron_BIG5-1" [45] +;; "wn.tamil.1993" [103] + +(defun set-font-encoding (pattern charset) + "Set arguments in `font-encoding-alist' (which see)." (let ((slot (assoc pattern font-encoding-alist))) (if slot - (let ((place (assq charset (cdr slot)))) - (if place - (setcdr place encoding) - (setcdr slot (cons (cons charset encoding) (cdr slot))))) + (setcdr slot charset) (setq font-encoding-alist - (cons (list pattern (cons charset encoding)) font-encoding-alist))) - )) - -;; Allow display of arbitrary characters with an iso-10646-encoded -;; (`Unicode') font. -(define-translation-table 'ucs-mule-to-mule-unicode - ucs-mule-to-mule-unicode) -(define-translation-hash-table 'ucs-mule-cjk-to-unicode - ucs-mule-cjk-to-unicode) - -(define-ccl-program ccl-encode-unicode-font - `(0 - ;; r0: charset-id - ;; r1: 1st position code - ;; r2: 2nd position code (if r0 is 2D charset) - ((if (r0 == ,(charset-id 'ascii)) - ((r2 = r1) - (r1 = 0)) - ;; At first, try to get a Unicode code point directly. - ((if (r2 >= 0) - ;; This is a 2D charset. - (r1 = ((r1 << 7) | r2))) - (lookup-character utf-subst-table-for-encode r0 r1) - (if r7 - ;; We got it! - ((r1 = (r0 >> 8)) - (r2 = (r0 & #xFF))) - ;; Look for a translation for non-ASCII chars. - ((translate-character ucs-mule-to-mule-unicode r0 r1) - (if (r0 == ,(charset-id 'ascii)) - ((r2 = r1) - (r1 = 0)) - ((if (r0 == ,(charset-id 'latin-iso8859-1)) - ((r2 = (r1 + 128)) - (r1 = 0)) - ((r2 = (r1 & #x7F)) - (r1 >>= 7) - (if (r0 == ,(charset-id 'mule-unicode-0100-24ff)) - ((r1 *= 96) - (r1 += r2) - (r1 += ,(- #x100 (* 32 96) 32)) - (r1 >8= 0) - (r2 = r7)) - (if (r0 == ,(charset-id 'mule-unicode-2500-33ff)) - ((r1 *= 96) - (r1 += r2) - (r1 += ,(- #x2500 (* 32 96) 32)) - (r1 >8= 0) - (r2 = r7)) - (if (r0 == ,(charset-id 'mule-unicode-e000-ffff)) - ((r1 *= 96) - (r1 += r2) - (r1 += ,(- #xe000 (* 32 96) 32)) - (r1 >8= 0) - (r2 = r7)) - ;; No way, use the glyph for U+FFFD. - ((r1 = #xFF) - (r2 = #xFD))))))))))))))) - "Encode characters for display with iso10646 font. -Translate through the translation-hash-table named -`ucs-mule-cjk-to-unicode' and the translation-table named -`ucs-mule-to-mule-unicode' initially.") - -;; Use the above CCL encoder for Unicode fonts. Please note that the -;; regexp is not simply "ISO10646-1" because there exists, for -;; instance, the following Devanagari Unicode fonts: -;; -misc-fixed-medium-r-normal--24-240-72-72-c-120-iso10646.indian-1 -;; -sibal-devanagari-medium-r-normal--24-240-75-75-P--iso10646-dev -(setq font-ccl-encoder-alist - (cons '("ISO10646.*-*" . ccl-encode-unicode-font) - font-ccl-encoder-alist)) + (cons (cons pattern charset) font-encoding-alist))))) ;; Setting for suppressing XLoadQueryFont on big fonts. (setq x-pixel-size-width-font-regexp - "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") + "gb2312\\|gbk\\|gb18030\\|jisx0208\\|ksc5601\\|cns11643\\|big5") ;; These fonts require vertical centering. (setq vertical-centering-font-regexp - "gb2312\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5") + "gb2312\\|gbk\\|gb18030\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5") ;; CDAC fonts are actually smaller than their design sizes. (setq face-font-rescale-alist '(("-cdac$" . 1.3))) -(defvar x-font-name-charset-alist - '(("iso8859-1" ascii latin-iso8859-1) - ("iso8859-2" ascii latin-iso8859-2) - ("iso8859-3" ascii latin-iso8859-3) - ("iso8859-4" ascii latin-iso8859-4) - ("iso8859-5" ascii cyrillic-iso8859-5) - ("iso8859-6" ascii arabic-iso8859-6) - ("iso8859-7" ascii greek-iso8859-7) - ("iso8859-8" ascii hebrew-iso8859-8) - ("iso8859-14" ascii latin-iso8859-14) - ("iso8859-15" ascii latin-iso8859-15) - ("tis620" ascii thai-tis620) - ("koi8" ascii cyrillic-iso8859-5) - ("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) - ("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower) - ("mulelao-1" ascii lao) - ("iso10646-1" ascii latin-iso8859-1 mule-unicode-0100-24ff - mule-unicode-2500-33ff mule-unicode-e000-ffff)) - "Alist of font names vs list of charsets the font can display. - -When a font name which matches some element of this alist is given as -`-fn' command line argument or is specified by X resource, a fontset -which uses the specified font for the corresponding charsets are -created and used for the initial frame.") +(defvar x-font-name-charset-alist nil + "This variable has no meaning now. Just kept for backward compatibility.") ;;; XLFD (X Logical Font Description) format handler. ;; Define XLFD's field index numbers. ; field name -(defconst xlfd-regexp-foundry-subnum 0) ; FOUNDRY -(defconst xlfd-regexp-family-subnum 1) ; FAMILY_NAME -(defconst xlfd-regexp-weight-subnum 2) ; WEIGHT_NAME -(defconst xlfd-regexp-slant-subnum 3) ; SLANT -(defconst xlfd-regexp-swidth-subnum 4) ; SETWIDTH_NAME -(defconst xlfd-regexp-adstyle-subnum 5) ; ADD_STYLE_NAME -(defconst xlfd-regexp-pixelsize-subnum 6) ; PIXEL_SIZE -(defconst xlfd-regexp-pointsize-subnum 7) ; POINT_SIZE -(defconst xlfd-regexp-resx-subnum 8) ; RESOLUTION_X -(defconst xlfd-regexp-resy-subnum 9) ; RESOLUTION_Y -(defconst xlfd-regexp-spacing-subnum 10) ; SPACING -(defconst xlfd-regexp-avgwidth-subnum 11) ; AVERAGE_WIDTH -(defconst xlfd-regexp-registry-subnum 12) ; CHARSET_REGISTRY -(defconst xlfd-regexp-encoding-subnum 13) ; CHARSET_ENCODING +(defconst xlfd-regexp-family-subnum 0) ; FOUNDRY and FAMILY +(defconst xlfd-regexp-weight-subnum 1) ; WEIGHT_NAME +(defconst xlfd-regexp-slant-subnum 2) ; SLANT +(defconst xlfd-regexp-swidth-subnum 3) ; SETWIDTH_NAME +(defconst xlfd-regexp-adstyle-subnum 4) ; ADD_STYLE_NAME +(defconst xlfd-regexp-pixelsize-subnum 5) ; PIXEL_SIZE +(defconst xlfd-regexp-pointsize-subnum 6) ; POINT_SIZE +(defconst xlfd-regexp-resx-subnum 7) ; RESOLUTION_X +(defconst xlfd-regexp-resy-subnum 8) ; RESOLUTION_Y +(defconst xlfd-regexp-spacing-subnum 8) ; SPACING +(defconst xlfd-regexp-avgwidth-subnum 10) ; AVERAGE_WIDTH +(defconst xlfd-regexp-registry-subnum 11) ; REGISTRY and ENCODING ;; Regular expression matching against a fontname which conforms to ;; XLFD (X Logical Font Description). All fields in XLFD should be ;; not be omitted (but can be a wild card) to be matched. (defconst xlfd-tight-regexp "^\ +-\\([^-]*-[^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ -\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ --\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\ --\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)$") +-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*-[^-]*\\)$") + +;; Regular expression matching against a fontname which conforms to +;; XLFD (X Logical Font Description). All fields in XLFD from FOUNDRY +;; to ADSTYLE, REGISTRY, and ENCODING should be not be omitted (but +;; can be a wild card) to be matched. +(defconst xlfd-style-regexp + "^\ +-\\([^-]*-[^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-.*\ +-\\([^-]*-[^-]*\\)$") ;; List of field numbers of XLFD whose values are numeric. (defconst xlfd-regexp-numeric-subnums - (list xlfd-regexp-pixelsize-subnum ;6 - xlfd-regexp-pointsize-subnum ;7 - xlfd-regexp-resx-subnum ;8 - xlfd-regexp-resy-subnum ;9 - xlfd-regexp-avgwidth-subnum ;11 + (list xlfd-regexp-pixelsize-subnum ;5 + xlfd-regexp-pointsize-subnum ;6 + xlfd-regexp-resx-subnum ;7 + xlfd-regexp-resy-subnum ;8 + xlfd-regexp-avgwidth-subnum ;10 )) (defun x-decompose-font-name (pattern) - "Decompose PATTERN into XLFD's fields and return vector of the fields. -The length of the vector is 14. - -If PATTERN doesn't conform to XLFD, try to get a full XLFD name from -X server and use the information of the full name to decompose -PATTERN. If no full XLFD name is gotten, return nil." - (let (xlfd-fields fontname) - (if (string-match xlfd-tight-regexp pattern) - (let ((i 0)) - (setq xlfd-fields (make-vector 14 nil)) - (while (< i 14) - (aset xlfd-fields i (match-string (1+ i) pattern)) - (setq i (1+ i))) - xlfd-fields) - (setq fontname (condition-case nil - (x-resolve-font-name pattern) - (error))) - (if (and fontname - (string-match xlfd-tight-regexp fontname)) - ;; We get a full XLFD name. - (let ((len (length pattern)) - (i 0) - l) - ;; Setup xlfd-fields by the full XLFD name. Each element - ;; should be a cons of matched index and matched string. - (setq xlfd-fields (make-vector 14 nil)) - (while (< i 14) - (aset xlfd-fields i - (cons (match-beginning (1+ i)) - (match-string (1+ i) fontname))) - (setq i (1+ i))) - - ;; Replace wild cards in PATTERN by regexp codes. - (setq i 0) - (while (< i len) - (let ((ch (aref pattern i))) - (if (= ch ??) - (setq pattern (concat (substring pattern 0 i) - "\\(.\\)" - (substring pattern (1+ i))) - len (+ len 4) - i (+ i 4)) - (if (= ch ?*) - (setq pattern (concat (substring pattern 0 i) - "\\(.*\\)" - (substring pattern (1+ i))) - len (+ len 5) - i (+ i 5)) - (setq i (1+ i)))))) - - ;; Set each element of xlfd-fields to proper strings. - (if (string-match pattern fontname) - ;; The regular expression PATTERN matchs the full XLFD - ;; name. Set elements that correspond to a wild card - ;; in PATTERN to "*", set the other elements to the - ;; exact strings in PATTERN. - (let ((l (cdr (cdr (match-data))))) - (setq i 0) - (while (< i 14) - (if (or (null l) (< (car (aref xlfd-fields i)) (car l))) - (progn - (aset xlfd-fields i (cdr (aref xlfd-fields i))) - (setq i (1+ i))) - (if (< (car (aref xlfd-fields i)) (car (cdr l))) - (progn - (aset xlfd-fields i "*") - (setq i (1+ i))) - (setq l (cdr (cdr l))))))) - ;; Set each element of xlfd-fields to the exact string - ;; in the corresonding fields in full XLFD name. - (setq i 0) - (while (< i 14) - (aset xlfd-fields i (cdr (aref xlfd-fields i))) - (setq i (1+ i)))) - xlfd-fields))))) - -;; Replace consecutive wild-cards (`*') in NAME to one. -;; Ex. (x-reduce-font-name "-*-*-*-iso8859-1") => "-*-iso8859-1" -(defsubst x-reduce-font-name (name) - (while (string-match "-\\*-\\(\\*-\\)+" name) - (setq name (replace-match "-*-" t t name))) - name) + "Decompose PATTERN into XLFD fields and return a vector of the fields. +The length of the vector is 12. +The FOUNDRY and FAMILY fields are concatinated and stored in the first +element of the vector. +The REGISTRY and ENCODING fields are concatinated and stored in the last +element of the vector. + +Return nil if PATTERN doesn't conform to XLFD." + (if (string-match xlfd-tight-regexp pattern) + (let ((xlfd-fields (make-vector 12 nil))) + (dotimes (i 12) + (aset xlfd-fields i (match-string (1+ i) pattern))) + (dotimes (i 12) + (if (string-match "^[*-]+$" (aref xlfd-fields i)) + (aset xlfd-fields i nil))) + xlfd-fields))) (defun x-compose-font-name (fields &optional reduce) - "Compose X's fontname from FIELDS. -FIELDS is a vector of XLFD fields, of length 14. + "Compose X fontname from FIELDS. +FIELDS is a vector of XLFD fields, of length 12. If a field is nil, wild-card letter `*' is embedded. Optional argument REDUCE exists just for backward compatibility, and is always ignored." @@ -398,7 +614,7 @@ If no font matching XLFD-FIELDS is available, successively replace parts of the font name pattern with \"*\" until some font is found. Value is name of that font." (let ((ascii-font nil) (index 0)) - (while (and (null ascii-font) (<= index xlfd-regexp-encoding-subnum)) + (while (and (null ascii-font) (<= index xlfd-regexp-registry-subnum)) (let ((pattern (x-compose-font-name xlfd-fields))) (condition-case nil (setq ascii-font (x-resolve-font-name pattern)) @@ -412,53 +628,33 @@ Value is name of that font." (defun x-complement-fontset-spec (xlfd-fields fontlist) - "Complement FONTLIST for charsets based on XLFD-FIELDS and return it. + "Complement elements of FONTLIST based on XLFD-FIELDS. XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. -FONTLIST is an alist of charsets vs the corresponding font names. - -The fonts are complemented as below. - -If FONTLIST doesn't specify a font for ASCII charset, generate a font -name for the charset from XLFD-FIELDS, and add that information to -FONTLIST. - -If a font specifid for ASCII supports the other charsets (see the -variable `x-font-name-charset-alist'), add that information to FONTLIST." - (let* ((slot (assq 'ascii fontlist)) - (ascii-font (cdr slot)) - ascii-font-spec) - (if ascii-font - (setcdr slot (setq ascii-font (x-resolve-font-name ascii-font))) - ;; If font for ASCII is not specified, add it. - (aset xlfd-fields xlfd-regexp-registry-subnum "iso8859") - (aset xlfd-fields xlfd-regexp-encoding-subnum "1") - (setq ascii-font (x-must-resolve-font-name xlfd-fields)) - (setq fontlist (cons (cons 'ascii ascii-font) fontlist))) - - ;; If the font for ASCII also supports the other charsets, and - ;; they are not specified in FONTLIST, add them. - (setq xlfd-fields (x-decompose-font-name ascii-font)) - (if (not xlfd-fields) - (setq ascii-font-spec ascii-font) - (setq ascii-font-spec - (cons (format "%s-%s" - (aref xlfd-fields xlfd-regexp-foundry-subnum) - (aref xlfd-fields xlfd-regexp-family-subnum)) - (format "%s-%s" - (aref xlfd-fields xlfd-regexp-registry-subnum) - (aref xlfd-fields xlfd-regexp-encoding-subnum))))) - (let ((tail x-font-name-charset-alist) - elt) - (while tail - (setq elt (car tail) tail (cdr tail)) - (if (string-match (car elt) ascii-font) - (let ((charsets (cdr elt)) - charset) - (while charsets - (setq charset (car charsets) charsets (cdr charsets)) - (or (assq charset fontlist) - (setq fontlist - (cons (cons charset ascii-font-spec) fontlist)))))))) +FONTLIST is an alist of script names vs the corresponding font names. + +The font names are complemented as below. + +If a font name matches `xlfd-style-regexp', each field of wild card is +replaced by the corresponding fields in XLFD-FIELDS." + (let ((default-spec (vector (aref xlfd-fields xlfd-regexp-family-subnum) + (aref xlfd-fields xlfd-regexp-weight-subnum) + (aref xlfd-fields xlfd-regexp-slant-subnum) + (aref xlfd-fields xlfd-regexp-swidth-subnum) + (aref xlfd-fields xlfd-regexp-adstyle-subnum) + (aref xlfd-fields xlfd-regexp-registry-subnum)))) + (dolist (elt fontlist) + (let ((name (cadr elt)) + font-spec) + (when (or (string-match xlfd-style-regexp name) + (and (setq name (car (x-list-fonts name nil nil 1))) + (string-match xlfd-style-regexp name))) + (setq font-spec (make-vector 6 nil)) + (dotimes (i 6) + (aset font-spec i (match-string (1+ i) name))) + (dotimes (i 5) + (if (string-match "^[*-]+$" (aref font-spec i)) + (aset font-spec i (aref default-spec i)))) + (setcar (cdr elt) font-spec)))) fontlist)) @@ -470,17 +666,15 @@ with \"fontset\" in `<CHARSET_REGISTRY>' field." (string= (match-string (1+ xlfd-regexp-registry-subnum) fontset) "fontset"))) -;; Return a list to be appended to `x-fixed-font-alist' when -;; `mouse-set-font' is called. (defun generate-fontset-menu () - (let ((fontsets (fontset-list)) - fontset-name - l) - (while fontsets - (setq fontset-name (car fontsets) fontsets (cdr fontsets)) - (setq l (cons (list (fontset-plain-name fontset-name) fontset-name) l))) + "Return list to be appended to `x-fixed-font-alist'. +Done when `mouse-set-font' is called." + (let (l) + (dolist (fontset (fontset-list)) + (or (string-match "fontset-default$" fontset) + (push (list (fontset-plain-name fontset) fontset) l))) (cons "Fontset" - (sort l (function (lambda (x y) (string< (car x) (car y)))))))) + (sort l #'(lambda (x y) (string< (car x) (car y))))))) (defun fontset-plain-name (fontset) "Return a plain and descriptive name of FONTSET." @@ -488,92 +682,141 @@ with \"fontset\" in `<CHARSET_REGISTRY>' field." (error "Invalid fontset: %s" fontset)) (let ((xlfd-fields (x-decompose-font-name fontset))) (if xlfd-fields - (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum)) + (let ((family (aref xlfd-fields xlfd-regexp-family-subnum)) + (weight (aref xlfd-fields xlfd-regexp-weight-subnum)) (slant (aref xlfd-fields xlfd-regexp-slant-subnum)) (swidth (aref xlfd-fields xlfd-regexp-swidth-subnum)) (size (aref xlfd-fields xlfd-regexp-pixelsize-subnum)) - (charset (aref xlfd-fields xlfd-regexp-registry-subnum)) - (nickname (aref xlfd-fields xlfd-regexp-encoding-subnum)) + (nickname (aref xlfd-fields xlfd-regexp-registry-subnum)) name) - (if (not (string= "fontset" charset)) - fontset - (if (> (string-to-number size) 0) - (setq name (format "%s: %s-dot" nickname size)) - (setq name nickname)) - (cond ((string-match "^medium$" weight) - (setq name (concat name " " "medium"))) - ((string-match "^bold$\\|^demibold$" weight) - (setq name (concat name " " weight)))) - (cond ((string-match "^i$" slant) - (setq name (concat name " " "italic"))) - ((string-match "^o$" slant) - (setq name (concat name " " "slant"))) - ((string-match "^ri$" slant) - (setq name (concat name " " "reverse italic"))) - ((string-match "^ro$" slant) - (setq name (concat name " " "reverse slant")))) - name)) + (if (not (string-match "^fontset-\\(.*\\)$" nickname)) + (setq nickname family) + (setq nickname (match-string 1 nickname))) + (if (and size (> (string-to-number size) 0)) + (setq name (format "%s: %s-dot" nickname size)) + (setq name nickname)) + (and weight + (cond ((string-match "^medium$" weight) + (setq name (concat name " " "medium"))) + ((string-match "^bold$\\|^demibold$" weight) + (setq name (concat name " " weight))))) + (and slant + (cond ((string-match "^i$" slant) + (setq name (concat name " " "italic"))) + ((string-match "^o$" slant) + (setq name (concat name " " "slant"))) + ((string-match "^ri$" slant) + (setq name (concat name " " "reverse italic"))) + ((string-match "^ro$" slant) + (setq name (concat name " " "reverse slant"))))) + name) fontset))) +(defvar charset-script-alist + '((ascii . latin) + (latin-iso8859-1 . latin) + (latin-iso8859-2 . latin) + (latin-iso8859-3 . latin) + (latin-iso8859-4 . latin) + (latin-iso8859-9 . latin) + (latin-iso8859-10 . latin) + (latin-iso8859-13 . latin) + (latin-iso8859-14 . latin) + (latin-iso8859-15 . latin) + (latin-iso8859-16 . latin) + (latin-jisx0201 . latin) + (thai-tis620 . thai) + (cyrillic-iso8859-5 . cyrillic) + (arabic-iso8859-6 . arabic) + (greek-iso8859-7 . latin) + (hebrew-iso8859-8 . latin) + (katakana-jisx0201 . kana) + (chinese-gb2312 . han) + (chinese-gbk . han) + (gb18030-2-byte . han) + (gb18030-4-byte-bmp . han) + (gb18030-4-byte-ext-1 . han) + (gb18030-4-byte-ext-2 . han) + (gb18030-4-byte-smp . han) + (chinese-big5-1 . han) + (chinese-big5-2 . han) + (chinese-cns11643-1 . han) + (chinese-cns11643-2 . han) + (chinese-cns11643-3 . han) + (chinese-cns11643-4 . han) + (chinese-cns11643-5 . han) + (chinese-cns11643-6 . han) + (chinese-cns11643-7 . han) + (japanese-jisx0208 . han) + (japanese-jisx0208-1978 . han) + (japanese-jisx0212 . han) + (japanese-jisx0213-1 . han) + (japanese-jisx0213-2 . han) + (korean-ksc5601 . hangul) + (chinese-sisheng . bopomofo) + (vietnamese-viscii-lower . latin) + (vietnamese-viscii-upper . latin) + (arabic-digit . arabic) + (arabic-1-column . arabic) + (arabic-2-column . arabic) + (indian-is13194 . devanagari) + (indian-glyph . devanagari) + (indian-1-column . devanagari) + (indian-2-column . devanagari) + (tibetan-1-column . tibetan)) + "Alist of charsets vs the corresponding most appropriate scripts. + +This alist is used by the function `create-fontset-from-fontset-spec' +to map charsets to scripts.") (defun create-fontset-from-fontset-spec (fontset-spec &optional style-variant noerror) "Create a fontset from fontset specification string FONTSET-SPEC. FONTSET-SPEC is a string of the format: - FONTSET-NAME,CHARSET0:FONT0,CHARSET1:FONT1, ... + FONTSET-NAME,SCRIPT0:FONT0,SCRIPT1:FONT1, ... Any number of SPACE, TAB, and NEWLINE can be put before and after commas. -Optional 2nd arg exists just for backward compatibility, and is ignored. +When a frame uses the fontset as the `font' parameter, the frame's +default font name is derived from FONTSET-NAME by substituting +\"iso8859-1\" for the tail part \"fontset-XXX\". But, if SCRIPT-NAMEn +is \"ascii\", use the corresponding FONT-NAMEn as the default font +name. -If this function attempts to create already existing fontset, an error is -signaled unless the optional 3rd argument NOERROR is non-nil. +Optional 2nd and 3rd arguments exist just for backward compatibility, +and are ignored. -It returns a name of the created fontset." - (if (not (string-match "^[^,]+" fontset-spec)) +It returns a name of the created fontset. + +For backward compatibility, SCRIPT-NAME may be a charset name, in +which case, the corresponding script is decided by the variable +`charset-script-alist' (which see)." + (or (string-match "^[^,]+" fontset-spec) (error "Invalid fontset spec: %s" fontset-spec)) - (setq fontset-spec (downcase fontset-spec)) (let ((idx (match-end 0)) (name (match-string 0 fontset-spec)) - xlfd-fields charset fontlist ascii-font) - (if (query-fontset name) - (or noerror - (error "Fontset \"%s\" already exists" name)) - (setq xlfd-fields (x-decompose-font-name name)) - (or xlfd-fields - (error "Fontset \"%s\" not conforming to XLFD" name)) - - ;; At first, extract pairs of charset and fontname from FONTSET-SPEC. - (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)" - fontset-spec idx) - (setq idx (match-end 0)) - (setq charset (intern (match-string 1 fontset-spec))) - (if (charsetp charset) - (setq fontlist (cons (cons charset (match-string 2 fontset-spec)) - fontlist)))) - (setq ascii-font (cdr (assq 'ascii fontlist))) - - ;; Complement FONTLIST. - (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) - - (new-fontset name fontlist) - - ;; Define the short name alias. - (if (and (string-match "fontset-.*$" name) - (not (assoc name fontset-alias-alist))) - (let ((alias (match-string 0 name))) - (or (rassoc alias fontset-alias-alist) - (setq fontset-alias-alist - (cons (cons name alias) fontset-alias-alist))))) - - ;; Define the ASCII font name alias. - (or ascii-font - (setq ascii-font (cdr (assq 'ascii fontlist)))) - (or (rassoc ascii-font fontset-alias-alist) - (setq fontset-alias-alist - (cons (cons name ascii-font) - fontset-alias-alist)))) - - name)) + xlfd-fields target script fontlist) + (setq xlfd-fields (x-decompose-font-name name)) + (or xlfd-fields + (error "Fontset name \"%s\" not conforming to XLFD" name)) + + ;; At first, extract pairs of charset and fontname from FONTSET-SPEC. + (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)" + fontset-spec idx) + (setq idx (match-end 0)) + (setq target (intern (match-string 1 fontset-spec))) + (cond ((or (eq target 'ascii) + (memq target (char-table-extra-slot char-script-table 0))) + (push (list target (match-string 2 fontset-spec)) fontlist)) + ((setq script (cdr (assq target charset-script-alist))) + (push (list script (match-string 2 fontset-spec)) fontlist)) + ((charsetp target) + (push (list target (match-string 2 fontset-spec)) fontlist)))) + + ;; Complement FONTLIST. + (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) + + ;; Create a fontset. + (new-fontset name (nreverse fontlist)))) (defun create-fontset-from-ascii-font (font &optional resolved-font fontset-name) @@ -589,23 +832,19 @@ an appropriate name is generated automatically. It returns a name of the created fontset." (setq font (downcase font)) - (if resolved-font - (setq resolved-font (downcase resolved-font)) - (setq resolved-font (downcase (x-resolve-font-name font)))) - (let ((xlfd (x-decompose-font-name font)) - (resolved-xlfd (x-decompose-font-name resolved-font)) - fontset fontset-spec) - (aset xlfd xlfd-regexp-foundry-subnum nil) - (aset xlfd xlfd-regexp-family-subnum nil) - (aset xlfd xlfd-regexp-registry-subnum "fontset") + (setq resolved-font + (downcase (or resolved-font (x-resolve-font-name font)))) + (let ((xlfd (x-decompose-font-name resolved-font)) + fontset) (if fontset-name (setq fontset-name (downcase fontset-name)) - (setq fontset-name - (format "%s_%s_%s" - (aref resolved-xlfd xlfd-regexp-registry-subnum) - (aref resolved-xlfd xlfd-regexp-encoding-subnum) - (aref resolved-xlfd xlfd-regexp-pixelsize-subnum)))) - (aset xlfd xlfd-regexp-encoding-subnum fontset-name) + (if (query-fontset "fontset-startup") + (setq fontset-name + (subst-char-in-string + ?- ?_ (aref xlfd xlfd-regexp-registry-subnum) t)) + (setq fontset-name "startup"))) + (aset xlfd xlfd-regexp-registry-subnum + (format "fontset-%s" fontset-name)) (setq fontset (x-compose-font-name xlfd)) (or (query-fontset fontset) (create-fontset-from-fontset-spec (concat fontset ", ascii:" font))))) @@ -616,21 +855,13 @@ It returns a name of the created fontset." ;; specified here because FAMILY of those fonts are not "fixed" in ;; many cases. (defvar standard-fontset-spec - (purecopy "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard, - chinese-gb2312:-*-medium-r-normal-*-16-*-gb2312*-*, - korean-ksc5601:-*-medium-r-normal-*-16-*-ksc5601*-*, - chinese-cns11643-1:-*-medium-r-normal-*-16-*-cns11643*-1, - chinese-cns11643-2:-*-medium-r-normal-*-16-*-cns11643*-2, - chinese-cns11643-3:-*-medium-r-normal-*-16-*-cns11643*-3, - chinese-cns11643-4:-*-medium-r-normal-*-16-*-cns11643*-4, - chinese-cns11643-5:-*-medium-r-normal-*-16-*-cns11643*-5, - chinese-cns11643-6:-*-medium-r-normal-*-16-*-cns11643*-6, - chinese-cns11643-7:-*-medium-r-normal-*-16-*-cns11643*-7") + (purecopy "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard") "String of fontset spec of the standard fontset. You have the biggest chance to display international characters with correct glyphs by using the standard fontset. See the documentation of `create-fontset-from-fontset-spec' for the format.") + ;; Create fontsets from X resources of the name `fontset-N (class ;; Fontset-N)' where N is integer 0, 1, ... ;; The values of the resources the string of the same format as |