From e94848ea6e02a78612eaf1dfe617a30651c89ad0 Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Mon, 4 Feb 2008 12:19:50 +0000 Subject: (print-fontset-element): Handle the case of inhibitting the fallback fonts. --- lisp/ChangeLog | 5 +++ lisp/international/mule-diag.el | 78 +++++++++++++++++++++-------------------- 2 files changed, 45 insertions(+), 38 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 60573c74d0..0dd1faa81d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2008-02-04 Kenichi Handa + + * international/mule-diag.el (print-fontset-element): Handle the + case of inhibitting the fallback fonts. + 2008-02-04 Kim F. Storm * ido.el (ido-magic-forward-char, ido-magic-backward-char) 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. -- cgit v1.2.3