194 |
(defconst utf-translate-cjk-charsets '(chinese-gb2312 |
(defconst utf-translate-cjk-charsets '(chinese-gb2312 |
195 |
chinese-big5-1 chinese-big5-2 |
chinese-big5-1 chinese-big5-2 |
196 |
japanese-jisx0208 japanese-jisx0212 |
japanese-jisx0208 japanese-jisx0212 |
197 |
|
katakana-jisx0201 |
198 |
korean-ksc5601) |
korean-ksc5601) |
199 |
"List of charsets supported by `utf-translate-cjk-mode'.") |
"List of charsets supported by `utf-translate-cjk-mode'.") |
200 |
|
|
201 |
(defconst utf-translate-cjk-unicode-range |
(defvar utf-translate-cjk-lang-env nil |
202 |
'((#x2e80 . #xd7a3) |
"Language environment in which tables for `utf-translate-cjk-mode' is loaded. |
203 |
(#xff00 . #xffef)) |
The value nil means that the tables are not yet loaded.") |
204 |
"List of Unicode code ranges supported by `utf-translate-cjk-mode'.") |
|
205 |
|
(defvar utf-translate-cjk-unicode-range) |
206 |
|
|
207 |
|
;; String generated from utf-translate-cjk-unicode-range. It is |
208 |
|
;; suitable for an argument to skip-chars-forward. |
209 |
|
(defvar utf-translate-cjk-unicode-range-string nil) |
210 |
|
|
211 |
|
(defun utf-translate-cjk-set-unicode-range (range) |
212 |
|
(setq utf-translate-cjk-unicode-range range) |
213 |
|
(setq utf-translate-cjk-unicode-range-string |
214 |
|
(let ((decode-char-no-trans |
215 |
|
#'(lambda (x) |
216 |
|
(cond ((< x #x100) (make-char 'latin-iso8859-1 x)) |
217 |
|
((< x #x2500) |
218 |
|
(setq x (- x #x100)) |
219 |
|
(make-char 'mule-unicode-0100-24ff |
220 |
|
(+ (/ x 96) 32) (+ (% x 96) 32))) |
221 |
|
((< x #x3400) |
222 |
|
(setq x (- x #x2500)) |
223 |
|
(make-char 'mule-unicode-2500-33ff |
224 |
|
(+ (/ x 96) 32) (+ (% x 96) 32))) |
225 |
|
(t |
226 |
|
(setq x (- x #xe000)) |
227 |
|
(make-char 'mule-unicode-e000-ffff |
228 |
|
(+ (/ x 96) 32) (+ (% x 96) 32)))))) |
229 |
|
ranges from to) |
230 |
|
(dolist (elt range) |
231 |
|
(setq from (max #xA0 (car elt)) to (min #xffff (cdr elt))) |
232 |
|
(if (and (>= to #x3400) (< to #xE000)) |
233 |
|
(setq to #x33FF)) |
234 |
|
(cond ((< from #x100) |
235 |
|
(if (>= to #xE000) |
236 |
|
(setq ranges (cons (cons #xE000 to) ranges) |
237 |
|
to #x33FF)) |
238 |
|
(if (>= to #x2500) |
239 |
|
(setq ranges (cons (cons #x2500 to) ranges) |
240 |
|
to #x24FF)) |
241 |
|
(if (>= to #x100) |
242 |
|
(setq ranges (cons (cons #x100 to) ranges) |
243 |
|
to #xFF))) |
244 |
|
((< from #x2500) |
245 |
|
(if (>= to #xE000) |
246 |
|
(setq ranges (cons (cons #xE000 to) ranges) |
247 |
|
to #x33FF)) |
248 |
|
(if (>= to #x2500) |
249 |
|
(setq ranges (cons (cons #x2500 to) ranges) |
250 |
|
to #x24FF))) |
251 |
|
((< from #x3400) |
252 |
|
(if (>= to #xE000) |
253 |
|
(setq ranges (cons (cons #xE000 to) ranges) |
254 |
|
to #x33FF)))) |
255 |
|
(if (<= from to) |
256 |
|
(setq ranges (cons (cons from to) ranges)))) |
257 |
|
(mapconcat #'(lambda (x) |
258 |
|
(format "%c-%c" |
259 |
|
(funcall decode-char-no-trans (car x)) |
260 |
|
(funcall decode-char-no-trans (cdr x)))) |
261 |
|
ranges ""))) |
262 |
|
;; These forces loading and settting tables for |
263 |
|
;; utf-translate-cjk-mode. |
264 |
|
(setq utf-translate-cjk-lang-env nil |
265 |
|
ucs-mule-cjk-to-unicode (make-hash-table :test 'eq) |
266 |
|
ucs-unicode-to-mule-cjk (make-hash-table :test 'eq))) |
267 |
|
|
268 |
|
(defcustom utf-translate-cjk-unicode-range '((#x2e80 . #xd7a3) |
269 |
|
(#xff00 . #xffef)) |
270 |
|
"List of Unicode code ranges supported by `utf-translate-cjk-mode'. |
271 |
|
Setting this variable directly does not take effect; |
272 |
|
use either \\[customize] or the function |
273 |
|
`utf-translate-cjk-set-unicode-range'." |
274 |
|
:version "21.4" |
275 |
|
:type '(repeat (cons integer integer)) |
276 |
|
:set (lambda (symbol value) |
277 |
|
(utf-translate-cjk-set-unicode-range value)) |
278 |
|
:group 'mule) |
279 |
|
|
280 |
;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'. |
;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'. |
281 |
(defsubst utf-translate-cjk-substitutable-p (code-point) |
(defsubst utf-translate-cjk-substitutable-p (code-point) |
288 |
(setq elt nil))) |
(setq elt nil))) |
289 |
elt)) |
elt)) |
290 |
|
|
|
(defvar utf-translate-cjk-lang-env nil |
|
|
"Language environment in which tables for `utf-translate-cjk-mode' is loaded. |
|
|
The value nil means that the tables are not yet loaded.") |
|
|
|
|
291 |
(defun utf-translate-cjk-load-tables () |
(defun utf-translate-cjk-load-tables () |
292 |
"Load tables for `utf-translate-cjk-mode'." |
"Load tables for `utf-translate-cjk-mode'." |
293 |
;; Fixme: Allow the use of the CJK charsets to be |
;; Fixme: Allow the use of the CJK charsets to be |
496 |
;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx |
;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx |
497 |
((r1 &= #x3F) |
((r1 &= #x3F) |
498 |
(r1 |= ((r0 & #x1F) << 6)) |
(r1 |= ((r0 & #x1F) << 6)) |
499 |
;; Now r2 holds scalar value. We don't have to check |
;; Now r1 holds scalar value. We don't have to check |
500 |
;; `overlong sequence' because r0 >= 0xC2. |
;; `overlong sequence' because r0 >= 0xC2. |
501 |
|
|
502 |
(if (r1 >= 256) |
(if (r1 >= 256) |
503 |
;; mule-unicode-0100-24ff (< 0800) |
;; mule-unicode-0100-24ff (< 0800) |
504 |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
((r0 = r1) |
505 |
(r1 -= #x0100) |
(lookup-integer utf-subst-table-for-decode r0 r1) |
506 |
(r2 = (((r1 / 96) + 32) << 7)) |
(if (r7 == 0) |
507 |
(r1 %= 96) |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
508 |
(r1 += (r2 + 32)) |
(r1 -= #x0100) |
509 |
(translate-character |
(r2 = (((r1 / 96) + 32) << 7)) |
510 |
utf-translation-table-for-decode r0 r1) |
(r1 %= 96) |
511 |
|
(r1 += (r2 + 32)) |
512 |
|
(translate-character |
513 |
|
utf-translation-table-for-decode r0 r1))) |
514 |
(write-multibyte-character r0 r1) |
(write-multibyte-character r0 r1) |
515 |
(read r0) |
(read r0) |
516 |
(repeat)) |
(repeat)) |
517 |
(if (r1 >= 160) |
(if (r1 >= 160) |
518 |
;; latin-iso8859-1 |
;; latin-iso8859-1 |
519 |
((r1 -= 128) |
((r0 = r1) |
520 |
(write-multibyte-character r6 r1) |
(lookup-integer utf-subst-table-for-decode r0 r1) |
521 |
|
(if (r7 == 0) |
522 |
|
((r1 -= 128) |
523 |
|
(write-multibyte-character r6 r1)) |
524 |
|
((write-multibyte-character r0 r1))) |
525 |
(read r0) |
(read r0) |
526 |
(repeat)) |
(repeat)) |
527 |
;; eight-bit-control |
;; eight-bit-control |
560 |
|
|
561 |
(if (r3 < #x2500) |
(if (r3 < #x2500) |
562 |
;; mule-unicode-0100-24ff (>= 0800) |
;; mule-unicode-0100-24ff (>= 0800) |
563 |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
((r0 = r3) |
564 |
(r3 -= #x0100) |
(lookup-integer utf-subst-table-for-decode r0 r1) |
565 |
(r3 //= 96) |
(if (r7 == 0) |
566 |
(r1 = (r7 + 32)) |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
567 |
(r1 += ((r3 + 32) << 7)) |
(r3 -= #x0100) |
568 |
(translate-character |
(r3 //= 96) |
569 |
utf-translation-table-for-decode r0 r1) |
(r1 = (r7 + 32)) |
570 |
|
(r1 += ((r3 + 32) << 7)) |
571 |
|
(translate-character |
572 |
|
utf-translation-table-for-decode r0 r1))) |
573 |
(write-multibyte-character r0 r1) |
(write-multibyte-character r0 r1) |
574 |
(read r0) |
(read r0) |
575 |
(repeat))) |
(repeat))) |
955 |
hash-table ch) |
hash-table ch) |
956 |
(set-buffer-multibyte t) |
(set-buffer-multibyte t) |
957 |
(when utf-translate-cjk-mode |
(when utf-translate-cjk-mode |
958 |
(if (not utf-translate-cjk-lang-env) |
(unless utf-translate-cjk-lang-env |
959 |
;; Check these characters: |
;; Check these characters in utf-translate-cjk-range. |
960 |
;; "U+2e80-U+33ff", "U+ff00-U+ffef" |
;; We may have to translate them to CJK charsets. |
961 |
;; We may have to translate them to CJK charsets. |
(skip-chars-forward |
962 |
(let ((range2 "$,29@(B-$,2G$,3r`(B-$,3u/(B")) |
(concat range utf-translate-cjk-unicode-range-string)) |
963 |
(skip-chars-forward (concat range range2)) |
(unless (eobp) |
964 |
(unless (eobp) |
(utf-translate-cjk-load-tables) |
965 |
(utf-translate-cjk-load-tables) |
(setq range |
966 |
(setq range (concat range range2))) |
(concat range utf-translate-cjk-unicode-range-string))) |
967 |
(setq hash-table (get 'utf-subst-table-for-decode |
(setq hash-table (get 'utf-subst-table-for-decode |
968 |
'translation-hash-table))))) |
'translation-hash-table)))) |
969 |
(while (and (skip-chars-forward range) |
(while (and (skip-chars-forward range) |
970 |
(not (eobp))) |
(not (eobp))) |
971 |
(setq ch (following-char)) |
(setq ch (following-char)) |