# HG changeset patch # User Kenichi Handa # Date 953598726 0 # Node ID ceaded4c2cb90b3df4c09e1a16a0e51f7f35f64a # Parent 73c16c6e401ee95452a84f7b82a6404ce221ceb4 (x-charset-registries): Variable removed, instead the corresponding data is stored in the default fontset. (register-alternate-fontnames): Function removed. (resolved-ascii-font): Variable removed. (x-compose-font-name): Ignore the second argument REDOCE. (x-complement-fontset-spec): Complement only an ASCII font and element for those charsets than can use that ASCII font. (generate-fontset-menu): Don't refer to global-fontset-alist, instead call fontset-list. (uninstantiated-fontset-alist): Variable removed. (x-style-funcs-alist): Likewise. (fontset-default-styles): Likewise. (x-modify-font-name): Function removed. (create-fontset-from-fontset-spec): Ignore the argument STYLE-VARIANT. (create-fontset-from-ascii-font): Docsting adjusted for the above change. (instantiate-fontset, resolve-fontset-name): Functions removed. (fontset-list): Now implemented by C code. diff -r 73c16c6e401e -r ceaded4c2cb9 lisp/international/fontset.el --- a/lisp/international/fontset.el Tue Mar 21 00:31:38 2000 +0000 +++ b/lisp/international/fontset.el Tue Mar 21 00:32:06 2000 +0000 @@ -24,68 +24,70 @@ ;;; Code: -;; Set standard REGISTRY property of charset to find an appropriate -;; font for each charset. This is used to generate a font name in a -;; fontset. 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. +;; 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". -(defvar x-charset-registries - '((ascii . "ISO8859-1") - (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") - )) - -(let ((l x-charset-registries)) +(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") + )) + charset registry arg) (while l - (condition-case nil - (put-charset-property (car (car l)) 'x-charset-registry (cdr (car l))) - (error nil)) - (setq l (cdr l)))) + (setq charset (car (car l)) registry (cdr (car l)) l (cdr l)) + (or (string-match "-" registry) + (setq registry (concat registry "*"))) + (if (symbolp charset) + (setq arg (make-char charset)) + (setq arg charset)) + (set-fontset-font t arg registry))) ;; Set arguments in `font-encoding-alist' (which see). (defun set-font-encoding (pattern charset encoding) @@ -106,9 +108,9 @@ (setq x-pixel-size-width-font-regexp "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") -;; There fonts require vertical centering. +;; These fonts require vertical centering. (setq vertical-centering-font-regexp - "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5") + "gb2312\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5") (defvar x-font-name-charset-alist '(("iso8859-1" ascii latin-iso8859-1) @@ -257,121 +259,53 @@ "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 non-nil means consecutive wild-cards are -reduced to be one." - (let ((name - (concat "-" (mapconcat (lambda (x) (or x "*")) fields "-")))) - (if reduce - (x-reduce-font-name name) - name))) - -(defun register-alternate-fontnames (fontname) - "Register alternate fontnames for FONTNAME in `alternate-fontname-alist'. -When Emacs fails to open FONTNAME, it tries to open an alternate font -registered in the variable `alternate-fontname-alist' (which see). - -For FONTNAME, the following three alternate fontnames are registered: - fontname which ignores style specification of FONTNAME, - fontname which ignores size specification of FONTNAME, - fontname which ignores both style and size specification of FONTNAME. -Emacs tries to open fonts in this order." - (unless (assoc fontname alternate-fontname-alist) - (let ((xlfd-fields (x-decompose-font-name fontname)) - style-ignored size-ignored both-ignored) - (when xlfd-fields - (aset xlfd-fields xlfd-regexp-foundry-subnum nil) - (aset xlfd-fields xlfd-regexp-family-subnum nil) - - (let ((temp (copy-sequence xlfd-fields))) - (aset temp xlfd-regexp-weight-subnum nil) - (aset temp xlfd-regexp-slant-subnum nil) - (aset temp xlfd-regexp-swidth-subnum nil) - (aset temp xlfd-regexp-adstyle-subnum nil) - (setq style-ignored (x-compose-font-name temp t))) - - (aset xlfd-fields xlfd-regexp-pixelsize-subnum nil) - (aset xlfd-fields xlfd-regexp-pointsize-subnum nil) - (aset xlfd-fields xlfd-regexp-resx-subnum nil) - (aset xlfd-fields xlfd-regexp-resy-subnum nil) - (aset xlfd-fields xlfd-regexp-spacing-subnum nil) - (aset xlfd-fields xlfd-regexp-avgwidth-subnum nil) - (setq size-ignored (x-compose-font-name xlfd-fields t)) - - (aset xlfd-fields xlfd-regexp-weight-subnum nil) - (aset xlfd-fields xlfd-regexp-slant-subnum nil) - (aset xlfd-fields xlfd-regexp-swidth-subnum nil) - (aset xlfd-fields xlfd-regexp-adstyle-subnum nil) - (setq both-ignored (x-compose-font-name xlfd-fields t)) - - (setq alternate-fontname-alist - (cons (list fontname style-ignored size-ignored both-ignored) - alternate-fontname-alist)))))) - -;; Just to avoid compiler waring. The gloval value is never used. -(defvar resolved-ascii-font nil) +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 all charsets based on XLFD-FIELDS and return it. + "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. -Font names for charsets not listed in FONTLIST are generated from -XLFD-FIELDS and a property of x-charset-registry of each charset -automatically. +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 ((ascii-font (cdr (assq 'ascii fontlist)))) -By side effect, this sets `resolved-ascii-font' to the resolved name -of ASCII font." - (let ((charsets charset-list) - (xlfd-fields-non-ascii (copy-sequence xlfd-fields)) - (new-fontlist nil)) - (aset xlfd-fields-non-ascii xlfd-regexp-foundry-subnum nil) - (aset xlfd-fields-non-ascii xlfd-regexp-family-subnum nil) - (aset xlfd-fields-non-ascii xlfd-regexp-adstyle-subnum nil) - (aset xlfd-fields-non-ascii xlfd-regexp-avgwidth-subnum nil) - (while charsets - (let ((charset (car charsets))) - (unless (assq charset fontlist) - (let ((registry (get-charset-property charset 'x-charset-registry)) - registry-val encoding-val fontname) - (if (string-match "-" registry) - ;; REGISTRY contains `CHARSET_ENCODING' field. - (setq registry-val (substring registry 0 (match-beginning 0)) - encoding-val (substring registry (match-end 0))) - (setq registry-val (concat registry "*") - encoding-val "*")) - (let ((xlfd (if (eq charset 'ascii) xlfd-fields - xlfd-fields-non-ascii))) - (aset xlfd xlfd-regexp-registry-subnum registry-val) - (aset xlfd xlfd-regexp-encoding-subnum encoding-val) - (setq fontname (downcase (x-compose-font-name xlfd)))) - (setq new-fontlist (cons (cons charset fontname) new-fontlist)) - (register-alternate-fontnames fontname)))) - (setq charsets (cdr charsets))) + ;; 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)))) - ;; Be sure that ASCII font is available. - (let ((slot (or (assq 'ascii fontlist) (assq 'ascii new-fontlist))) - ascii-font) - (setq ascii-font (condition-case nil - (x-resolve-font-name (cdr slot)) - (error nil))) - (if ascii-font - (let ((l x-font-name-charset-alist)) - ;; If the ASCII font can also be used for another - ;; charsets, use that font instead of what generated based - ;; on x-charset-registry in the previous code. - (while l - (if (string-match (car (car l)) ascii-font) - (let ((charsets (cdr (car l))) - slot2) - (while charsets - (if (and (not (eq (car charsets) 'ascii)) - (setq slot2 (assq (car charsets) new-fontlist))) - (setcdr slot2 (cdr slot))) - (setq charsets (cdr charsets))) - (setq l nil)) - (setq l (cdr l)))) - (setq resolved-ascii-font ascii-font) - (append fontlist new-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. @@ -384,11 +318,11 @@ ;; Return a list to be appended to `x-fixed-font-alist' when ;; `mouse-set-font' is called. (defun generate-fontset-menu () - (let ((fontsets global-fontset-alist) + (let ((fontsets (fontset-list)) fontset-name l) (while fontsets - (setq fontset-name (car (car fontsets)) fontsets (cdr 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)))))))) @@ -426,53 +360,6 @@ name)) fontset))) -(defvar uninstantiated-fontset-alist nil - "Alist of fontset names vs. information for instantiating them. -Each element has the form (FONTSET STYLE FONTLIST), where -FONTSET is a name of fontset not yet instantiated. -STYLE is a style of FONTSET, one of the followings: - bold, demobold, italic, oblique, - bold-italic, demibold-italic, bold-oblique, demibold-oblique. -FONTLIST is an alist of charsets vs font names to be used in FONSET.") - -(defconst x-style-funcs-alist - `((bold . x-make-font-bold) - (demibold . x-make-font-demibold) - (italic . x-make-font-italic) - (oblique . x-make-font-oblique) - (bold-italic . x-make-font-bold-italic) - (demibold-italic - . ,(function (lambda (x) - (let ((y (x-make-font-demibold x))) - (and y (x-make-font-italic y)))))) - (demibold-oblique - . ,(function (lambda (x) - (let ((y (x-make-font-demibold x))) - (and y (x-make-font-oblique y)))))) - (bold-oblique - . ,(function (lambda (x) - (let ((y (x-make-font-bold x))) - (and y (x-make-font-oblique y))))))) - "Alist of font style vs function to generate a X font name of the style. -The function is called with one argument, a font name.") - -(defcustom fontset-default-styles '(bold italic bold-italic) - "List of alternative styles to create for a fontset. -Valid elements include `bold', `demibold'; `italic', `oblique'; -and combinations of one from each group, -such as `bold-italic' and `demibold-oblique'." - :group 'faces - :type '(set (const bold) (const demibold) (const italic) (const oblique) - (const bold-italic) (const bold-oblique) (const demibold-italic) - (const demibold-oblique))) - -(defun x-modify-font-name (fontname style) - "Substitute style specification part of FONTNAME for STYLE. -STYLE should be listed in the variable `x-style-funcs-alist'." - (let ((func (cdr (assq style x-style-funcs-alist)))) - (if func - (funcall func fontname)))) - ;;;###autoload (defun create-fontset-from-fontset-spec (fontset-spec &optional style-variant noerror) @@ -481,12 +368,8 @@ 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 STYLE-VARIANT is a list of font styles -\(e.g. bold, italic) or the symbol t to specify all available styles. -If this argument is specified, fontsets which differs from -FONTSET-NAME in styles are also created. An element of STYLE-VARIANT -may be cons of style and a font name. In this case, the style variant -fontset uses the font for ASCII character set. +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. @@ -494,12 +377,17 @@ 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)) - fontlist full-fontlist ascii-font resolved-ascii-font charset) + 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)) @@ -507,77 +395,27 @@ (if (charsetp charset) (setq fontlist (cons (cons charset (match-string 2 fontset-spec)) fontlist)))) - ;; Remember the specified ASCII font name now because it will be - ;; replaced by resolved font name by x-complement-fontset-spec. - (setq ascii-font (cdr (assq 'ascii fontlist))) - - ;; If NAME conforms to XLFD, complement FONTLIST for charsets - ;; which are not specified in FONTSET-SPEC. - (let ((fields (x-decompose-font-name name))) - (if fields - (setq full-fontlist (x-complement-fontset-spec fields fontlist)))) - - (when full-fontlist - ;; Create the fontset. - (new-fontset name full-fontlist) - ;; Define aliases: short name (if appropriate) and ASCII font name. - (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))))) - (or (rassoc resolved-ascii-font fontset-alias-alist) - (setq fontset-alias-alist - (cons (cons name resolved-ascii-font) - fontset-alias-alist))) - (or (equal ascii-font resolved-ascii-font) - (rassoc ascii-font fontset-alias-alist) - (setq fontset-alias-alist - (cons (cons name ascii-font) - fontset-alias-alist))) + ;; Complement FONTLIST. + (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) - ;; At last, handle style variants. - (if (eq style-variant t) - (setq style-variant fontset-default-styles)) + (new-fontset name fontlist) - (if style-variant - ;; Generate fontset names of style variants and set them - ;; in uninstantiated-fontset-alist. - (let* (nonascii-fontlist - new-name new-ascii-font style font) - (if ascii-font - (setq nonascii-fontlist (delete (cons 'ascii ascii-font) - (copy-sequence fontlist))) - (setq ascii-font (cdr (assq 'ascii full-fontlist)) - nonascii-fontlist fontlist)) - (while style-variant - (setq style (car style-variant)) - (if (symbolp style) - (setq font nil) - (setq font (cdr style) - style (car style))) - (setq new-name (x-modify-font-name name style)) - (when new-name - ;; Modify ASCII font name for the style... - (setq new-ascii-font - (or font - (x-modify-font-name resolved-ascii-font style))) - ;; but leave fonts for the other charsets unmodified - ;; for the moment. They are modified for the style - ;; in instantiate-fontset. - (setq uninstantiated-fontset-alist - (cons (list new-name - style - (cons (cons 'ascii new-ascii-font) - nonascii-fontlist)) - uninstantiated-fontset-alist)) - (or (rassoc new-ascii-font fontset-alias-alist) - (setq fontset-alias-alist - (cons (cons new-name new-ascii-font) - fontset-alias-alist)))) - (setq style-variant (cdr style-variant))))))) + ;; 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. + (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 @@ -592,87 +430,29 @@ `' fields of a new fontset name. If it is omitted, an appropriate name is generated automatically. -Style variants of the fontset is created too. Font names in the -variants are generated automatically from FONT unless X resources -XXX.attributeFont explicitly specify them. - It returns a name of the created fontset." - (or resolved-font - (setq resolved-font (x-resolve-font-name font))) - (let* ((faces (copy-sequence fontset-default-styles)) - (styles faces) - (xlfd (x-decompose-font-name font)) - (resolved-xlfd (x-decompose-font-name resolved-font)) - face face-font fontset fontset-spec) - (while faces - (setq face (car faces)) - (setq face-font (x-get-resource (concat (symbol-name face) - ".attributeFont") - "Face.AttributeFont")) - (if face-font - (setcar faces (cons face face-font))) - (setq faces (cdr faces))) + (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") - (or 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)))) + (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) - ;; The fontset name should have concrete values in weight and - ;; slant field. - (let ((weight (aref xlfd xlfd-regexp-weight-subnum)) - (slant (aref xlfd xlfd-regexp-slant-subnum))) - (if (or (not weight) (string-match "[*?]*" weight)) - (aset xlfd xlfd-regexp-weight-subnum - (aref resolved-xlfd xlfd-regexp-weight-subnum))) - (if (or (not slant) (string-match "[*?]*" slant)) - (aset xlfd xlfd-regexp-slant-subnum - (aref resolved-xlfd xlfd-regexp-slant-subnum)))) (setq fontset (x-compose-font-name xlfd)) (or (query-fontset fontset) - (create-fontset-from-fontset-spec (concat fontset ", ascii:" font) - styles)))) - -(defun instantiate-fontset (fontset) - "Make FONTSET be ready to use. -FONTSET should be in the variable `uninstantiated-fontset-alist' in advance. -Return FONTSET if it is created successfully, else return nil." - (let ((fontset-data (assoc fontset uninstantiated-fontset-alist))) - (when fontset-data - (setq uninstantiated-fontset-alist - (delete fontset-data uninstantiated-fontset-alist)) + (create-fontset-from-fontset-spec (concat fontset ", ascii:" font))))) - (let* ((fields (x-decompose-font-name fontset)) - (style (nth 1 fontset-data)) - (fontlist (x-complement-fontset-spec fields (nth 2 fontset-data))) - (font (cdr (assq 'ascii fontlist)))) - ;; If ASCII font is available, instantiate this fontset. - (when font - (let ((new-fontlist (list (cons 'ascii font)))) - ;; Fonts for non-ascii charsets should be modified for - ;; this style now. - (while fontlist - (setq font (cdr (car fontlist))) - (or (eq (car (car fontlist)) 'ascii) - (setq new-fontlist - (cons (cons (car (car fontlist)) - (x-modify-font-name font style)) - new-fontlist))) - (setq fontlist (cdr fontlist))) - (new-fontset fontset new-fontlist) - fontset)))))) - -(defun resolve-fontset-name (pattern) - "Return a fontset name matching PATTERN." - (let ((fontset (car (rassoc pattern fontset-alias-alist)))) - (or fontset (setq fontset pattern)) - (if (assoc fontset uninstantiated-fontset-alist) - (instantiate-fontset fontset) - (query-fontset fontset)))) ;; Create standard fontset from 16 dots fonts which are the most widely ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are @@ -707,10 +487,6 @@ (create-fontset-from-fontset-spec fontset-spec t 'noerror) (setq idx (1+ idx))))) -(defsubst fontset-list () - "Returns a list of all defined fontset names." - (mapcar 'car global-fontset-alist)) - ;; (provide 'fontset)