From: Kenichi Handa <handa@m17n.org>
Date: Fri, 10 Jan 2003 07:25:31 +0000 (+0000)
Subject: (print-fontset-element): New
X-Git-Tag: emacs-pretest-23.0.90~8295^2~1864^2~111
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5c117135d1746aa558c68da3eb55ca650c29afd3;p=emacs.git

(print-fontset-element): New
function.
(print-fontset): Use print-fontset-element to print the elements
of a fontset.  Use it also to print fonts fallen back to the
default fontsets.
---

diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index a128b28bad7..10332ed7810 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -971,62 +971,66 @@ but still contains full information about each coding system."
       (with-output-to-temp-buffer "*Help*"
 	(describe-font-internal font-info 'verbose)))))
 
-(defun print-fontset (fontset &optional print-fonts)
+(defun print-fontset-element (val)
+  ;; VAL has this format:
+  ;;  ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
+  ;; CHAR RANGE is already inserted.  Get character codes from
+  ;; the current line.
+  (beginning-of-line)
+  (let ((from (following-char))
+	(to (if (looking-at "[^.]*[.]* ")
+		(char-after (match-end 0)))))
+    (if (re-search-forward "[ \t]*$" nil t)
+	(delete-region (match-beginning 0) (match-end 0)))
+
+    ;; For non-ASCII characters, insert also CODE RANGE.
+    (if (or (>= from 128) (and to (>= to 128)))
+	(if to
+	    (insert (format " (#x%02X .. #x%02X)" from to))
+	  (insert (format " (#x%02X)" from))))
+
+    ;; Insert a requested font name.
+    (dolist (elt val)
+      (let ((requested (car elt)))
+	(if (stringp requested)
+	    (insert "\n    " requested)
+	  (let ((family (aref requested 0))
+		(registry (aref requested 5)))
+	    (if (not family)
+		(setq 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))))
+
+      ;; 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.
-If optional arg PRINT-FONTS is non-nil, also print names of all opened
+If optional arg PRINT-OPENED is non-nil, also print names of all opened
 fonts for FONTSET.  This function actually inserts the information in
 the current buffer."
   (beginning-of-line)
   (insert "Fontset: " fontset "\n")
-  (insert "CHAR RANGE (CODE RANGE)\n")
-  (insert "-----------------------\n")
-  (insert "    FONT NAME (REQUESTED and [OPENED])\n")
-  (insert "    ----------------------------------")
-  (describe-vector
-   (fontset-info fontset)
-   #'(lambda (val)
-       ;; VAL has this format:
-       ;;  ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
-
-       ;; CHAR RANGE is already inserted.  Get character codes from
-       ;; the current line.
-       (beginning-of-line)
-       (let ((from (following-char))
-	     (to (if (looking-at "[^.]*[.]* ")
-		     (char-after (match-end 0)))))
-	 (if (re-search-forward "[ \t]*$" nil t)
-	     (delete-region (match-beginning 0) (match-end 0)))
-
-	 ;; For non-ASCII characters, insert also CODE RANGE.
-	 (if (>= from 128)
-	     (if to
-		 (insert (format "\t(#x%02X .. #x%02X)" from to))
-	       (insert (format "\t(#x%02X)" from))))
-
-	 ;; Insert a requested font name.
-	 (dolist (elt val)
-	   (let ((requested (car elt)))
-	     (if (stringp requested)
-		 (insert "\n    " requested)
-	       (let ((family (aref requested 0))
-		     (registry (aref requested 5)))
-		 (if (not family)
-		     (setq 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))))
-
-	   ;; Insert opened font names (if any).
-	   (dolist (opened (cdr elt))
-	     (insert "\n\t[" opened "]")))))))
+  (insert (propertize "CHAR RANGE" 'face 'underline)
+	   " (" (propertize "CODE RANGE" 'face 'underline) ")\n")
+  (insert "    " (propertize "FONT NAME" 'face 'underline)
+	  " (" (propertize "REQUESTED" 'face 'underline)
+	  " and [" (propertize "OPENED" 'face 'underline) "])")
+  (let ((info (fontset-info fontset)))
+    (describe-vector info 'print-fontset-element)
+    (insert "\n  ---<fallback to the default fontset>---")
+    (describe-vector (char-table-extra-slot info 0) 'print-fontset-element)))
 
 ;;;###autoload
 (defun describe-fontset (fontset)