--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mule/char-table.el	Mon Aug 13 10:09:35 2007 +0200
@@ -0,0 +1,190 @@
+;;; char-table.el --- display table of charset
+
+;; Copyright (C) 1996,1997 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version: $Id: char-table.el,v 1.1 1997/11/29 18:44:03 steve Exp $
+;; Keywords: character, mule
+
+;; 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
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(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))
+     )))
+
+(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 insert-94-charset-table (charset &optional plane ofs)
+  (if (null ofs)
+      (setq ofs 0)
+    )
+  (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)))
+  (insert "$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(B\n")
+  (let ((j 2))
+    (insert (format "%02x%x$B("(B   " (or plane 0) (* (+ j ofs) 16)))
+    (let ((k 1))
+      (while (< k 16)
+	(insert (char-table-1 charset j k plane))
+	(setq k (+ k 1))
+	)
+      (insert "\n")
+      )
+    (setq j 3)
+    (while (< j 7)
+      (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
+      (let ((k 0))
+	(while (< k 16)
+	  (insert (char-table-1 charset j k plane))
+	  (setq k (+ k 1))
+	  )
+	(insert "\n")
+	)
+      (setq j (+ j 1))
+      )
+    (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
+    (let ((k 0))
+      (while (< k 15)
+	(insert (char-table-1 charset j k plane))
+	(setq k (+ k 1))
+	)
+      (insert "\n")
+      )
+    ))
+
+(defun insert-96-charset-table (charset &optional plane ofs)
+  (if (null ofs)
+      (setq ofs 0)
+    )
+  (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)))
+  (insert "$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(B\n")
+  (let ((j 2))
+    (while (< j 8)
+      (insert (format "%02x%x$B("(B" (or plane 0) (* (+ j ofs) 16)))
+      (let ((k 0))
+	(while (< k 16)
+	  (insert (char-table-1 charset j k plane))
+	  (setq k (+ k 1))
+	  )
+	(insert "\n")
+	)
+      (setq j (1+ j))
+      )))
+
+(defun insert-94x94-charset-table (charset)
+  (insert-94-charset-table charset 33)
+  (let ((i 34))
+    (while (< i 127)
+      (insert "$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
+      (insert-94-charset-table charset i)
+      (setq i (1+ i))
+      )))
+
+(defun insert-96x96-charset-table (charset)
+  (insert-96-charset-table charset 32)
+  (let ((i 33))
+    (while (< i 128)
+      (insert "$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(B\n")
+      (insert-96-charset-table charset i)
+      (setq i (1+ i))
+      )))
+
+(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)
+		  (insert-94-charset-table charset)
+		  )
+		 ((= cc 96)
+		  (insert-96-charset-table charset)
+		  ))
+	   )
+	  ((= cd 2)
+	   (cond ((= cc 94)
+		  (insert-94x94-charset-table charset)
+		  )
+		 ((= cc 96)
+		  (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
+;;;
+
+(provide 'char-table)
+
+;;; char-table.el ends here