mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-02 08:22:22 +00:00
Code Issues Releases Activity

(print-fontset-element): Handle the

Browse Source 
case of inhibitting the fallback fonts.
This commit is contained in:
Kenichi Handa 2008-02-04 12:19:50 +00:00
parent 3d4448a85b
commit e94848ea6e
2 changed files with 44 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lisp/ChangeLog
View File

@ -1,3 +1,8 @@
2008-02-04 Kenichi Handa <handa@ni.aist.go.jp>
* international/mule-diag.el (print-fontset-element): Handle the
case of inhibitting the fallback fonts.
2008-02-04 Kim F. Storm <storm@cua.dk>
* ido.el (ido-magic-forward-char, ido-magic-backward-char)

76
lisp/international/mule-diag.el
View File

@ -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)))))
(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 "]"))))))
;; 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.