mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-03-02 11:50:48 -08:00
Code Issues Projects Releases Wiki Activity

(x-complement-fontset-spec): Use

Browse source 
font-spec.
This commit is contained in:
Kenichi Handa 2007-12-03 13:42:35 +00:00
parent 794eba0f36
commit 9841dbc9ac
1 changed files with 52 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

77
lisp/international/fontset.el
View file

@ -229,17 +229,17 @@
;; fontset to find an appropriate font for each script/charset. The
;; specification has the form ((SCRIPT FONT-SPEC ...) ...), where
;; FONT-SPEC is:
;; a vector [ FAMILY WEIGHT SLANT ADSTYLE REGISTRY ],
;; or a cons (FAMILY . REGISTRY),
;; or a string FONT-NAME.
;; a cons (FAMILY . REGISTRY),
;; or a string FONT-NAME,
;; or an object created by `font-spec'.
;;
;; FAMILY, WEIGHT, SLANT, and ADSTYLE may be nil, in which case, the
;; the corresponding 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.
;; FAMILY may be nil, in which case, the the corresponding 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.
;;
;; SCRIPT is a symbol that appears as an element of the char table
;; `char-script-table'. SCRIPT may be a charset specifying the range
@ -638,26 +638,53 @@ The font names are complemented as below.
If a font name matches `xlfd-style-regexp', each field of wild card is
replaced by the corresponding fields in XLFD-FIELDS."
(let ((default-spec (vector (aref xlfd-fields xlfd-regexp-family-subnum)
(aref xlfd-fields xlfd-regexp-weight-subnum)
(aref xlfd-fields xlfd-regexp-slant-subnum)
(aref xlfd-fields xlfd-regexp-swidth-subnum)
(aref xlfd-fields xlfd-regexp-adstyle-subnum)
(aref xlfd-fields xlfd-regexp-registry-subnum))))
(let ((family (aref xlfd-fields xlfd-regexp-family-subnum))
(weight (aref xlfd-fields xlfd-regexp-weight-subnum))
(slant (aref xlfd-fields xlfd-regexp-slant-subnum))
(width (aref xlfd-fields xlfd-regexp-swidth-subnum))
(adstyle (aref xlfd-fields xlfd-regexp-adstyle-subnum))
(registry (aref xlfd-fields xlfd-regexp-registry-subnum)))
(if weight (setq weight (intern weight)))
(if slant (setq slant (intern slant)))
(if width (setq width (intern width)))
(if adstyle (setq adstyle (intern adstyle)))
(dolist (elt fontlist)
(let ((name (cadr elt))
font-spec)
args)
(when (or (string-match xlfd-style-regexp name)
(and (setq name (car (x-list-fonts name nil nil 1)))
(string-match xlfd-style-regexp name)))
(setq font-spec (make-vector 6 nil))
(dotimes (i 6)
(aset font-spec i (match-string (1+ i) name)))
(dotimes (i 5)
(if (string-match "^[*-]+$" (aref font-spec i))
(aset font-spec i (aref default-spec i))))
(setcar (cdr elt) font-spec))))
(let ((fam (match-string (1+ xlfd-regexp-family-subnum) name))
(wei (match-string (1+ xlfd-regexp-weight-subnum) name))
(sla (match-string (1+ xlfd-regexp-slant-subnum) name))
(wid (match-string (1+ xlfd-regexp-swidth-subnum) name))
(ads (match-string (1+ xlfd-regexp-adstyle-subnum) name))
(reg (match-string (1+ xlfd-regexp-registry-subnum) name)))
(if (or (and fam (setq fam (if (not (string-match "^[*?]*$" fam))
fam)))
family)
(setq args (list :family (or fam family))))
(if (or (and wei (setq wei (if (not (string-match "^[*?]*$" wei))
(intern wei))))
weight)
(setq args (cons :weight (cons (or wei weight) args))))
(if (or (and sla (setq sla (if (not (string-match "^[*?]*$" sla))
(intern sla))))
slant)
(setq args (cons :slant (cons (or sla slant) args))))
(if (or (and wid (setq wid (if (not (string-match "^[*?]*$" wid))
(intern wid))))
width)
(setq args (cons :width (cons (or wid width) args))))
(if (or (and ads (setq ads (if (not (string-match "^[*?]*$" ads))
(intern ads))))
adstyle)
(setq args (cons :adstyle (cons (or ads adstyle) args))))
(if (or (and reg (setq reg (if (not (string-match "^[*?]*$" reg))
reg)))
registry)
(setq args (cons :registry (cons (or reg registry) args))))
(setcar (cdr elt) (apply 'font-spec args))))))
fontlist))
(defun fontset-name-p (fontset)