(register-alternate-fontnames fontname))))
(setq charsets (cdr charsets)))
- ;; Be sure that ASCII font is avairable.
+ ;; Be sure that ASCII font is available.
(let ((slot (or (assq 'ascii fontlist) (assq 'ascii new-fontlist)))
ascii-font)
- (if (setq ascii-font (condition-case nil
- (x-resolve-font-name (cdr slot))
- (error nil)))
- (setcdr slot 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
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) (x-make-font-italic (x-make-font-demibold x)))))
- (demibold-oblique
- . ,(function (lambda (x) (x-make-font-oblique (x-make-font-demibold x)))))
- (bold-oblique
- . ,(function (lambda (x) (x-make-font-oblique (x-make-font-bold x))))))
- "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.")
-
(defconst x-style-funcs-alist
`((bold . x-make-font-bold)
(demibold . x-make-font-demibold)
and combinations of one from each group,
such as `bold-italic' and `demibold-oblique'."
:group 'faces
- :type '(set bold demibold italic oblique bold-italic bold-oblique
- demibold-italic demibold-oblique))
+ :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.
fontset uses the font for ASCII character set.
If this function attempts to create already existing fontset, error is
-signaled unless the optional 3rd argument NOERROR is non-nil."
+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))
(let ((idx (match-end 0))
(name (match-string 0 fontset-spec))
- fontlist full-fontlist ascii-font charset)
+ fontlist full-fontlist ascii-font resolved-ascii-font charset)
(if (query-fontset name)
(or noerror
(error "Fontset \"%s\" already exists"))
(or (rassoc alias fontset-alias-alist)
(setq fontset-alias-alist
(cons (cons name alias) fontset-alias-alist)))))
- (let ((resolved-ascii-font (cdr (assq 'ascii full-fontlist))))
- (setq fontset-alias-alist
- (cons (cons name resolved-ascii-font)
- fontset-alias-alist))
- (or (equal ascii-font resolved-ascii-font)
- (setq fontset-alias-alist
- (cons (cons name ascii-font)
- fontset-alias-alist))))
+ (setq resolved-ascii-font (cdr (assq 'ascii full-fontlist)))
+ (setq fontset-alias-alist
+ (cons (cons name resolved-ascii-font)
+ fontset-alias-alist))
+ (or (equal ascii-font resolved-ascii-font)
+ (setq fontset-alias-alist
+ (cons (cons name ascii-font)
+ fontset-alias-alist)))
;; At last, handle style variants.
(if (eq style-variant t)
(when new-name
;; Modify ASCII font name for the style...
(setq new-ascii-font
- (or font (x-modify-font-name ascii-font style)))
+ (or font
+ (x-modify-font-name resolved-ascii-font style)))
;; but leave fonts for the other charsets unmodified
;; for the momemnt. They are modified for the style
;; in instantiate-fontset.
(setq fontset-alias-alist
(cons (cons new-name new-ascii-font)
fontset-alias-alist)))
- (setq style-variant (cdr style-variant)))))))))
+ (setq style-variant (cdr style-variant)))))))
+ 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.
+
+Style variants of the fontset is created too. Font names in the
+variants are generated automatially from FONT unless X resources
+XXX.attribyteFont 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)))
+ (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))))
+ (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 readly to use.