-;;; 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) 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
;; Keywords: mule, multilingual, fontset
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
;;; Code:
;; 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"))
- (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 . (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"))
- (japanese-jisx0213-1 . ("*" . "JISX0213"))
- (japanese-jisx0213-2 . ("*" . "JISX0213"))
- ))
- charset font-spec arg)
- (while l
- (setq charset (car (car l)) font-spec (cdr (car l)) l (cdr l))
- (or (string-match "-" (cdr font-spec))
- (setcdr font-spec (concat (cdr font-spec) "*")))
- (if (symbolp charset)
- (setq arg (make-char charset))
- (setq arg charset))
- (set-fontset-font "fontset-default" arg font-spec)))
+(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 . "Oriay-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)
(cons (list pattern (cons charset encoding)) font-encoding-alist)))
))
-(set-font-encoding "ISO8859-1" 'ascii 0)
-(set-font-encoding "JISX0201" 'latin-jisx0201 0)
+;; 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-mule-unicode-0100-24ff
+(define-ccl-program ccl-encode-unicode-font
`(0
- (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
- ((r1 *= 96)
- (r1 += r2)
- (r1 += ,(- ?\x100 (* 32 96) 32))
- (r1 >8= 0)
- (r2 = r7))
- ((r2 = r1)
- (r1 = 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-1" . ccl-encode-mule-unicode-0100-24ff)
+ (cons '("ISO10646.*-*" . ccl-encode-unicode-font)
font-ccl-encoder-alist))
;; Setting for suppressing XLoadQueryFont on big fonts.
(setq vertical-centering-font-regexp
"gb2312\\|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)
("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower)
("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower)
("mulelao-1" ascii lao)
- ("iso10646-1" ascii mule-unicode-0100-24ff))
+ ("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 found"))
+ 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* ((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-compose-font-name xlfd-fields))
+ (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))
(defun fontset-name-p (fontset)
name)
(if (not (string= "fontset" charset))
fontset
- (if (> (string-to-int size) 0)
+ (if (> (string-to-number size) 0)
(setq name (format "%s: %s-dot" nickname size))
(setq name nickname))
(cond ((string-match "^medium$" weight)
name))
fontset)))
-;;;###autoload
+
(defun create-fontset-from-fontset-spec (fontset-spec
&optional style-variant noerror)
"Create a fontset from fontset specification string FONTSET-SPEC.
(name (match-string 0 fontset-spec))
xlfd-fields charset fontlist ascii-font)
(if (query-fontset name)
- (or noerror
+ (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)
+ (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))
(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)
"Create a fontset from an ASCII font FONT.
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
+omitted, `x-resolve-font-name' is called to get the resolved name. At
this time, if FONT is not available, error is signaled.
Optional 2nd arg FONTSET-NAME is a string to be used in
;;
(provide 'fontset)
+;;; arch-tag: bb53e629-0234-403c-950e-551e61554849
;;; fontset.el ends here