-;;; fontset.el --- Commands for handling fontset.
+;;; fontset.el --- commands for handling fontset
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001 Free Software Foundation, Inc.
;; Keywords: mule, multilingual, fontset
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
;;; Code:
-;; Set standard REGISTRY 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. If the value 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
-;; the value 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".
-
-(let ((l `((latin-iso8859-1 . "ISO8859-1")
- (latin-iso8859-2 . "ISO8859-2")
- (latin-iso8859-3 . "ISO8859-3")
- (latin-iso8859-4 . "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 . "JISX0201")
- (cyrillic-iso8859-5 . "ISO8859-5")
- (latin-iso8859-9 . "ISO8859-9")
- (japanese-jisx0208-1978 . "JISX0208.1978")
- (chinese-gb2312 . "GB2312")
- (japanese-jisx0208 . "JISX0208.1983")
- (korean-ksc5601 . "KSC5601")
- (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 . "sisheng_cwnn")
- (vietnamese-viscii-lower . "VISCII1.1")
- (vietnamese-viscii-upper . "VISCII1.1")
- (arabic-digit . "MuleArabic-0")
- (arabic-1-column . "MuleArabic-1")
- (arabic-2-column . "MuleArabic-2")
- (ipa . "MuleIPA")
- (ethiopic . "Ethiopic-Unicode")
- (ascii-right-to-left . "ISO8859-1")
- (indian-is13194 . "IS13194-Devanagari")
- (indian-2-column . "MuleIndian-2")
- (indian-1-column . "MuleIndian-1")
- (lao . "MuleLao-1")
- (tibetan . "MuleTibetan-0")
- (tibetan-1-column . "MuleTibetan-1")
- (latin-iso8859-14 . "ISO8859-14")
- (latin-iso8859-15 . "ISO8859-15")
+;; 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
+;; 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".
+
+(let ((l `((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"))
+ (indian-1-column . ("*" . "MuleIndian-1"))
+ (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"))
))
- charset registry arg)
+ charset font-spec arg)
(while l
- (setq charset (car (car l)) registry (cdr (car l)) l (cdr l))
- (or (string-match "-" registry)
- (setq registry (concat registry "*")))
+ (setq charset (car (car l)) font-spec (cdr (car l)) l (cdr l))
(if (symbolp charset)
(setq arg (make-char charset))
(setq arg charset))
- (set-fontset-font t arg registry)))
+ (set-fontset-font "fontset-default" arg font-spec)))
;; Set arguments in `font-encoding-alist' (which see).
(defun set-font-encoding (pattern charset encoding)
(set-font-encoding "ISO8859-1" 'ascii 0)
(set-font-encoding "JISX0201" 'latin-jisx0201 0)
+(define-ccl-program ccl-encode-unicode-font
+ `(0
+ (if (r0 == ,(charset-id 'ascii))
+ ((r2 = r1)
+ (r1 = 0))
+ (if (r0 == ,(charset-id 'latin-iso8859-1))
+ ((r2 = (r1 + 128))
+ (r1 = 0))
+ (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)))))))))
+
+(setq font-ccl-encoder-alist
+ (cons '("ISO10646-1" . ccl-encode-unicode-font)
+ font-ccl-encoder-alist))
+
;; Setting for suppressing XLoadQueryFont on big fonts.
(setq x-pixel-size-width-font-regexp
"gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5")
("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))
+ ("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
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.
+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))
+ (let ((pattern (x-compose-font-name xlfd-fields)))
+ (condition-case nil
+ (setq ascii-font (x-resolve-font-name pattern))
+ (error
+ (message "Warning: no fonts matching `%s' available" pattern)
+ (aset xlfd-fields index "*")
+ (setq index (1+ index))))))
+ (unless ascii-font
+ (error "No fonts founds"))
+ ascii-font))
+
+
(defun x-complement-fontset-spec (xlfd-fields fontlist)
"Complement FONTLIST for charsets based on XLFD-FIELDS and return it.
XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
If a font specifid for ASCII supports the other charsets (see the
variable `x-font-name-charset-alist'), add that information to FONTLIST."
- (let ((ascii-font (cdr (assq 'ascii fontlist))))
-
- ;; If font for ASCII is not specified, add it.
- (unless ascii-font
- (let ((registry (cdr (fontset-font t 0)))
- (encoding nil))
- (if (string-match "-" registry)
- (setq encoding (substring registry (match-end 0))
- registry (substring registry 0 (match-beginning 0))))
- (aset xlfd-fields xlfd-regexp-registry-subnum registry)
- (aset xlfd-fields xlfd-regexp-encoding-subnum encoding)
- (setq ascii-font (x-compose-font-name xlfd-fields))
- (setq fontlist (cons (cons 'ascii ascii-font) 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 charset (car charsets) charsets (cdr charsets))
(or (assq charset fontlist)
(setq fontlist
- (cons (cons charset ascii-font) fontlist))))))))
+ (cons (cons charset ascii-font-spec) fontlist))))))))
fontlist))
(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))
(cons (cons name alias) fontset-alias-alist)))))
;; Define the ASCII font name alias.
- (setq ascii-font (cdr (assq 'ascii fontlist)))
+ (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)