Mercurial > hg > xemacs-beta

comparison lisp/mule/japan-util.el @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents
children 79940b592197
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 ;;; japan-util.el --- utilities for Japanese -*- coding: iso-2022-7bit; -*-
2
3
4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
5 ;; Licensed to the Free Software Foundation.
6
7 ;; Keywords: mule, multilingual, Japanese
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ;; 02111-1307, USA.
25
26 ;;; Synched up with: Emacs 21.0.103 (language/japan-util.el).
27
28 ;;; Code:
29
30 (defvar sentence-end-save nil)
31
32 ;;;###autoload
33 (defun setup-japanese-environment-internal ()
34 (cond ((eq system-type 'ms-dos)
35 (prefer-coding-system 'japanese-shift-jis))
36 ((eq system-type 'usg-unix-v)
37 (prefer-coding-system 'japanese-iso-8bit)))
38 (setq sentence-end-save sentence-end)
39 (setq sentence-end (concat sentence-end "\\|[$B!#!)!*(B]")))
40
41 (defun exit-japanese-environment ()
42 (setq sentence-end sentence-end-save))
43
44 (defconst japanese-kana-table
45 '((?$B$"(B ?$B%"(B ?(I1(B) (?$B$$(B ?$B%$(B ?(I2(B) (?$B$&(B ?$B%&(B ?(I3(B) (?$B$((B ?$B%((B ?(I4(B) (?$B$*(B ?$B%*(B ?(I5(B)
46 (?$B$+(B ?$B%+(B ?(I6(B) (?$B$-(B ?$B%-(B ?(I7(B) (?$B$/(B ?$B%/(B ?(I8(B) (?$B$1(B ?$B%1(B ?(I9(B) (?$B$3(B ?$B%3(B ?(I:(B)
47 (?$B$5(B ?$B%5(B ?(I;(B) (?$B$7(B ?$B%7(B ?(I<(B) (?$B$9(B ?$B%9(B ?(I=(B) (?$B$;(B ?$B%;(B ?(I>(B) (?$B$=(B ?$B%=(B ?(I?(B)
48 (?$B$?(B ?$B%?(B ?(I@(B) (?$B$A(B ?$B%A(B ?(IA(B) (?$B$D(B ?$B%D(B ?(IB(B) (?$B$F(B ?$B%F(B ?(IC(B) (?$B$H(B ?$B%H(B ?(ID(B)
49 (?$B$J(B ?$B%J(B ?(IE(B) (?$B$K(B ?$B%K(B ?(IF(B) (?$B$L(B ?$B%L(B ?(IG(B) (?$B$M(B ?$B%M(B ?(IH(B) (?$B$N(B ?$B%N(B ?(II(B)
50 (?$B$O(B ?$B%O(B ?(IJ(B) (?$B$R(B ?$B%R(B ?(IK(B) (?$B$U(B ?$B%U(B ?(IL(B) (?$B$X(B ?$B%X(B ?(IM(B) (?$B$[(B ?$B%[(B ?(IN(B)
51 (?$B$^(B ?$B%^(B ?(IO(B) (?$B$_(B ?$B%_(B ?(IP(B) (?$B$`(B ?$B%`(B ?(IQ(B) (?$B$a(B ?$B%a(B ?(IR(B) (?$B$b(B ?$B%b(B ?(IS(B)
52 (?$B$d(B ?$B%d(B ?(IT(B) (?$B$f(B ?$B%f(B ?(IU(B) (?$B$h(B ?$B%h(B ?(IV(B)
53 (?$B$i(B ?$B%i(B ?(IW(B) (?$B$j(B ?$B%j(B ?(IX(B) (?$B$k(B ?$B%k(B ?(IY(B) (?$B$l(B ?$B%l(B ?(IZ(B) (?$B$m(B ?$B%m(B ?(I[(B)
54 (?$B$o(B ?$B%o(B ?(I\(B) (?$B$p(B ?$B%p(B "(I2(B") (?$B$q(B ?$B%q(B "(I4(B") (?$B$r(B ?$B%r(B ?(I&(B)
55 (?$B$s(B ?$B%s(B ?(I](B)
56 (?$B$,(B ?$B%,(B "(I6^(B") (?$B$.(B ?$B%.(B "(I7^(B") (?$B$0(B ?$B%0(B "(I8^(B") (?$B$2(B ?$B%2(B "(I9^(B") (?$B$4(B ?$B%4(B "(I:^(B")
57 (?$B$6(B ?$B%6(B "(I;^(B") (?$B$8(B ?$B%8(B "(I<^(B") (?$B$:(B ?$B%:(B "(I=^(B") (?$B$<(B ?$B%<(B "(I>^(B") (?$B$>(B ?$B%>(B "(I?^(B")
58 (?$B$@(B ?$B%@(B "(I@^(B") (?$B$B(B ?$B%B(B "(IA^(B") (?$B$E(B ?$B%E(B "(IB^(B") (?$B$G(B ?$B%G(B "(IC^(B") (?$B$I(B ?$B%I(B "(ID^(B")
59 (?$B$P(B ?$B%P(B "(IJ^(B") (?$B$S(B ?$B%S(B "(IK^(B") (?$B$V(B ?$B%V(B "(IL^(B") (?$B$Y(B ?$B%Y(B "(IM^(B") (?$B$\(B ?$B%\(B "(IN^(B")
60 (?$B$Q(B ?$B%Q(B "(IJ_(B") (?$B$T(B ?$B%T(B "(IK_(B") (?$B$W(B ?$B%W(B "(IL_(B") (?$B$Z(B ?$B%Z(B "(IM_(B") (?$B$](B ?$B%](B "(IN_(B")
61 (?$B$!(B ?$B%!(B ?(I'(B) (?$B$#(B ?$B%#(B ?(I((B) (?$B$%(B ?$B%%(B ?(I)(B) (?$B$'(B ?$B%'(B ?(I*(B) (?$B$)(B ?$B%)(B ?(I+(B)
62 (?$B$C(B ?$B%C(B ?(I/(B)
63 (?$B$c(B ?$B%c(B ?(I,(B) (?$B$e(B ?$B%e(B ?(I-(B) (?$B$g(B ?$B%g(B ?(I.(B)
64 (?$B$n(B ?$B%n(B "(I\(B")
65 ("$B$&!+(B" ?$B%t(B "(I3^(B") (nil ?$B%u(B "(I6(B") (nil ?$B%v(B "(I9(B"))
66 "Japanese JISX0208 Kana character table.
67 Each element is of the form (HIRAGANA KATAKANA HANKAKU-KATAKANA), where
68 HIRAGANA and KATAKANA belong to `japanese-jisx0208',
69 HANKAKU-KATAKANA belongs to `japanese-jisx0201-kana'.")
70
71 ;; Put properties 'katakana, 'hiragana, and 'jix0201 to each Japanese
72 ;; kana characters for conversion among them.
73 (let ((l japanese-kana-table)
74 slot hiragana katakana jisx0201)
75 (while l
76 (setq slot (car l)
77 hiragana (car slot) katakana (nth 1 slot) jisx0201 (nth 2 slot)
78 l (cdr l))
79 (if hiragana
80 (if (stringp hiragana)
81 (if (> (length hiragana) 1)
82 (let ((hira (aref hiragana 0)))
83 (put-char-code-property
84 hira 'kana-composition
85 (cons (cons (aref hiragana 1) katakana)
86 (get-char-code-property hira 'kana-composition)))))
87 (put-char-code-property hiragana 'katakana katakana)
88 (put-char-code-property hiragana 'jisx0201 jisx0201)))
89 (when (integerp katakana)
90 (put-char-code-property katakana 'hiragana hiragana)
91 (put-char-code-property katakana 'jisx0201 jisx0201))
92 (if jisx0201
93 (if (stringp jisx0201)
94 (if (> (length jisx0201) 1)
95 (let ((kana (aref jisx0201 0)))
96 (put-char-code-property
97 kana 'kana-composition
98 (cons (cons (aref jisx0201 1) katakana)
99 (get-char-code-property kana 'kana-composition)))))
100 (put-char-code-property jisx0201 'hiragana hiragana)
101 (put-char-code-property jisx0201 'katakana katakana)
102 (put-char-code-property jisx0201 'jisx0208 katakana)))))
103
104 (defconst japanese-symbol-table
105 '((?\$B!!(B ?\ ) (?$B!$(B ?, ?(I$(B) (?$B!%(B ?. ?(I!(B) (?$B!"(B ?, ?(I$(B) (?$B!#(B ?. ?(I!(B) (?$B!&(B nil ?(I%(B)
106 (?$B!'(B ?:) (?$B!((B ?\;) (?$B!)(B ??) (?$B!*(B ?!) (?$B!+(B nil ?(I^(B) (?$B!,(B nil ?(I_(B)
107 (?$B!-(B ?') (?$B!.(B ?`) (?$B!0(B ?^) (?$B!2(B ?_) (?$B!<(B ?-) (?$B!=(B ?-) (?$B!>(B ?-)
108 (?$B!?(B ?/) (?$B!@(B ?\\) (?$B!A(B ?~) (?$B!C(B ?|) (?$B!F(B ?`) (?$B!G(B ?') (?$B!H(B ?\") (?$B!I(B ?\")
109 (?\$B!J(B ?\() (?\$B!K(B ?\)) (?\$B!N(B ?[) (?\$B!O(B ?]) (?\$B!P(B ?{) (?\$B!Q(B ?})
110 (?$B!R(B ?<) (?$B!S(B ?>) (?$B!\(B ?+) (?$B!](B ?-) (?$B!a(B ?=) (?$B!c(B ?<) (?$B!d(B ?>)
111 (?$B!l(B ?') (?$B!m(B ?\") (?$B!o(B ?\\) (?$B!p(B ?$) (?$B!s(B ?%) (?$B!t(B ?#) (?$B!u(B ?&) (?$B!v(B ?*)
112 (?$B!w(B ?@))
113 "Japanese JISX0208 symbol character table.
114 Each element is of the form (SYMBOL ASCII HANKAKU), where SYMBOL
115 belongs to `japanese-jisx0208', ASCII belongs to `ascii', and HANKAKU
116 belongs to `japanese-jisx0201-kana'.")
117
118 ;; Put properties 'jisx0208, 'jisx0201, and 'ascii to each Japanese
119 ;; symbol and ASCII characters for conversion among them.
120 (let ((l japanese-symbol-table)
121 slot jisx0208 ascii jisx0201)
122 (while l
123 (setq slot (car l)
124 jisx0208 (car slot) ascii (nth 1 slot) jisx0201 (nth 2 slot)
125 l (cdr l))
126 (if ascii
127 (progn
128 (put-char-code-property jisx0208 'ascii ascii)
129 (put-char-code-property ascii 'jisx0208 jisx0208)))
130 (if jisx0201
131 (progn
132 (put-char-code-property jisx0208 'jisx0201 jisx0201)
133 (put-char-code-property jisx0201 'jisx0208 jisx0208)))))
134
135 (defconst japanese-alpha-numeric-table
136 '((?$B#0(B . ?0) (?$B#1(B . ?1) (?$B#2(B . ?2) (?$B#3(B . ?3) (?$B#4(B . ?4)
137 (?$B#5(B . ?5) (?$B#6(B . ?6) (?$B#7(B . ?7) (?$B#8(B . ?8) (?$B#9(B . ?9)
138 (?$B#A(B . ?A) (?$B#B(B . ?B) (?$B#C(B . ?C) (?$B#D(B . ?D) (?$B#E(B . ?E)
139 (?$B#F(B . ?F) (?$B#G(B . ?G) (?$B#H(B . ?H) (?$B#I(B . ?I) (?$B#J(B . ?J)
140 (?$B#K(B . ?K) (?$B#L(B . ?L) (?$B#M(B . ?M) (?$B#N(B . ?N) (?$B#O(B . ?O)
141 (?$B#P(B . ?P) (?$B#Q(B . ?Q) (?$B#R(B . ?R) (?$B#S(B . ?S) (?$B#T(B . ?T)
142 (?$B#U(B . ?U) (?$B#V(B . ?V) (?$B#W(B . ?W) (?$B#X(B . ?X) (?$B#Y(B . ?Y) (?$B#Z(B . ?Z)
143 (?$B#a(B . ?a) (?$B#b(B . ?b) (?$B#c(B . ?c) (?$B#d(B . ?d) (?$B#e(B . ?e)
144 (?$B#f(B . ?f) (?$B#g(B . ?g) (?$B#h(B . ?h) (?$B#i(B . ?i) (?$B#j(B . ?j)
145 (?$B#k(B . ?k) (?$B#l(B . ?l) (?$B#m(B . ?m) (?$B#n(B . ?n) (?$B#o(B . ?o)
146 (?$B#p(B . ?p) (?$B#q(B . ?q) (?$B#r(B . ?r) (?$B#s(B . ?s) (?$B#t(B . ?t)
147 (?$B#u(B . ?u) (?$B#v(B . ?v) (?$B#w(B . ?w) (?$B#x(B . ?x) (?$B#y(B . ?y) (?$B#z(B . ?z))
148 "Japanese JISX0208 alpha numeric character table.
149 Each element is of the form (ALPHA-NUMERIC ASCII), where ALPHA-NUMERIC
150 belongs to `japanese-jisx0208', ASCII belongs to `ascii'.")
151
152 ;; Put properties 'jisx0208 and 'ascii to each Japanese alpha numeric
153 ;; and ASCII characters for conversion between them.
154 (let ((l japanese-alpha-numeric-table)
155 slot jisx0208 ascii)
156 (while l
157 (setq slot (car l)
158 jisx0208 (car slot) ascii (cdr slot)
159 l (cdr l))
160 (put-char-code-property jisx0208 'ascii ascii)
161 (put-char-code-property ascii 'jisx0208 jisx0208)))
162
163 ;; Convert string STR by FUNC and return a resulting string.
164 (defun japanese-string-conversion (str func &rest args)
165 (let ((buf (get-buffer-create " *Japanese work*")))
166 (save-excursion
167 (set-buffer buf)
168 (erase-buffer)
169 (insert str)
170 (apply func 1 (point) args)
171 (buffer-string))))
172
173 ;;;###autoload
174 (defun japanese-katakana (obj &optional hankaku)
175 "Convert argument to Katakana and return that.
176 The argument may be a character or string. The result has the same type.
177 The argument object is not altered--the value is a copy.
178 Optional argument HANKAKU t means to convert to `hankaku' Katakana
179 \(`japanese-jisx0201-kana'), in which case return value
180 may be a string even if OBJ is a character if two Katakanas are
181 necessary to represent OBJ."
182 (if (stringp obj)
183 (japanese-string-conversion obj 'japanese-katakana-region hankaku)
184 (or (get-char-code-property obj (if hankaku 'jisx0201 'katakana))
185 obj)))
186
187 ;;;###autoload
188 (defun japanese-hiragana (obj)
189 "Convert argument to Hiragana and return that.
190 The argument may be a character or string. The result has the same type.
191 The argument object is not altered--the value is a copy."
192 (if (stringp obj)
193 (japanese-string-conversion obj 'japanese-hiragana-region)
194 (or (get-char-code-property obj 'hiragana)
195 obj)))
196
197 ;;;###autoload
198 (defun japanese-hankaku (obj &optional ascii-only)
199 "Convert argument to `hankaku' and return that.
200 The argument may be a character or string. The result has the same type.
201 The argument object is not altered--the value is a copy.
202 Optional argument ASCII-ONLY non-nil means to return only ASCII character."
203 (if (stringp obj)
204 (japanese-string-conversion obj 'japanese-hankaku-region ascii-only)
205 (or (get-char-code-property obj 'ascii)
206 (and (not ascii-only)
207 (get-char-code-property obj 'jisx0201))
208 obj)))
209
210 ;;;###autoload
211 (defun japanese-zenkaku (obj)
212 "Convert argument to `zenkaku' and return that.
213 The argument may be a character or string. The result has the same type.
214 The argument object is not altered--the value is a copy."
215 (if (stringp obj)
216 (japanese-string-conversion obj 'japanese-zenkaku-region)
217 (or (get-char-code-property obj 'jisx0208)
218 obj)))
219
220 (defun japanese-replace-region (from to string)
221 "Replace the region specified by FROM and TO to STRING."
222 (goto-char from)
223 (insert string)
224 (delete-char (- to from)))
225
226 ;;;###autoload
227 (defun japanese-katakana-region (from to &optional hankaku)
228 "Convert Japanese `hiragana' chars in the region to `katakana' chars.
229 Optional argument HANKAKU t means to convert to `hankaku katakana' character
230 of which charset is `japanese-jisx0201-kana'."
231 (interactive "r\nP")
232 (save-restriction
233 (narrow-to-region from to)
234 (save-excursion
235 (goto-char (point-min))
236 (while (re-search-forward "\\cH\\|\\cK" nil t)
237 (let* ((kana (preceding-char))
238 (composition
239 (and (not hankaku)
240 (get-char-code-property kana 'kana-composition)))
241 next slot)
242 (if (and composition (setq slot (assq (following-char) composition)))
243 (japanese-replace-region (match-beginning 0) (1+ (point))
244 (cdr slot))
245 (let ((kata (get-char-code-property
246 kana (if hankaku 'jisx0201 'katakana))))
247 (if kata
248 (japanese-replace-region (match-beginning 0) (point)
249 kata)))))))))
250
251
252 ;;;###autoload
253 (defun japanese-hiragana-region (from to)
254 "Convert Japanese `katakana' chars in the region to `hiragana' chars."
255 (interactive "r")
256 (save-restriction
257 (narrow-to-region from to)
258 (save-excursion
259 (goto-char (point-min))
260 (while (re-search-forward "\\cK\\|\\ck" nil t)
261 (let* ((kata (preceding-char))
262 (composition (get-char-code-property kata 'kana-composition))
263 next slot)
264 (if (and composition (setq slot (assq (following-char) composition)))
265 (japanese-replace-region (match-beginning 0) (1+ (point))
266 (get-char-code-property
267 (cdr slot) 'hiragana))
268 (let ((hira (get-char-code-property kata 'hiragana)))
269 (if hira
270 (japanese-replace-region (match-beginning 0) (point)
271 hira)))))))))
272
273 ;;;###autoload
274 (defun japanese-hankaku-region (from to &optional ascii-only)
275 "Convert Japanese `zenkaku' chars in the region to `hankaku' chars.
276 `Zenkaku' chars belong to `japanese-jisx0208'
277 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
278 Optional argument ASCII-ONLY non-nil means to convert only to ASCII char."
279 (interactive "r\nP")
280 (save-restriction
281 (narrow-to-region from to)
282 (save-excursion
283 (goto-char (point-min))
284 (while (re-search-forward "\\cj" nil t)
285 (let* ((zenkaku (preceding-char))
286 (hankaku (or (get-char-code-property zenkaku 'ascii)
287 (and (not ascii-only)
288 (get-char-code-property zenkaku 'jisx0201)))))
289 (if hankaku
290 (japanese-replace-region (match-beginning 0) (match-end 0)
291 hankaku)))))))
292
293 ;;;###autoload
294 (defun japanese-zenkaku-region (from to &optional katakana-only)
295 "Convert hankaku' chars in the region to Japanese `zenkaku' chars.
296 `Zenkaku' chars belong to `japanese-jisx0208'
297 `Hankaku' chars belong to `ascii' or `japanese-jisx0201-kana'.
298 Optional argument KATAKANA-ONLY non-nil means to convert only KATAKANA char."
299 (interactive "r\nP")
300 (save-restriction
301 (narrow-to-region from to)
302 (save-excursion
303 (goto-char (point-min))
304 (while (or (and katakana-only
305 (re-search-forward "\\ck" nil t))
306 (and (not katakana-only)
307 (re-search-forward "\\ca\\|\\ck" nil t)))
308 (let* ((hankaku (preceding-char))
309 (composition (get-char-code-property hankaku 'kana-composition))
310 next slot)
311 (if (and composition (setq slot (assq (following-char) composition)))
312 (japanese-replace-region (match-beginning 0) (1+ (point))
313 (cdr slot))
314 (let ((zenkaku (japanese-zenkaku hankaku)))
315 (if zenkaku
316 (japanese-replace-region (match-beginning 0) (match-end 0)
317 zenkaku)))))))))
318
319 ;;;###autoload
320 (defun read-hiragana-string (prompt &optional initial-input)
321 "Read a Hiragana string from the minibuffer, prompting with string PROMPT.
322 If non-nil, second arg INITIAL-INPUT is a string to insert before reading."
323 (read-multilingual-string prompt initial-input "japanese-hiragana"))
324
325 ;;
326 (provide 'japan-util)
327
328 ;;; japan-util.el ends here