;;; 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.
+;; Copyright (C) 1997-2015 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, 2011
;; 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)
("jisx0208" . japanese-jisx0208)
("jisx0201" . jisx0201)
("jisx0212" . japanese-jisx0212)
+ ("ksx1001" . korean-ksc5601)
("ksc5601.1987" . korean-ksc5601)
("cns11643.1992.*1" . chinese-cns11643-1)
("cns11643.1992.*2" . chinese-cns11643-2)
("muleindian-1" . indian-1-column)
("mulelao-1" . mule-lao)
("muletibetan-2" . tibetan)
- ("muletibetan-1" . tibetan-1-column)))
+ ("muletibetan-0" . tibetan)
+ ("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)
(carian #x102A0)
(olt-italic #x10300)
(ugaritic #x10380)
+ (old-permic #x10350)
(old-persian #x103A0)
(deseret #x10400)
(shavian #x10450)
(osmanya #x10480)
+ (elbasan #x10500)
+ (caucasian-albanian #x10530)
+ (linear-a #x10600)
(cypriot-syllabary #x10800)
+ (palmyrene #x10860)
+ (nabataean #x10880)
(phoenician #x10900)
(lydian #x10920)
(kharoshthi #x10A00)
+ (manichaean #x10AC0)
+ (mahajani #x11150)
+ (sinhala-archaic-number #x111E1)
+ (khojki #x11200)
+ (khudawadi #x112B0)
+ (grantha #x11305)
+ (tirhuta #x11481)
+ (siddham #x11580)
+ (modi #x11600)
+ (takri #x11680)
+ (warang-citi #x118A1)
+ (pau-cin-hau #x11AC0)
(cuneiform #x12000)
(cuneiform-numbers-and-punctuation #x12400)
+ (mro #x16A40)
+ (bassa-vah #x16AD0)
+ (pahawh-hmong #x16B11)
+ (duployan-shorthand #x1BC20)
(byzantine-musical-symbol #x1D000)
(musical-symbol #x1D100)
(ancient-greek-musical-notation #x1D200)
(tai-xuan-jing-symbol #x1D300)
(counting-rod-numeral #x1D360)
- (mathematical #x1D400)
+ (mende-kikakui #x1E810)
(mahjong-tile #x1F000)
(domino-tile #x1F030)))
(defvar otf-script-alist)
+;; The below was synchronized with the latest Jan 3, 2013 version of
+;; https://www.microsoft.com/typography/otspec/scripttags.htm.
(setq otf-script-alist
'((arab . arabic)
+ (armi . aramaic)
(armn . armenian)
+ (avst . avestan)
(bali . balinese)
+ (bamu . bamum)
+ (batk . batak)
+ (bng2 . bengali)
(beng . bengali)
(bopo . bopomofo)
(brai . braille)
+ (brah . brahmi)
(bugi . buginese)
(buhd . buhid)
(byzm . byzantine-musical-symbol)
(cans . canadian-aboriginal)
+ (cari . carian)
+ (cakm . chakma)
+ (cham . cham)
(cher . cherokee)
(copt . coptic)
(xsux . cuneiform)
- (cyrl . cyrillic)
(cprt . cypriot)
+ (cyrl . cyrillic)
(dsrt . deseret)
(deva . devanagari)
+ (dev2 . devanagari)
+ (egyp . egyptian)
(ethi . ethiopic)
(geor . georgian)
(glag . glagolitic)
(goth . gothic)
(grek . greek)
(gujr . gujarati)
+ (gjr2 . gujarati)
(guru . gurmukhi)
+ (gur2 . gurmukhi)
(hani . han)
(hang . hangul)
+ (jamo . hangul)
(hano . hanunoo)
(hebr . hebrew)
- (kana . kana)
+ (phli . inscriptional-pahlavi)
+ (prti . inscriptional-parthian)
+ (java . javanese)
+ (kthi . kaithi)
+ (kana . kana) ; Hiragana
(knda . kannada)
+ (knd2 . kannada)
+ (kali . kayah-li)
(khar . kharoshthi)
(khmr . khmer)
(lao\ . lao)
(latn . latin)
+ (lepc . lepcha)
(limb . limbu)
(linb . linear_b)
(mlym . malayalam)
+ (mlm2 . malayalam)
+ (mand . mandaic)
(math . mathematical)
+ (mtei . meetei-mayek)
+ (merc . meroitic)
+ (mero . meroitic)
(mong . mongolian)
(musc . musical-symbol)
- (mymr . myanmar)
+ (mymr . burmese)
(nko\ . nko)
(ogam . ogham)
+ (olck . ol-chiki)
(ital . old_italic)
(xpeo . old_persian)
+ (sarb . old-south-arabian)
+ (orkh . old-turkic)
(orya . oriya)
+ (ory2 . oriya)
(osma . osmanya)
(phag . phags-pa)
(phnx . phoenician)
+ (rjng . rejang)
(runr . runic)
+ (samr . samaritan)
+ (saur . saurashtra)
+ (shrd . sharada)
(shaw . shavian)
(sinh . sinhala)
+ (sora . sora-sompeng)
+ (sund . sundanese)
(sylo . syloti_nagri)
(syrc . syriac)
(tglg . tagalog)
(tagb . tagbanwa)
- (taml . tamil)
(tale . tai_le)
+ (talu . tai-lue)
+ (lana . tai-tham)
+ (tavt . tai-viet)
+ (takr . takri)
+ (taml . tamil)
+ (tml2 . tamil)
(telu . telugu)
(thaa . thaana)
(thai . thai)
(tibt . tibetan)
(tfng . tifinagh)
(ugar . ugaritic)
+ (vai\ . vai)
(yi\ \ . yi)))
;; Set standard fontname specification of characters in the default
;; 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 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
,(font-spec :registry "iso10646-1" :script 'latin))
(thai ,(font-spec :registry "iso10646-1" :otf '(thai nil nil (mark)))
+ ,(font-spec :registry "iso10646-1" :script 'thai)
(nil . "TIS620*")
(nil . "ISO8859-11"))
(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
symbol
braille
yi
- aegean-number
+ aegean-number
ancient-greek-number
ancient-symbol
phaistos-disc
ancient-greek-musical-notation
tai-xuan-jing-symbol
counting-rod-numeral
- mathematical
mahjong-tile
domino-tile))
(set-fontset-font "fontset-default"
- script (font-spec :registry "iso10646-1" :script script)))
+ script (font-spec :registry "iso10646-1" :script script)
+ nil 'append))
+
+ ;; Special settings for `MATHEMATICAL (U+1D400..U+1D7FF)'.
+ (dolist (math-subgroup '((#x1D400 #x1D433 mathematical-bold)
+ (#x1D434 #x1D467 mathematical-italic)
+ (#x1D468 #x1D49B mathematical-bold-italic)
+ (#x1D49C #x1D4CF mathematical-script)
+ (#x1D4D0 #x1D503 mathematical-bold-script)
+ (#x1D504 #x1D537 mathematical-fraktur)
+ (#x1D538 #x1D56B mathematical-double-struck)
+ (#x1D56C #x1D59F mathematical-bold-fraktur)
+ (#x1D5A0 #x1D5D3 mathematical-sans-serif)
+ (#x1D5D4 #x1D607 mathematical-sans-serif-bold)
+ (#x1D608 #x1D63B mathematical-sans-serif-italic)
+ (#x1D63C #x1D66F mathematical-sans-serif-bold-italic)
+ (#x1D670 #x1D6A3 mathematical-monospace)
+ (#x1D6A4 #x1D6A5 mathematical-italic)
+ (#x1D6A8 #x1D6E1 mathematical-bold)
+ (#x1D6E2 #x1D71B mathematical-italic)
+ (#x1D71C #x1D755 mathematical-bold-italic)
+ (#x1D756 #x1D78F mathematical-sans-serif-bold)
+ (#x1D790 #x1D7C9 mathematical-sans-serif-bold-italic)
+ (#x1D7CA #x1D7D7 mathematical-bold)
+ (#x1D7D8 #x1D7E1 mathematical-double-struck)
+ (#x1D7E2 #x1D7EB mathematical-sans-serif)
+ (#x1D7EC #x1D7F5 mathematical-sans-serif-bold)
+ (#x1D7F6 #x1D7FF mathematical-monospace)))
+ (let ((slot (assq (nth 2 math-subgroup) script-representative-chars)))
+ (if slot
+ (if (vectorp (cdr slot))
+ (setcdr slot (vconcat (cdr slot) (vector (car math-subgroup))))
+ (setcdr slot (vector (cadr slot) (car math-subgroup))))
+ (setq slot (list (nth 2 math-subgroup) (car math-subgroup)))
+ (nconc script-representative-chars (list slot))))
+ (set-fontset-font
+ "fontset-default"
+ (cons (car math-subgroup) (nth 1 math-subgroup))
+ (font-spec :registry "iso10646-1" :script (nth 2 math-subgroup))))
+
+ ;; Append CJK fonts for characters other than han, kana, cjk-misc.
+ ;; 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
(set-fontset-font "fontset-default" '(#x20000 . #x2FFFF)
'(nil . "unicode-sip"))
- (set-fontset-font "fontset-default" '(#xE000 . #xF8FF) nil))
+ (set-fontset-font "fontset-default" '(#xE000 . #xF8FF)
+ '(nil . "iso10646-1"))
+ ;; Don't try the fallback fonts even if no suitable font was found
+ ;; by the above font-spec.
+ (set-fontset-font "fontset-default" '(#xE000 . #xF8FF) nil nil 'append))
+
+(defun create-default-fontset ()
+ "Create the default fontset.
+Internal use only. Should be called at startup time."
+ (condition-case err
+ (setup-default-fontset)
+ (error (display-warning
+ 'initialization
+ (format "Creation of the default fontsets failed: %s" err)
+ :error))))
;; These are the registered registries/encodings from
;; ftp://ftp.x.org/pub/DOCS/registry 2001/06/01
;; "HP-Hebrew8" [36]
;; HPHEBREW8 8-bit character set
;; "HP-Japanese15" [36]
-;; HPJAPAN15 15-bit characer set,
-;; modified from industry defacto
+;; HPJAPAN15 15-bit character set,
+;; modified from industry de facto
;; standard Shift-JIS
;; "HP-Kana8" [36]
;; HPKANA8 8-bit character set
;; 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"))
+(put 'vertical-centering-font-regexp 'standard-value
+ (list vertical-centering-font-regexp))
;; 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.")
(defun x-decompose-font-name (pattern)
"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
+The FOUNDRY and FAMILY fields are concatenated and stored in the first
element of the vector.
-The REGISTRY and ENCODING fields are concatinated and stored in the last
+The REGISTRY and ENCODING fields are concatenated and stored in the last
element of the vector.
Return nil if PATTERN doesn't conform to XLFD."
(aset xlfd-fields i nil)))
xlfd-fields)))
-(defun x-compose-font-name (fields &optional reduce)
+(defun x-compose-font-name (fields &optional _reduce)
"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.
(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))
+ ;(swidth (aref xlfd-fields xlfd-regexp-swidth-subnum))
(size (aref xlfd-fields xlfd-regexp-pixelsize-subnum))
(nickname (aref xlfd-fields xlfd-regexp-registry-subnum))
name)
to map charsets to scripts.")
(defun create-fontset-from-fontset-spec (fontset-spec
- &optional style-variant noerror)
+ &optional _style-variant _noerror)
"Create a fontset from fontset specification string FONTSET-SPEC.
FONTSET-SPEC is a string of the format:
- FONTSET-NAME,SCRIPT0:FONT0,SCRIPT1:FONT1, ...
+ FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ...
Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
When a frame uses the fontset as the `font' parameter, the frame's
(error "Fontset name \"%s\" not conforming to XLFD" name))
(setq default-spec (font-spec :name name))
;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
- (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)"
+ (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)"
fontset-spec idx)
(setq idx (match-end 0))
(setq target (intern (match-string 1 fontset-spec)))
(while (setq fontset-spec (x-get-resource (format "fontset-%d" idx)
(format "Fontset-%d" idx)))
(condition-case nil
- (create-fontset-from-fontset-spec fontset-spec t 'noerror)
- (error (message "Fontset-%d: invalid specification in X resource" idx)))
+ (create-fontset-from-fontset-spec fontset-spec t)
+ (error (display-warning
+ 'initialization
+ (format "Fontset-%d: invalid specification in X resource" idx)
+ :warning)))
(setq idx (1+ idx)))))
;;
(provide 'fontset)
-;; arch-tag: bb53e629-0234-403c-950e-551e61554849
;;; fontset.el ends here