cgit.sxemacs.org Git - packages/blob - mule-packages/mule-base/char-table.el

   1 ;;; char-table.el --- display table of charset
   2
   3 ;; Copyright (C) 1996,1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: char-table.el,v 1.1.1.1 1998-01-14 06:35:19 steve Exp $
   7 ;; Keywords: character, mule
   8
   9 ;; This file is part of tl (Tiny Library).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (defsubst char-position-to-string (charset r l &optional plane)
  29   (char-to-string
  30    (if plane
  31        (make-char charset plane (+ (* r 16) l))
  32      (make-char charset (+ (* r 16) l))
  33      )))
  34
  35 (defsubst char-table-1 (charset r l plane)
  36   (let* ((str (char-position-to-string charset r l plane))
  37          (lp (- 3 (string-width str)))
  38          (rp (/ lp 2)))
  39     (setq lp
  40           (if (= (mod lp 2) 0)
  41               rp
  42             (1+ rp)))
  43     (concat (make-string lp ? ) str (make-string rp ? ))
  44     ))
  45
  46 (defun insert-94-charset-table (charset &optional plane ofs)
  47   (if (null ofs)
  48       (setq ofs 0)
  49     )
  50   (insert (format
  51           "[%02x]\e$B("\e(B 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
  52           (or plane 0)))
  53   (insert "\e$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!\e(B\n")
  54   (let ((j 2))
  55     (insert (format "%02x%x\e$B("\e(B   " (or plane 0) (* (+ j ofs) 16)))
  56     (let ((k 1))
  57       (while (< k 16)
  58         (insert (char-table-1 charset j k plane))
  59         (setq k (+ k 1))
  60         )
  61       (insert "\n")
  62       )
  63     (setq j 3)
  64     (while (< j 7)
  65       (insert (format "%02x%x\e$B("\e(B" (or plane 0) (* (+ j ofs) 16)))
  66       (let ((k 0))
  67         (while (< k 16)
  68           (insert (char-table-1 charset j k plane))
  69           (setq k (+ k 1))
  70           )
  71         (insert "\n")
  72         )
  73       (setq j (+ j 1))
  74       )
  75     (insert (format "%02x%x\e$B("\e(B" (or plane 0) (* (+ j ofs) 16)))
  76     (let ((k 0))
  77       (while (< k 15)
  78         (insert (char-table-1 charset j k plane))
  79         (setq k (+ k 1))
  80         )
  81       (insert "\n")
  82       )
  83     ))
  84
  85 (defun insert-96-charset-table (charset &optional plane ofs)
  86   (if (null ofs)
  87       (setq ofs 0)
  88     )
  89   (insert (format
  90           "[%02x]\e$B("\e(B 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
  91           (or plane 0)))
  92   (insert "\e$B(!(!(+(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!(!\e(B\n")
  93   (let ((j 2))
  94     (while (< j 8)
  95       (insert (format "%02x%x\e$B("\e(B" (or plane 0) (* (+ j ofs) 16)))
  96       (let ((k 0))
  97         (while (< k 16)
  98           (insert (char-table-1 charset j k plane))
  99           (setq k (+ k 1))
 100           )
 101         (insert "\n")
 102         )
 103       (setq j (1+ j))
 104       )))
 105
 106 (defun insert-94x94-charset-table (charset)
 107   (insert-94-charset-table charset 33)
 108   (let ((i 34))
 109     (while (< i 127)
 110       (insert "\e$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,\e(B\n")
 111       (insert-94-charset-table charset i)
 112       (setq i (1+ i))
 113       )))
 114
 115 (defun insert-96x96-charset-table (charset)
 116   (insert-96-charset-table charset 32)
 117   (let ((i 33))
 118     (while (< i 128)
 119       (insert "\e$B(,(,(;(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,\e(B\n")
 120       (insert-96-charset-table charset i)
 121       (setq i (1+ i))
 122       )))
 123
 124 (defun insert-charset-table (charset)
 125   "Insert character table of CHARSET."
 126   (insert "\e$B(,(,(8(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,\e(B\n")
 127   (let ((cc (charset-chars charset))
 128         (cd (charset-dimension charset))
 129         )
 130     (cond ((= cd 1)
 131            (cond ((= cc 94)
 132                   (insert-94-charset-table charset)
 133                   )
 134                  ((= cc 96)
 135                   (insert-96-charset-table charset)
 136                   ))
 137            )
 138           ((= cd 2)
 139            (cond ((= cc 94)
 140                   (insert-94x94-charset-table charset)
 141                   )
 142                  ((= cc 96)
 143                   (insert-96x96-charset-table charset)
 144                   ))
 145            )))
 146   (insert "\e$B(,(,(:(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,(,\e(B\n")
 147   )
 148
 149 ;;;###autoload
 150 (defun view-charset (charset)
 151   "Display character table of CHARSET."
 152   (interactive
 153    (list
 154     (let ((charset-alist
 155            (mapcar (function
 156                     (lambda (charset)
 157                       (cons (charset-doc-string charset) charset)
 158                       ))
 159                    (charset-list))))
 160       (cdr (assoc (completing-read "What charset: "
 161                                    charset-alist nil t nil)
 162                   charset-alist))
 163       )))
 164   (let* ((desc (charset-doc-string charset))
 165          (buf (concat "*Charset table for "
 166                       (charset-doc-string charset)
 167                       "*")))
 168     (unless (get-buffer buf)
 169       (let ((the-buf (current-buffer)))
 170         (set-buffer (get-buffer-create buf))
 171         (insert (format "%s (%s)\n" desc charset))
 172         (let ((msg (format "Generating char table for %s..." desc)))
 173           (message msg)
 174           (insert-charset-table charset)
 175           (message "%s Done." msg)
 176           )
 177         (set-buffer-modified-p nil)
 178         (goto-char (point-min))
 179         (set-buffer the-buf)
 180         ))
 181     (view-buffer buf)
 182     ))
 183
 184
 185 ;;; @ end
 186 ;;;
 187
 188 (provide 'char-table)
 189
 190 ;;; char-table.el ends here