diff options
author | Kenichi Handa <[email protected]> | 2008-02-04 12:19:50 +0000 |
---|---|---|
committer | Kenichi Handa <[email protected]> | 2008-02-04 12:19:50 +0000 |
commit | e94848ea6e02a78612eaf1dfe617a30651c89ad0 (patch) | |
tree | 7c8d37da02a73d11e6a98786a91ac43cf7c9d92b /lisp/international/mule-diag.el | |
parent | 3d4448a85bd57bf1c5afcf546e1a2a1cae1b4c1f (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.el | 78 |
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. |