;;; fontset.el --- commands for handling fontset
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Licensed to the Free Software Foundation.
;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2003
+;; 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.
;;; 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)
+ ("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)
+ ("big5" . big5)
+ ("sisheng_cwnn" . chinese-sisheng)
+ ("viscii" . viscii)
+ ("tis620" . tis620-2533)
+ ("mulearabic-0" . arabic-digit)
+ ("mulearabic-1" . arabic-1-column)
+ ("mulearabic-2" . arabic-2-column)
+ ("muleipa" . ipa)
+ ("ethiopic-unicode" . 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)
+ ("abobe-symbol" . symbol)
+ ("iso10646-1" . (unicode . nil))
+ ("iso10646.indian-1" . (unicode . nil))))
+
+
;; 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"))
- (thai-tis620 . ("*" . "TIS620"))
- (greek-iso8859-7 . ("*" . "ISO8859-7"))
- (arabic-iso8859-6 . ("*" . "ISO8859-6"))
- (hebrew-iso8859-8 . ("*" . "ISO8859-8"))
- (katakana-jisx0201 . ("*" . "JISX0201"))
- (latin-jisx0201 . (nil . "JISX0201"))
- (cyrillic-iso8859-5 . ("*" . "ISO8859-5"))
- (latin-iso8859-9 . (nil . "ISO8859-9"))
- (japanese-jisx0208-1978 . ("*" . "JISX0208.1978"))
- (chinese-gb2312 . ("*" . "GB2312.1980"))
- (japanese-jisx0208 . ("*" . "JISX0208.1990"))
- (korean-ksc5601 . ("*" . "KSC5601.1989"))
- (japanese-jisx0212 . ("*" . "JISX0212"))
- (chinese-cns11643-1 . ("*" . "CNS11643.1992-1"))
- (chinese-cns11643-2 . ("*" . "CNS11643.1992-2"))
- (chinese-cns11643-3 . ("*" . "CNS11643.1992-3"))
- (chinese-cns11643-4 . ("*" . "CNS11643.1992-4"))
- (chinese-cns11643-5 . ("*" . "CNS11643.1992-5"))
- (chinese-cns11643-6 . ("*" . "CNS11643.1992-6"))
- (chinese-cns11643-7 . ("*" . "CNS11643.1992-7"))
- (chinese-big5-1 . ("*" . "Big5"))
- (chinese-big5-2 . ("*" . "Big5"))
- (chinese-sisheng . (nil . "sisheng_cwnn"))
- (vietnamese-viscii-lower . (nil . "VISCII1.1"))
- (vietnamese-viscii-upper . (nil . "VISCII1.1"))
- (arabic-digit . ("*" . "MuleArabic-0"))
- (arabic-1-column . ("*" . "MuleArabic-1"))
- (arabic-2-column . ("*" . "MuleArabic-2"))
- (ipa . (nil . "MuleIPA"))
- (ethiopic . ("*" . "Ethiopic-Unicode"))
- (ascii-right-to-left . (nil . "ISO8859-1"))
- (indian-is13194 . ("*" . "IS13194-Devanagari"))
- (indian-2-column . ("*" . "MuleIndian-2"))
- (lao . ("*" . "MuleLao-1"))
- (tibetan . ("proportional" . "MuleTibetan-2"))
- (tibetan-1-column . ("*" . "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 . ("*" . "JISX0213.2000-1"))
- (japanese-jisx0213-2 . ("*" . "JISX0213.2000-2"))
- ;; unicode
- ((,(decode-char 'ucs #x0900) . ,(decode-char 'ucs #x097F))
- . ("*" . "ISO10646.indian-1"))
- ;; Indian CDAC
- (,(indian-font-char-range 'cdac:dv-ttsurekh)
- . ("*" . "Devanagari-CDAC"))
- (,(indian-font-char-range 'cdac:sd-ttsurekh)
- . ("*" . "Sanskrit-CDAC"))
- (,(indian-font-char-range 'cdac:bn-ttdurga)
- . ("*" . "Bengali-CDAC"))
- (,(indian-font-char-range 'cdac:as-ttdurga)
- . ("*" . "Assamese-CDAC"))
- (,(indian-font-char-range 'cdac:pn-ttamar)
- . ("*" . "Punjabi-CDAC"))
- (,(indian-font-char-range 'cdac:gj-ttavantika)
- . ("*" . "Gujarati-CDAC"))
- (,(indian-font-char-range 'cdac:or-ttsarala)
- . ("*" . "Oriya-CDAC"))
- (,(indian-font-char-range 'cdac:tm-ttvalluvar)
- . ("*" . "Tamil-CDAC"))
- (,(indian-font-char-range 'cdac:tl-tthemalatha)
- . ("*" . "Telugu-CDAC"))
- (,(indian-font-char-range 'cdac:kn-ttuma)
- . ("*" . "Kannada-CDAC"))
- (,(indian-font-char-range 'cdac:ml-ttkarthika)
- . ("*" . "Malayalam-CDAC"))
- ;; Indian AKRUTI
- (,(indian-font-char-range 'akruti:dev)
- . ("*" . "Devanagari-Akruti"))
- (,(indian-font-char-range 'akruti:bng)
- . ("*" . "Bengali-Akruti"))
- (,(indian-font-char-range 'akruti:pnj)
- . ("*" . "Punjabi-Akruti"))
- (,(indian-font-char-range 'akruti:guj)
- . ("*" . "Gujarati-Akruti"))
- (,(indian-font-char-range 'akruti:ori)
- . ("*" . "Oriay-Akruti"))
- (,(indian-font-char-range 'akruti:tml)
- . ("*" . "Tamil-Akruti"))
- (,(indian-font-char-range 'akruti:tlg)
- . ("*" . "Telugu-Akruti"))
- (,(indian-font-char-range 'akruti:knd)
- . ("*" . "Kannada-Akruti"))
- (,(indian-font-char-range 'akruti:mal)
- . ("*" . "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"))
+
+ ;; 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"))
+
+ (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*"))
+
+ (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 . "JISX0213.2000-1")
+ (nil . "JISX0213.2000-2"))
+
+ (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 . "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"))
+ ))
+
+ ;; Append Unicode fonts.
+ ;; This may find fonts with more variants (bold, italic) but which
+ ;; don't cover many characters.
+ (set-fontset-font "fontset-default" '(0 . #xFFFF)
+ '(nil . "iso10646-1") nil 'append)
+ ;; These may find fonts that cover many characters but with fewer
+ ;; variants.
+ (set-fontset-font "fontset-default" '(0 . #xFFFF)
+ '("gnu-unifont" . "iso10646-1") nil 'append)
+ (set-fontset-font "fontset-default" '(0 . #xFFFF)
+ '("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 ucs-mule-cjk-to-unicode 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 '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
(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, the length 14.
+ "Compose X fontname from FIELDS.
+FIELDS is a vector of XLFD fields, the length 12.
If a field is nil, wild-card letter `*' is embedded.
Optional argument REDUCE is always ignored. It exists just for
backward compatibility."
(concat "-" (mapconcat (lambda (x) (or x "*")) fields "-")))
-
(defun x-must-resolve-font-name (xlfd-fields)
"Like `x-resolve-font-name', but always return a font name.
XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
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))
(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 6)
+ (if (string-match "^[*-]+$" (aref font-spec i))
+ (aset font-spec i (aref default-spec i))))
+ (setcar (cdr elt) font-spec))))
fontlist))
(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."
(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-int 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-int 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-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,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ...
+ FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ...
Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
-Optional 2nd argument is ignored. It exists just for backward
-compatibility.
+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, error is
-signaled unless the optional 3rd argument NOERROR is non-nil.
+Optional 2nd and 3rd arguments are ignored. They exist just for
+backward compatibility.
-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]*\\([^:]+\\):\\([^,]+\\)" 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 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]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx)
+ (setq idx (match-end 0))
+ (setq script (intern (match-string 1 fontset-spec)))
+ (if (or (eq script 'ascii)
+ (memq script (char-table-extra-slot char-script-table 0))
+ (setq script (cdr (assq script charset-script-alist))))
+ (setq fontlist (cons (list script (match-string 2 fontset-spec))
+ fontlist))))
+
+ ;; Complement FONTLIST.
+ (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist))
+
+ ;; Create a fontset.
+ (new-fontset name fontlist)))
(defun create-fontset-from-ascii-font (font &optional resolved-font
fontset-name)
Optional 1st arg RESOLVED-FONT is a resolved name of FONT. If
omitted, `x-resolve-font-name' is called to get the resolved name. At
-this time, if FONT is not available, error is signaled.
+this time, if FONT is not available, an error is signaled.
Optional 2nd arg FONTSET-NAME is a string to be used in
`<CHARSET_ENCODING>' fields of a new fontset name. If it is omitted,
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)))))
;; 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