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

(print-fontset-element): Fix for the

Browse source 
format change of a fontset element for font-backend feature.
This commit is contained in:
Kenichi Handa 2007-06-20 11:30:15 +00:00
parent d0364d0982
commit 2b96faf776
1 changed files with 26 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

37
lisp/international/mule-diag.el
View file

@ -877,21 +877,36 @@ The font must be already used by Emacs."
(let ((requested (car elt)))
(if (stringp requested)
(insert "\n " requested)
(let ((family (aref requested 0))
(registry (aref requested 5)))
(let (family registry weight slant width adstyle)
(if (fontp requested)
(setq family (font-get requested :family)
registry (font-get requested :registry)
weight (font-get requested :weight)
slant (font-get requested :slant)
width (font-get requested :width)
adstyle (font-get requested :adstyle))
(setq family (aref requested 0)
registry (aref requested 5)
weight (aref requested 1)
slant (aref requested 2)
width (aref requested 3)
adstyle (aref requested 4)))
(if (not family)
(setq family "*-*")
(if (symbolp family)
(setq family (symbol-name family)))
(or (string-match "-" family)
(setq family (concat "*-" family))))
(or (string-match "-" registry)
(= (aref registry (1- (length registry))) ?*)
(setq registry (concat registry "*")))
(insert "\n -" family
?- (or (aref requested 1) ?*) ; weight
?- (or (aref requested 2) ?*) ; slant
?- (or (aref requested 3) ?*) ; width
?- (or (aref requested 4) ?*) ; adstyle
"-*-*-*-*-*-*-" registry))))
(if (not registry)
(setq registry "*-*")
(if (symbolp registry)
(setq registry (symbol-name registry)))
(or (string-match "-" registry)
(= (aref registry (1- (length registry))) ?*)
(setq registry (concat registry "*"))))
(insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
family (or weight "*") (or slant "*") (or width "*")
(or adstyle "*") registry)))))
;; Insert opened font names (if any).
(if (and (boundp 'print-opened) (symbol-value 'print-opened))