mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-14 09:39:42 +00:00
f6cab6c82f
ASCII font name so that the same family name is used for fonts registered in x-font-name-charset-alist. (create-fontset-from-fontset-spec): Adjusted for the above change. The name of fontset alias should be a unresolved ASCII font name.
530 lines
20 KiB
EmacsLisp
530 lines
20 KiB
EmacsLisp
;;; fontset.el --- Commands for handling fontset.
|
||
|
||
;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
|
||
;; Licensed to the Free Software Foundation.
|
||
|
||
;; Keywords: mule, multilingual, fontset
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation; either version 2, or (at your option)
|
||
;; any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; 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.
|
||
|
||
;;; Code:
|
||
|
||
;; 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 font-spec arg)
|
||
(while l
|
||
(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 "fontset-default" arg font-spec)))
|
||
|
||
;; Set arguments in `font-encoding-alist' (which see).
|
||
(defun set-font-encoding (pattern charset encoding)
|
||
(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)))))
|
||
(setq font-encoding-alist
|
||
(cons (list pattern (cons charset encoding)) font-encoding-alist)))
|
||
))
|
||
|
||
(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")
|
||
|
||
;; These fonts require vertical centering.
|
||
(setq vertical-centering-font-regexp
|
||
"gb2312\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5")
|
||
|
||
(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.")
|
||
|
||
;;; 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
|
||
|
||
;; 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
|
||
"^\
|
||
-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\
|
||
-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\
|
||
-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)$")
|
||
|
||
;; 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
|
||
))
|
||
|
||
(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)
|
||
|
||
(defun x-compose-font-name (fields &optional reduce)
|
||
"Compose X's fontname from FIELDS.
|
||
FIELDS is a vector of XLFD fields, the length 14.
|
||
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-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.
|
||
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)))
|
||
(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-resolve-font-name (x-compose-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.
|
||
(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) fontlist))))))))
|
||
|
||
fontlist))
|
||
|
||
(defun fontset-name-p (fontset)
|
||
"Return non-nil if FONTSET is valid as fontset name.
|
||
A valid fontset name should conform to XLFD (X Logical Font Description)
|
||
with \"fontset\" in `<CHARSET_REGISTRY> field."
|
||
(and (string-match xlfd-tight-regexp fontset)
|
||
(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)))
|
||
(cons "Fontset"
|
||
(sort l (function (lambda (x y) (string< (car x) (car y))))))))
|
||
|
||
(defun fontset-plain-name (fontset)
|
||
"Return a plain and descriptive name of FONTSET."
|
||
(if (not (setq fontset (query-fontset 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))
|
||
(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))
|
||
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))
|
||
fontset)))
|
||
|
||
;;;###autoload
|
||
(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, ...
|
||
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.
|
||
|
||
If this function attempts to create already existing fontset, error is
|
||
signaled unless the optional 3rd argument NOERROR is non-nil.
|
||
|
||
It returns a name of the created fontset."
|
||
(if (not (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))
|
||
|
||
(defun create-fontset-from-ascii-font (font &optional resolved-font
|
||
fontset-name)
|
||
"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
|
||
this time, if FONT is not available, 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,
|
||
an appropriate name is generated automatically.
|
||
|
||
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")
|
||
(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)
|
||
(setq fontset (x-compose-font-name xlfd))
|
||
(or (query-fontset fontset)
|
||
(create-fontset-from-fontset-spec (concat fontset ", ascii:" font)))))
|
||
|
||
|
||
;; Create standard fontset from 16 dots fonts which are the most widely
|
||
;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are
|
||
;; 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")
|
||
"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
|
||
;; `standard-fontset-spec'.
|
||
|
||
(defun create-fontset-from-x-resource ()
|
||
(let ((idx 0)
|
||
fontset-spec)
|
||
(while (setq fontset-spec (x-get-resource (format "fontset-%d" idx)
|
||
(format "Fontset-%d" idx)))
|
||
(create-fontset-from-fontset-spec fontset-spec t 'noerror)
|
||
(setq idx (1+ idx)))))
|
||
|
||
;;
|
||
(provide 'fontset)
|
||
|
||
;;; fontset.el ends here
|