219
|
1 ;;; skk-kcode.el --- $B4A;z%3!<%I$r;H$C$?JQ49$N$?$a$N%W%m%0%i%`(B
|
|
2 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997
|
|
3 ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
|
|
4
|
|
5 ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
|
|
6 ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
|
|
7 ;; Version: $Id: skk-kcode.el,v 1.1 1997/12/02 08:48:38 steve Exp $
|
|
8 ;; Keywords: japanese
|
|
9 ;; Last Modified: $Date: 1997/12/02 08:48:38 $
|
|
10
|
|
11 ;; This program is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation; either versions 2, or (at your option)
|
|
14 ;; any later version.
|
|
15
|
|
16 ;; This program is distributed in the hope that it will be useful
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
22 ;; along with SKK, see the file COPYING. If not, write to the Free
|
|
23 ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
|
|
24 ;; MA 02111-1307, USA.
|
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;; Following people contributed modifications to skk.el (Alphabetical order):
|
|
29 ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
|
|
30
|
|
31 ;;; Code:
|
|
32 (require 'skk-foreword)
|
|
33 (require 'skk-vars)
|
|
34
|
|
35 (defvar skk-input-by-code-menu-keys1 '(?a ?s ?d ?f ?g ?h ?q ?w ?e ?r ?t ?y)
|
|
36 "*$B%a%K%e!<7A<0$G(B JIS $BJ8;z$rF~NO$9$k$H$-$K;HMQ$9$kA*Br%-!<$N%j%9%H!#(B
|
|
37 $BBh(B 1 $BCJ3,$N%a%K%e!<$G;HMQ$9$k!#(B
|
|
38 12 $B8D$N%-!<(B (char type) $B$r4^$`I,MW$,$"$k!#(B")
|
|
39
|
|
40 (defvar skk-input-by-code-menu-keys2
|
|
41 '(?a ?s ?d ?f ?g ?h ?j ?k ?l ?q ?w ?e ?r ?t ?y ?u)
|
|
42 "*$B%a%K%e!<7A<0$G(B JIS $BJ8;z$rF~NO$9$k$H$-$K;HMQ$9$kA*Br%-!<$N%j%9%H!#(B
|
|
43 $BBh(B 2 $BCJ3,$N%a%K%e!<$G;HMQ$9$k!#(B
|
|
44 16 $B8D$N%-!<(B (char type) $B$r4^$`I,MW$,$"$k!#(B")
|
|
45
|
|
46 (defvar skk-kcode-load-hook nil
|
|
47 "*skk-kcode.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
|
|
48
|
|
49 ;; variables for the function skk-input-by-code-or-menu
|
|
50 (defconst skk-code-n1-min 161)
|
|
51 (defconst skk-code-n1-max 244)
|
|
52 (defconst skk-code-n2-min 161)
|
|
53 (defconst skk-code-n2-max 254)
|
|
54 (defconst skk-code-null 128)
|
|
55 (defvar skk-input-by-code-or-menu-jump-default skk-code-n1-min)
|
|
56 (skk-deflocalvar skk-kcode-charset
|
|
57 (if (or skk-mule3 skk-xemacs)
|
|
58 'japanese-jisx0208
|
|
59 lc-jp)
|
|
60 "skk-input-by-code-or-menu $B$G;H$o$l$kJ8;z%;%C%H!#(B" )
|
|
61 (defconst skk-kcode-definded-charsets
|
|
62 (if (or skk-mule3 skk-xemacs)
|
|
63 (mapcar '(lambda (x) (list (symbol-name x))) (charset-list))
|
|
64 nil ))
|
|
65
|
|
66 ;;;###skk-autoload
|
|
67 (defun skk-input-by-code-or-menu (&optional arg)
|
|
68 "7bit $B$b$7$/$O(B 8bit $B$b$7$/$O(B $B6hE@%3!<%I$KBP1~$9$k(B 2byte $BJ8;z$rA^F~$9$k!#(B"
|
|
69 ;; The function skk-input-by-code-or-menu, which was used until version
|
|
70 ;; 4.20, is now replaced by this new function.
|
|
71 (interactive "*P")
|
|
72 (if arg
|
|
73 (let ((charset
|
|
74 (intern (completing-read (format "CHARSET(%s): " skk-kcode-charset)
|
|
75 skk-kcode-definded-charsets nil t ))))
|
|
76 (cond ((null charset))
|
|
77 ((not (skk-charsetp charset))
|
|
78 (error "invalid charset"))
|
|
79 (t (setq skk-kcode-charset charset)) )))
|
|
80 (let ((str
|
|
81 (read-string
|
|
82 (format
|
|
83 "7/8 bits or KUTEN code for %s (00nn or CR for Jump Menu): "
|
|
84 skk-kcode-charset )))
|
|
85 (enable-recursive-mini-buffer t)
|
|
86 n1 n2 )
|
|
87 (if (string-match "\\(.+\\)-\\(.+\\)" str)
|
|
88 (setq n1 (+ (string-to-number (match-string 1 str)) 32 128)
|
|
89 n2 (+ (string-to-number (match-string 2 str)) 32 128) )
|
|
90 (setq n1 (if (string= str "") 128
|
|
91 (+ (* 16 (skk-jis-char-to-hex (aref str 0)))
|
|
92 (skk-char-to-hex (aref str 1)) ))
|
|
93 n2 (if (string= str "") 128
|
|
94 (+ (* 16 (skk-jis-char-to-hex (aref str 2)))
|
|
95 (skk-char-to-hex (aref str 3)) ))))
|
|
96 (insert (if (> n1 160)
|
|
97 (skk-make-string n1 n2)
|
|
98 (skk-input-by-code-or-menu-0 n1 n2) ))
|
|
99 (if skk-henkan-active (skk-kakutei)) ))
|
|
100
|
|
101 (defun skk-char-to-hex (char)
|
|
102 (cond ((> char 96) (- char 87)) ; a-f
|
|
103 ((> char 64) (- char 55)) ; A-F
|
|
104 ((> char 47) (- char 48)) ; 0-9
|
|
105 (t
|
|
106 ;; $BJ*8@$o$L%(%i!<$ONI$/$J$$$,(B...$B!#(B
|
|
107 (error "") )))
|
|
108
|
|
109 (defun skk-jis-char-to-hex (char)
|
|
110 (cond ((> char 96) (- char 87)) ; a-f
|
|
111 ((> char 64) (- char 55)) ; A-F
|
|
112 ((> char 47) (- char 40)) ; 0-9
|
|
113 (t
|
|
114 ;; $BJ*8@$o$L%(%i!<$ONI$/$J$$$,(B...$B!#(B
|
|
115 (error "") )))
|
|
116
|
|
117 (defun skk-make-string (n1 n2)
|
|
118 (char-to-string (skk-make-char skk-kcode-charset n1 n2)) )
|
|
119
|
|
120 (defun skk-next-n2-code (n)
|
|
121 (if (<= (setq n (1+ n)) skk-code-n2-max) n skk-code-n2-min))
|
|
122
|
|
123 (defun skk-previous-n2-code (n)
|
|
124 (if (<= skk-code-n2-min (setq n (1- n))) n skk-code-n2-max))
|
|
125
|
|
126 (defun skk-next-n1-code (n)
|
|
127 (if (<= (setq n (1+ n)) skk-code-n1-max) n skk-code-n1-min))
|
|
128
|
|
129 (defun skk-previous-n1-code (n)
|
|
130 (if (<= skk-code-n1-min (setq n (1- n))) n skk-code-n1-max))
|
|
131
|
|
132 (defun skk-input-by-code-or-menu-0 (n1 n2)
|
|
133 (if (= n1 skk-code-null)
|
|
134 (skk-input-by-code-or-menu-jump n2)
|
|
135 (skk-input-by-code-or-menu-1 n1 n2)))
|
|
136
|
|
137 (defun skk-input-by-code-or-menu-jump (n)
|
|
138 (let ((menu-keys1 ; $BI=<(MQ$N%-!<%j%9%H$rAH$_N)$F$k!#(B
|
|
139 (mapcar (function (lambda (char) (char-to-string (upcase char))))
|
|
140 skk-input-by-code-menu-keys1 ))
|
|
141 kanji-char )
|
|
142 (if (< n skk-code-n1-min) (setq n skk-input-by-code-or-menu-jump-default))
|
|
143 (while (not kanji-char)
|
|
144 (let ((n-org n)
|
|
145 (chars
|
|
146 (list
|
|
147 (list (skk-make-string n skk-code-n1-min) n skk-code-n1-min)
|
|
148 (list (skk-make-string n 177) n 177)
|
|
149 (list (skk-make-string n 193) n 193)
|
|
150 (list (skk-make-string n 209) n 209)
|
|
151 (list (skk-make-string n 225) n 225)
|
|
152 (list (skk-make-string n 241) n 241)
|
|
153 (progn
|
|
154 (setq n (skk-next-n1-code n))
|
|
155 (list (skk-make-string n skk-code-n1-min) n
|
|
156 skk-code-n1-min ))
|
|
157 (list (skk-make-string n 177) n 177)
|
|
158 (list (skk-make-string n 193) n 193)
|
|
159 (list (skk-make-string n 209) n 209)
|
|
160 (list (skk-make-string n 225) n 225)
|
|
161 (list (skk-make-string n 241) n 241))))
|
|
162 (skk-save-point
|
|
163 (let ((i 0) message-log-max str )
|
|
164 (while (< i 12)
|
|
165 (setq str (concat str (nth i menu-keys1) ":" (car (nth i chars))
|
|
166 " " ))
|
|
167 (setq i (1+ i)) )
|
|
168 (message str) )
|
|
169 (let ((char (skk-read-event))
|
|
170 rest ch )
|
|
171 (if (not (integerp char))
|
|
172 (progn
|
|
173 (skk-message "\"%s\" $B$OM-8z$J%-!<$G$O$"$j$^$;$s!*(B"
|
|
174 "\"%s\" is not valid here!" (prin1 char) )
|
|
175 (sit-for 1)
|
|
176 (message "")
|
|
177 (setq n n-org) )
|
|
178 (setq rest (or (memq char skk-input-by-code-menu-keys1)
|
|
179 (if (skk-lower-case-p char)
|
|
180 (memq (upcase char) skk-input-by-code-menu-keys1)
|
|
181 (memq (downcase char) skk-input-by-code-menu-keys1) ))
|
|
182 ch (if rest
|
|
183 ;; 12 == (length skk-input-by-code-menu-keys1)
|
|
184 (nth (- 12 (length rest)) chars)
|
|
185 nil )
|
|
186 kanji-char
|
|
187 (cond
|
|
188 (ch)
|
|
189 ((eq char 120) ; x
|
|
190 (if (< (setq n (- n-org 2)) skk-code-n1-min)
|
|
191 (setq n skk-code-n1-max))
|
|
192 nil)
|
|
193 ((eq char 32) ; space
|
|
194 (setq n (skk-next-n1-code n))
|
|
195 nil)
|
|
196 ((eq char 63) ; ?
|
|
197 (skk-message
|
|
198 (concat "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) "
|
|
199 "[$B2?$+%-!<$r2!$7$F$/$@$5$$(B]" )
|
|
200 (concat "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) "
|
|
201 "[Hit any key to continue]" )
|
|
202 (car (car chars))
|
|
203 n-org skk-code-n1-min n-org skk-code-n1-min
|
|
204 (- n-org 128) (- skk-code-n1-min 128)
|
|
205 (- n-org 128) (- skk-code-n1-min 128) )
|
|
206 (skk-read-event)
|
|
207 (setq n n-org)
|
|
208 nil)
|
|
209 (t
|
|
210 (skk-message "\"%c\" $B$OM-8z$J%-!<$G$O$"$j$^$;$s!*(B"
|
|
211 "\"%c\" is not valid here!" char )
|
|
212 (sit-for 1)
|
|
213 (message "")
|
|
214 (setq n n-org)
|
|
215 nil ))))))))
|
|
216 (setq skk-input-by-code-or-menu-jump-default (car (cdr kanji-char)))
|
|
217 (skk-input-by-code-or-menu-1
|
|
218 (car (cdr kanji-char)) (car (cdr (cdr kanji-char))) )))
|
|
219
|
|
220 (defun skk-input-by-code-or-menu-1 (n1 n2)
|
|
221 (let ((menu-keys2 ; $BI=<(MQ$N%-!<%j%9%H$rAH$_N)$F$k!#(B
|
|
222 (mapcar (function (lambda (char) (char-to-string (upcase char))))
|
|
223 skk-input-by-code-menu-keys2 ))
|
|
224 kanji-char )
|
|
225 (while (not kanji-char)
|
|
226 (let ((n1-org n1) (n2-org n2) (i 0)
|
|
227 (chars (list (skk-make-string n1 n2))))
|
|
228 ;; 16 == (length skk-input-by-code-menu-keys2)
|
|
229 (while (< i 16)
|
|
230 (nconc chars (list
|
|
231 (progn (setq n2 (skk-next-n2-code n2))
|
|
232 (if (= n2 skk-code-n2-min)
|
|
233 (setq n1 (skk-next-n1-code n1)))
|
|
234 (skk-make-string n1 n2))))
|
|
235 (setq i (1+ i)))
|
|
236 (skk-save-point
|
|
237 (let ((i 0) message-log-max str )
|
|
238 (while (< i 16)
|
|
239 (setq str (concat str (nth i menu-keys2) ":" (nth i chars) " "))
|
|
240 (setq i (1+ i)) )
|
|
241 (message str) )
|
|
242 (let ((char (skk-read-event)))
|
|
243 (if (not (integerp char))
|
|
244 (progn
|
|
245 (skk-message "\"%s\" $B$OM-8z$J%-!<$G$O$"$j$^$;$s!*(B"
|
|
246 "\"%s\" is not valid here!" (prin1 char) )
|
|
247 (sit-for 1)
|
|
248 (message "")
|
|
249 (setq n1 n1-org n2 n2-org) )
|
|
250 (setq rest
|
|
251 (or (memq char skk-input-by-code-menu-keys2)
|
|
252 (if (skk-lower-case-p char)
|
|
253 (memq (upcase char) skk-input-by-code-menu-keys2)
|
|
254 (memq (downcase char) skk-input-by-code-menu-keys2) ))
|
|
255 ch (if rest
|
|
256 ;; 16 == (length skk-input-by-code-menu-keys2)
|
|
257 (nth (- 16 (length rest)) chars) )
|
|
258 kanji-char
|
|
259 (cond
|
|
260 (ch)
|
|
261 ((eq char 120) ; x
|
|
262 (if (< (setq n2 (- n2 31)) skk-code-n2-min)
|
|
263 (setq n2 (+ n2 94)
|
|
264 n1 (skk-previous-n1-code n1)))
|
|
265 nil )
|
|
266 ((eq char 32) ; space
|
|
267 (if (= (setq n2 (skk-next-n2-code n2))
|
|
268 skk-code-n2-min)
|
|
269 (setq n1 (skk-next-n1-code n1)))
|
|
270 nil )
|
|
271 ((eq char 63) ; ?
|
|
272 (skk-message
|
|
273 (concat "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) "
|
|
274 "[$B2?$+%-!<$r2!$7$F$/$@$5$$(B]" )
|
|
275 (concat "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d) "
|
|
276 "[Hit any key to continue]" )
|
|
277 (car chars) n1-org n2-org n1-org n2-org
|
|
278 (- n1-org 128) (- n2-org 128)
|
|
279 (- n1-org 128) (- n2-org 128) )
|
|
280 (skk-read-event)
|
|
281 (setq n1 n1-org n2 n2-org)
|
|
282 nil )
|
|
283 ((eq char 62) ; >
|
|
284 (if (= (setq n2 (skk-next-n2-code n2-org))
|
|
285 skk-code-n2-min)
|
|
286 (setq n1 (skk-next-n1-code n1-org))
|
|
287 (setq n1 n1-org))
|
|
288 nil )
|
|
289 ((eq char 60) ; <
|
|
290 (if (= (setq n2 (skk-previous-n2-code n2-org))
|
|
291 skk-code-n2-max)
|
|
292 (setq n1 (skk-previous-n1-code n1-org))
|
|
293 (setq n1 n1-org))
|
|
294 nil )
|
|
295 (t
|
|
296 (skk-message "\"%c\" $B$OM-8z$J%-!<$G$O$"$j$^$;$s!*(B"
|
|
297 "\"%c\" is not valid here!" char )
|
|
298 (sit-for 1)
|
|
299 (message "")
|
|
300 (setq n1 n1-org n2 n2-org)
|
|
301 nil ))))))))
|
|
302 kanji-char ))
|
|
303
|
|
304 ;;;###skk-autoload
|
|
305 (defun skk-display-code-for-char-at-point ()
|
|
306 "$B%]%$%s%H$K$"$kJ8;z$N(B EUC $B%3!<%I$H(B JIS $B%3!<%I$rI=<($9$k!#(B"
|
|
307 (interactive)
|
|
308 (if (eobp)
|
|
309 (skk-error "$B%+!<%=%k$,%P%C%U%!$N=*C<$K$"$j$^$9(B"
|
|
310 "Cursor is at the end of the buffer" )
|
|
311 (let ((str
|
|
312 (skk-buffer-substring
|
|
313 (point)
|
|
314 (skk-save-point (forward-char 1) (point)))))
|
|
315 (cond
|
|
316 (skk-xemacs
|
|
317 (let* ((char (string-to-char str))
|
|
318 (charset (char-charset char)))
|
|
319 (cond
|
|
320 ((memq charset '(japanese-jisx0208 japanese-jisx0208-1978))
|
|
321 (let* ((char1-j (char-octet char 0))
|
|
322 (char1-k (- char1-j 32))
|
|
323 (char1-e (+ char1-j 128))
|
|
324 (char2-j (char-octet char 1))
|
|
325 (char2-k (- char2-j 32))
|
|
326 (char2-e (+ char2-j 128)))
|
|
327 (message
|
|
328 "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d), KUTEN: (%2d, %2d)"
|
|
329 str char1-e char2-e char1-e char2-e
|
|
330 char1-j char2-j char1-j char2-j char1-k char2-k)))
|
|
331 ((memq charset '(ascii latin-jisx0201))
|
|
332 (message "\"%s\" %2x (%3d)"
|
|
333 str (char-octet char 0) (char-octet char 0)))
|
|
334 (t
|
|
335 (skk-error "$BH=JL$G$-$J$$J8;z$G$9(B"
|
|
336 "Cannot understand this character")))
|
|
337 ))
|
|
338 (skk-mule3
|
|
339 (let* ((char (string-to-char str))
|
|
340 (charset (char-charset char)))
|
|
341 (cond
|
|
342 ((memq charset '(japanese-jisx0208 japanese-jisx0208-1978))
|
|
343 (let* ((char-list (mapcar (function +) str))
|
|
344 (char1-e (car (cdr char-list)))
|
|
345 (char1-j (- char1-e 128))
|
|
346 (char1-k (- char1-j 32))
|
|
347 (char2-e (car (cdr (cdr char-list))))
|
|
348 (char2-j (- char2-e 128))
|
|
349 (char2-k (- char2-j 32)))
|
|
350 (message
|
|
351 "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d), KUTEN: (%2d, %2d)"
|
|
352 str char1-e char2-e char1-e char2-e
|
|
353 char1-j char2-j char1-j char2-j char1-k char2-k)))
|
|
354 ((memq charset '(ascii latin-jisx0201))
|
|
355 (message "\"%s\" %2x (%3d)" char char char))
|
|
356 (t
|
|
357 (skk-error "$BH=JL$G$-$J$$J8;z$G$9(B"
|
|
358 "Cannot understand this character")))
|
|
359 ))
|
|
360 (t ; skk-mule
|
|
361 (let (;; $BJ8;zNs$r(B char $B$KJ,2r!#(B
|
|
362 ;; (mapcar '+ str) == (append str nil)
|
|
363 (char-list (mapcar (function +) str)))
|
|
364 (cond
|
|
365 ((and (= (length char-list) 3)
|
|
366 (memq (car char-list) (list lc-jp lc-jpold)))
|
|
367 (let* ((char1-e (car (cdr char-list)))
|
|
368 (char1-j (- char1-e 128))
|
|
369 (char1-k (- char1-j 32))
|
|
370 (char2-e (car (cdr (cdr char-list))))
|
|
371 (char2-j (- char2-e 128))
|
|
372 (char2-k (- char2-j 32)))
|
|
373 (message
|
|
374 "$B!X(B%s$B!Y(B EUC: %2x%2x (%3d, %3d), JIS: %2x%2x (%3d, %3d), KUTEN: (%2d, %2d)"
|
|
375 str char1-e char2-e char1-e char2-e
|
|
376 char1-j char2-j char1-j char2-j char1-k char2-k)))
|
|
377 ((or (= (length char-list) 1) ; ascii character
|
|
378 (memq (car char-list) (list lc-ascii lc-roman)))
|
|
379 (let ((char (car char-list)))
|
|
380 (message "\"%c\" %2x (%3d)" char char char)))
|
|
381 (t
|
|
382 (skk-error "$BH=JL$G$-$J$$J8;z$G$9(B"
|
|
383 "Cannot understand this character" ))
|
|
384 )))
|
|
385 ))))
|
|
386
|
|
387 (run-hooks 'skk-kcode-load-hook)
|
|
388
|
|
389 (provide 'skk-kcode)
|
|
390 ;;; skk-kcode.el ends here
|