--- a/lisp/tl/char-table.el	Mon Aug 13 09:44:44 2007 +0200
+++ b/lisp/tl/char-table.el	Mon Aug 13 09:45:46 2007 +0200
@@ -3,10 +3,10 @@
 ;; Copyright (C) 1996,1997 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: char-table.el,v 1.2 1997/02/15 22:21:24 steve Exp $
-;; Keywords: character, Emacs/mule
+;; Version: $Id: char-table.el,v 1.3 1997/06/29 23:13:25 steve Exp $
+;; Keywords: character, mule
 
-;; This file is not part of tl (Tiny Library).
+;; This file is part of tl (Tiny Library).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -25,121 +25,161 @@
 
 ;;; Code:
 
-(defun char-position-to-string (charset r l &optional plane)
+(defsubst char-position-to-string (charset r l &optional plane)
   (char-to-string
    (if plane
        (make-char charset plane (+ (* r 16) l))
      (make-char charset (+ (* r 16) l))
      )))
 
-(defun char-table-1 (charset r l plane)
-  (let ((str (char-position-to-string charset r l plane)))
-    (concat
-     (let ((i 0)
-	   (len (- 3 (string-columns str)))
-	   (dest ""))
-       (while (< i len)
-	 (setq dest (concat dest " "))
-	 (setq i (1+ i))
-	 )
-       dest) str)))
+(defsubst char-table-1 (charset r l plane)
+  (let* ((str (char-position-to-string charset r l plane))
+	 (lp (- 3 (string-width str)))
+	 (rp (/ lp 2)))
+    (setq lp
+	  (if (= (mod lp 2) 0)
+	      rp
+	    (1+ rp)))
+    (concat (make-string lp ? ) str (make-string rp ? ))
+    ))
 
-(defun show-94-table (charset &optional plane ofs)
+(defun insert-94-charset-table (charset &optional plane ofs)
   (if (null ofs)
       (setq ofs 0)
     )
-  (princ "======================================================\n")
-  (princ (format
-	  "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
+  (insert (format
+	  "[%02x]$B("(B 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
 	  (or plane 0)))
-  (princ "-----+------------------------------------------------\n")
+  (insert "$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(B\n")
   (let ((j 2))
-    (princ (format "%2x%x :   " (or plane 0) (* (+ j ofs) 16)))
+    (insert (format "%02x%x$B("(B   " (or plane 0) (* (+ j ofs) 16)))
     (let ((k 1))
       (while (< k 16)
-	(princ (char-table-1 charset j k plane))
+	(insert (char-table-1 charset j k plane))
 	(setq k (+ k 1))
 	)
-      (princ "\n")
+      (insert "\n")
       )
     (setq j 3)
     (while (< j 7)
-      (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16)))
+      (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
       (let ((k 0))
 	(while (< k 16)
-	  (princ (char-table-1 charset j k plane))
+	  (insert (char-table-1 charset j k plane))
 	  (setq k (+ k 1))
 	  )
-	(princ "\n")
+	(insert "\n")
 	)
       (setq j (+ j 1))
       )
-    (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16)))
+    (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
     (let ((k 0))
       (while (< k 15)
-	(princ (char-table-1 charset j k plane))
+	(insert (char-table-1 charset j k plane))
 	(setq k (+ k 1))
 	)
-      (princ "\n")
+      (insert "\n")
       )
     ))
 
-(defun show-96-table (charset &optional plane ofs)
+(defun insert-96-charset-table (charset &optional plane ofs)
   (if (null ofs)
       (setq ofs 0)
     )
-  (princ "======================================================\n")
-  (princ (format
-	  "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
+  (insert (format
+	  "[%02x]$B("(B 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
 	  (or plane 0)))
-  (princ "-----+------------------------------------------------\n")
+  (insert "$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(B\n")
   (let ((j 2))
     (while (< j 8)
-      (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16)))
+      (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
       (let ((k 0))
 	(while (< k 16)
-	  (princ (char-table-1 charset j k plane))
+	  (insert (char-table-1 charset j k plane))
 	  (setq k (+ k 1))
 	  )
-	(princ "\n")
+	(insert "\n")
 	)
       (setq j (1+ j))
       )))
 
-(defun show-94x94-table (charset)
-  (let ((i 33))
+(defun insert-94x94-charset-table (charset)
+  (insert-94-charset-table charset 33)
+  (let ((i 34))
     (while (< i 127)
-      (show-94-table charset i)
+      (insert "$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
+      (insert-94-charset-table charset i)
       (setq i (1+ i))
       )))
 
-(defun show-96x96-table (charset)
-  (let ((i 32))
+(defun insert-96x96-charset-table (charset)
+  (insert-96-charset-table charset 32)
+  (let ((i 33))
     (while (< i 128)
-      (show-96-table charset i)
+      (insert "$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
+      (insert-96-charset-table charset i)
       (setq i (1+ i))
       )))
 
-(defun show-char-table (charset)
+(defun insert-charset-table (charset)
+  "Insert character table of CHARSET."
+  (insert "$B(,(,(8(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
   (let ((cc (charset-chars charset))
 	(cd (charset-dimension charset))
 	)
     (cond ((= cd 1)
 	   (cond ((= cc 94)
-		  (show-94-table charset)
+		  (insert-94-charset-table charset)
 		  )
 		 ((= cc 96)
-		  (show-96-table charset)
+		  (insert-96-charset-table charset)
 		  ))
 	   )
 	  ((= cd 2)
 	   (cond ((= cc 94)
-		  (show-94x94-table charset)
+		  (insert-94x94-charset-table charset)
 		  )
 		 ((= cc 96)
-		  (show-96x96-table charset)
+		  (insert-96x96-charset-table charset)
 		  ))
-	   ))))
+	   )))
+  (insert "$B(,(,(:(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
+  )
+
+;;;###autoload
+(defun view-charset (charset)
+  "Display character table of CHARSET."
+  (interactive
+   (list
+    (let ((charset-alist
+	   (mapcar (function
+		    (lambda (charset)
+		      (cons (charset-doc-string charset) charset)
+		      ))
+		   (charset-list))))
+      (cdr (assoc (completing-read "What charset: "
+				   charset-alist nil t nil)
+		  charset-alist))
+      )))
+  (let* ((desc (charset-doc-string charset))
+	 (buf (concat "*Charset table for "
+		      (charset-doc-string charset)
+		      "*")))
+    (unless (get-buffer buf)
+      (let ((the-buf (current-buffer)))
+	(set-buffer (get-buffer-create buf))
+	(insert (format "%s (%s)\n" desc charset))
+	(let ((msg (format "Generating char table for %s..." desc)))
+	  (message msg)
+	  (insert-charset-table charset)
+	  (message "%s Done." msg)
+	  )
+	(set-buffer-modified-p nil)
+	(goto-char (point-min))
+	(set-buffer the-buf)
+	))
+    (view-buffer buf)
+    ))
 
 
 ;;; @ end