;;; fontset.el --- commands for handling fontset
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009
+;; 2005, 2006, 2007, 2008, 2009, 2010
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003, 2006
;; Setup font-encoding-alist for all known encodings.
(setq font-encoding-alist
+ (mapcar (lambda (arg)
+ (cons (purecopy (car arg)) (cdr arg)))
'(("iso8859-1$" . iso-8859-1)
("iso8859-2$" . iso-8859-2)
("iso8859-3$" . iso-8859-3)
("mulelao-1" . mule-lao)
("muletibetan-2" . tibetan)
("muletibetan-0" . tibetan)
- ("muletibetan-1" . tibetan-1-column)))
+ ("muletibetan-1" . tibetan-1-column))))
(defvar font-encoding-charset-alist)
(thai #xE17)
(lao #xEA5)
(tibetan #xF40)
- (myanmar #x1000)
+ (burmese #x1000)
(georgian #x10D3)
(ethiopic #x1208)
(cherokee #x13B6)
(math . mathematical)
(mong . mongolian)
(musc . musical-symbol)
- (mymr . myanmar)
+ (mymr . burmese)
(nko\ . nko)
(ogam . ogham)
(ital . old_italic)
;; or a string FONT-NAME,
;; or an object created by `font-spec'.
;;
-;; FAMILY may be nil, in which case, the the corresponding name of
+;; FAMILY may be nil, in which case, 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
(declare-function set-fontset-font "fontset.c"
(name target font-spec &optional frame add))
+(eval-when-compile
+
+;; Build a data to initialize the default fontset at compile time to
+;; avoid loading charsets that won't be necessary at runtime.
+
+;; The value is (CJK-REGISTRY-VECTOR TARGET-SPEC ...), where
+;; CJK-REGISTRY-VECTOR is ["JISX0208.1983-0" "GB2312.1980-0" ...],
+;; TARGET-SPEC is (TARGET . BITMASK) or (TARGET SPEC ...),
+;; TARGET is CHAR or (FROM-CHAR . TO-CHAR),
+;; BITMASK is a bitmask of indices to CJK-REGISTRY-VECTOR,
+;; SPEC is a list of arguments to font-spec.
+
+(defmacro build-default-fontset-data ()
+ (let* (;; CHARSET-REGISTRY CHARSET FROM-CODE TO-CODE
+ (cjk '(("JISX0208.1983-0" japanese-jisx0208 #x2121 #x287E)
+ ("GB2312.1980-0" chinese-gb2312 #x2121 #x297E)
+ ("BIG5-0" big5 #xA140 #xA3FE)
+ ("CNS11643.1992-1" chinese-cns11643-1 #x2121 #x427E)
+ ("KSC5601.1987-0" korean-ksc5601 #x2121 #x2C7E)))
+ (scripts '((tibetan
+ (:registry "iso10646-1" :otf (tibt nil (ccmp blws abvs)))
+ (:family "mtib" :registry "iso10646-1")
+ (:registry "muletibetan-2"))
+ (ethiopic
+ (:registry "iso10646-1" :script ethiopic)
+ (:registry "ethiopic-unicode"))
+ (phonetic
+ (:registry "iso10646-1" :script phonetic)
+ (:registry "MuleIPA-1")
+ (:registry "iso10646-1"))))
+ (cjk-table (make-char-table nil))
+ (script-coverage
+ #'(lambda (script)
+ (let ((coverage))
+ (map-char-table
+ #'(lambda (range val)
+ (when (eq val script)
+ (if (consp range)
+ (setq range (cons (car range) (cdr range))))
+ (push range coverage)))
+ char-script-table)
+ coverage)))
+ (data (list (vconcat (mapcar 'car cjk))))
+ (i 0))
+ (dolist (elt cjk)
+ (let ((mask (lsh 1 i)))
+ (map-charset-chars
+ #'(lambda (range arg)
+ (let ((from (car range)) (to (cdr range)))
+ (if (< to #x110000)
+ (while (<= from to)
+ (or (memq (aref char-script-table from)
+ '(kana hangul han cjk-misc))
+ (aset cjk-table from
+ (logior (or (aref cjk-table from) 0) mask)))
+ (setq from (1+ from))))))
+ (nth 1 elt) nil (nth 2 elt) (nth 3 elt)))
+ (setq i (1+ i)))
+ (map-char-table
+ #'(lambda (range val)
+ (if (consp range)
+ (setq range (cons (car range) (cdr range))))
+ (push (cons range val) data))
+ cjk-table)
+ (dolist (script scripts)
+ (dolist (range (funcall script-coverage (car script)))
+ (push (cons range (cdr script)) data)))
+ `(quote ,(nreverse data))))
+)
+
(defun setup-default-fontset ()
"Setup the default fontset."
(new-fontset
(sinhala ,(font-spec :registry "iso10646-1" :otf '(sinh nil (akhn))))
(malayalam ,(font-spec :registry "iso10646-1" :otf '(mlym nil (akhn))))
+ (burmese ,(font-spec :registry "iso10646-1" :otf '(mymr nil nil))
+ ,(font-spec :registry "iso10646-1" :script 'burmese))
+
(lao ,(font-spec :registry "iso10646-1" :otf '(lao\ nil nil (mark)))
,(font-spec :registry "iso10646-1" :script 'lao)
(nil . "MuleLao-1"))
(tai-viet ("TaiViet" . "iso10646-1"))
- ;; both for script and charset.
- (tibetan ,(font-spec :registry "iso10646-1"
- :otf '(tibt nil (ccmp blws abvs)))
- ,(font-spec :family "mtib" :registry "iso10646-1")
- (nil . "muletibetan-2"))
-
- ;; both for script and charset.
- (ethiopic ,(font-spec :registry "iso10646-1" :script 'ethiopic)
- (nil . "ethiopic-unicode"))
-
(greek ,(font-spec :registry "iso10646-1" :script 'greek)
(nil . "ISO8859-7"))
(nil . "koi8-r"))
(arabic ,(font-spec :registry "iso10646-1"
- :otf '(arab nil (init medi fini liga)))
+ :otf '(arab nil (init medi fina liga)))
(nil . "MuleArabic-0")
(nil . "MuleArabic-1")
(nil . "MuleArabic-2")
(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 ,(font-spec :registry "iso10646-1" :script 'phonetic)
- (nil . "MuleIPA-1")
- (nil . "iso10646-1"))
;; Fallback fonts
(nil (nil . "gb2312.1980")
armenian
syriac
thaana
- myanmar
georgian
cherokee
canadian-aboriginal
(font-spec :registry "iso10646-1" :script (nth 2 math-subgroup))))
;; Append CJK fonts for characters other than han, kana, cjk-misc.
- ;; CHARSET-REGISTRY CHARSET FROM-CODE TO-CODE
- (let ((list '(("JISX0208.1983-0" japanese-jisx0208 #x2121 #x287E)
- ("GB2312.1980-0" chinese-gb2312 #x2121 #x297E)
- ("BIG5-0" big5 #xA140 #xA3FE)
- ("CNS11643.1992-1" chinese-cns11643-1 #x2121 #x427E)
- ("KSC5601.1987-0" korean-ksc5601 #x2121 #x2C7E))))
- (dolist (elt list)
- (map-charset-chars
- #'(lambda (range arg)
- (set-fontset-font "fontset-default" range
- (cons nil (car elt)) nil 'append))
- (nth 1 elt) nil (nth 2 elt) (nth 3 elt))))
+ ;; Append fonts for scripts whose name is also a charset name.
+ (let* ((data (build-default-fontset-data))
+ (registries (car data)))
+ (dolist (target-spec (cdr data))
+ (let ((target (car target-spec))
+ (spec (cdr target-spec)))
+ (if (integerp spec)
+ (dotimes (i (length registries))
+ (if (> (logand spec (lsh 1 i)) 0)
+ (set-fontset-font "fontset-default" target
+ (cons nil (aref registries i))
+ nil 'append)))
+ (dolist (args spec)
+ (set-fontset-font "fontset-default" target
+ (apply 'font-spec args) nil 'append))))))
;; Append Unicode fonts.
;; This may find fonts with more variants (bold, italic) but which
;; Setting for suppressing XLoadQueryFont on big fonts.
(setq x-pixel-size-width-font-regexp
- "gb2312\\|gbk\\|gb18030\\|jisx0208\\|ksc5601\\|cns11643\\|big5")
+ (purecopy "gb2312\\|gbk\\|gb18030\\|jisx0208\\|ksc5601\\|cns11643\\|big5"))
;; These fonts require vertical centering.
(setq vertical-centering-font-regexp
- "gb2312\\|gbk\\|gb18030\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5")
+ (purecopy "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)))
+ (list (cons (purecopy "-cdac$") 1.3)))
(defvar x-font-name-charset-alist nil
"This variable has no meaning now. Just kept for backward compatibility.")