aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/international/mule-diag.el
diff options
context:
space:
mode:
authorKenichi Handa <[email protected]>2008-02-04 12:19:50 +0000
committerKenichi Handa <[email protected]>2008-02-04 12:19:50 +0000
commite94848ea6e02a78612eaf1dfe617a30651c89ad0 (patch)
tree7c8d37da02a73d11e6a98786a91ac43cf7c9d92b /lisp/international/mule-diag.el
parent3d4448a85bd57bf1c5afcf546e1a2a1cae1b4c1f (diff)
(print-fontset-element): Handle the
case of inhibitting the fallback fonts.
Diffstat (limited to 'lisp/international/mule-diag.el')
-rw-r--r--lisp/international/mule-diag.el78
1 files changed, 40 insertions, 38 deletions
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 844b9236cd..68945984b1 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -876,44 +876,46 @@ The font must be already used by Emacs."
;; Insert a requested font name.
(dolist (elt val)
- (let ((requested (car elt)))
- (if (stringp requested)
- (insert "\n " requested)
- (let (family registry weight slant width adstyle)
- (if (and (fboundp 'fontp) (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))))
- (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))
- (dolist (opened (cdr elt))
- (insert "\n\t[" opened "]"))))))
+ (if (not elt)
+ (insert "\n -- inhibit fallback fonts --")
+ (let ((requested (car elt)))
+ (if (stringp requested)
+ (insert "\n " requested)
+ (let (family registry weight slant width adstyle)
+ (if (and (fboundp 'fontp) (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))))
+ (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))
+ (dolist (opened (cdr elt))
+ (insert "\n\t[" opened "]")))))))
(defun print-fontset (fontset &optional print-opened)
"Print information about FONTSET.