;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
-;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
-;; Copyright (C) 1995, 1997, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 2003
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
## CHARSET-SYMBOL-NAME,
## DIMENSION (1 or 2)
## CHARS (94 or 96)
-## WIDTH (occupied column numbers: 1 or 2),
-## DIRECTION (0:left-to-right, 1:right-to-left),
## ISO-FINAL-CHAR (character code of ISO-2022's final character)
-## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
+## -1 means that no final character is assigned.
## DESCRIPTION (describing string of the charset)
")
(let ((l charset-list)
charset)
(while l
(setq charset (car l) l (cdr l))
- (princ (format "%s:%d:%d:%d:%d:%s\n"
+ (princ (format "%s:%d:%d:%d:%s\n"
charset
(charset-dimension charset)
(charset-chars charset)
- (aref char-width-table (make-char charset))
+;;; (char-width (make-char charset))
;;; (charset-direction charset)
(charset-iso-final-char charset)
;;; (charset-iso-graphic-plane charset)
;;;###autoload
(defun describe-font (fontname)
- "Display information about fonts which partially match FONTNAME."
- (interactive "sFontname (default current choice for ASCII chars): ")
+ "Display information about a font whose name is FONTNAME.
+The font must be already used by Emacs."
+ (interactive "sFont name (default current choice for ASCII chars): ")
(or (and window-system (fboundp 'fontset-list))
- (error "No fontsets being used"))
- (when (or (not fontname) (= (length fontname) 0))
- (setq fontname (cdr (assq 'font (frame-parameters))))
- (if (query-fontset fontname)
- (setq fontname
- (nth 1 (assq 'ascii (aref (fontset-info fontname) 2))))))
- (let ((font-info (font-info fontname)))
+ (error "No fonts being used"))
+ (let (fontset font-info)
+ (when (or (not fontname) (= (length fontname) 0))
+ (setq fontname (frame-parameter nil 'font))
+ ;; Check if FONTNAME is a fontset.
+ (if (query-fontset fontname)
+ (setq fontset fontname
+ fontname (nth 1 (assq 'ascii
+ (aref (fontset-info fontname) 2))))))
+ (setq font-info (font-info fontname))
(if (null font-info)
- (message "No matching font")
+ (if fontset
+ ;; The font should be surely used. So, there's some
+ ;; problem about getting information about it. It is
+ ;; better to print the fontname to show which font has
+ ;; this problem.
+ (message "No information about \"%s\"" fontname)
+ (message "No matching font being used"))
(with-output-to-temp-buffer "*Help*"
(describe-font-internal font-info 'verbose)))))
(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 (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))))
- (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))
HCoop / bpt / emacs.git / blobdiff