Mercurial > hg > xemacs-beta

comparison lisp/tl/char-table.el @ 86:364816949b59 r20-0b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b93
author cvs
date Mon, 13 Aug 2007 09:09:02 +0200
parents
children 0d2f883870bc
comparison
equal deleted inserted replaced
85:c661705957e0 86:364816949b59
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 1997/01/30 02:27:29 steve Exp $
7 ;; Keywords: character, Emacs/mule
8
9 ;; This file is not 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 (require 'char-util)
29
30 (defun char-position-to-string (charset r l &optional plane)
31 (char-to-string
32 (if plane
33 (make-character charset plane (row-line-to-char r l))
34 (make-character charset (row-line-to-char r l))
35 )))
36
37 (defun char-table-1 (charset r l plane)
38 (let ((str (char-position-to-string charset r l plane)))
39 (concat
40 (let ((i 0)
41 (len (- 3 (string-columns str)))
42 (dest ""))
43 (while (< i len)
44 (setq dest (concat dest " "))
45 (setq i (1+ i))
46 )
47 dest) str)))
48
49 (defun show-94-table (charset &optional plane ofs)
50 (if (null ofs)
51 (setq ofs 0)
52 )
53 (princ "======================================================\n")
54 (princ (format
55 "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
56 (or plane 0)))
57 (princ "-----+------------------------------------------------\n")
58 (let ((j 2))
59 (princ (format "%2x%x : " (or plane 0) (* (+ j ofs) 16)))
60 (let ((k 1))
61 (while (< k 16)
62 (princ (char-table-1 charset j k plane))
63 (setq k (+ k 1))
64 )
65 (princ "\n")
66 )
67 (setq j 3)
68 (while (< j 7)
69 (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16)))
70 (let ((k 0))
71 (while (< k 16)
72 (princ (char-table-1 charset j k plane))
73 (setq k (+ k 1))
74 )
75 (princ "\n")
76 )
77 (setq j (+ j 1))
78 )
79 (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16)))
80 (let ((k 0))
81 (while (< k 15)
82 (princ (char-table-1 charset j k plane))
83 (setq k (+ k 1))
84 )
85 (princ "\n")
86 )
87 ))
88
89 (defun show-96-table (charset &optional plane ofs)
90 (if (null ofs)
91 (setq ofs 0)
92 )
93 (princ "======================================================\n")
94 (princ (format
95 "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n"
96 (or plane 0)))
97 (princ "-----+------------------------------------------------\n")
98 (let ((j 2))
99 (while (< j 8)
100 (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16)))
101 (let ((k 0))
102 (while (< k 16)
103 (princ (char-table-1 charset j k plane))
104 (setq k (+ k 1))
105 )
106 (princ "\n")
107 )
108 (setq j (1+ j))
109 )))
110
111 (defun show-94x94-table (charset)
112 (let ((i 33))
113 (while (< i 127)
114 (show-94-table charset i)
115 (setq i (1+ i))
116 )))
117
118 (defun show-96x96-table (charset)
119 (let ((i 32))
120 (while (< i 128)
121 (show-96-table charset i)
122 (setq i (1+ i))
123 )))
124
125 (defun show-char-table (charset)
126 (let ((cc (charset-chars charset))
127 (cd (charset-dimension charset))
128 )
129 (cond ((= cd 1)
130 (cond ((= cc 94)
131 (show-94-table charset)
132 )
133 ((= cc 96)
134 (show-96-table charset)
135 ))
136 )
137 ((= cd 2)
138 (cond ((= cc 94)
139 (show-94x94-table charset)
140 )
141 ((= cc 96)
142 (show-96x96-table charset)
143 ))
144 ))))
145
146
147 ;;; @ end
148 ;;;
149
150 (provide 'char-table)
151
152 ;;; char-table.el ends here