aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2002-09-30 06:39:07 +0000
committerKenichi Handa2002-09-30 06:39:07 +0000
commit0c76a98d614c521ccdd2cff1fe9cd9f51a1577a7 (patch)
treeee5d3ff7c8d6a439fe2418333c3fe36a298b5e97
parent7d38f8fcf6702e5783c45860442922f243ab45ea (diff)
downloademacs-0c76a98d614c521ccdd2cff1fe9cd9f51a1577a7.tar.gz
emacs-0c76a98d614c521ccdd2cff1fe9cd9f51a1577a7.zip
(decode-char): Refer to the translation
hash table named utf-subst-table-for-decode. Refer to the translation table utf-translation-table-for-decode instead of utf-8-translation-table-for-decode. (encode-char): Refer to the translation hash table named utf-subst-table-for-encode. Refer to the translation table utf-translation-table-for-encode instead of utf-8-translation-table-for-encode.
-rw-r--r--lisp/international/mule.el94
1 files changed, 53 insertions, 41 deletions
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 9fda80fe91c..05085149667 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -308,39 +308,47 @@ See also the documentation of `make-char'."
308Return nil if such a character is not supported. 308Return nil if such a character is not supported.
309Currently the only supported coded character set is `ucs' (ISO/IEC 309Currently the only supported coded character set is `ucs' (ISO/IEC
31010646: Universal Multi-Octet Coded Character Set), and the result is 31010646: Universal Multi-Octet Coded Character Set), and the result is
311translated through the char table `utf-8-translation-table-for-decode'. 311translated through the translation-table named
312`utf-translation-table-for-decode' or the translation-hash-table named
313`utf-subst-table-for-decode'.
312 314
313Optional argument RESTRICTION specifies a way to map the pair of CCS 315Optional argument RESTRICTION specifies a way to map the pair of CCS
314and CODE-POINT to a character. Currently not supported and just ignored." 316and CODE-POINT to a character. Currently not supported and just ignored."
315 (cond 317 (cond
316 ((eq ccs 'ucs) 318 ((eq ccs 'ucs)
317 (let ((c (cond 319 (or (gethash code-point
318 ((< code-point 160) 320 (get 'utf-subst-table-for-decode 'translation-hash-table))
319 code-point) 321 (let ((c (cond
320 ((< code-point 256) 322 ((< code-point 160)
321 (make-char 'latin-iso8859-1 code-point)) 323 code-point)
322 ((< code-point #x2500) 324 ((< code-point 256)
323 (setq code-point (- code-point #x0100)) 325 (make-char 'latin-iso8859-1 code-point))
324 (make-char 'mule-unicode-0100-24ff 326 ((< code-point #x2500)
325 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) 327 (setq code-point (- code-point #x0100))
326 ((< code-point #x3400) 328 (make-char 'mule-unicode-0100-24ff
327 (setq code-point (- code-point #x2500)) 329 (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
328 (make-char 'mule-unicode-2500-33ff 330 ((< code-point #x3400)
329 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) 331 (setq code-point (- code-point #x2500))
330 ((and (>= code-point #xe000) (< code-point #x10000)) 332 (make-char 'mule-unicode-2500-33ff
331 (setq code-point (- code-point #xe000)) 333 (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
332 (make-char 'mule-unicode-e000-ffff 334 ((and (>= code-point #xe000) (< code-point #x10000))
333 (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))))) 335 (setq code-point (- code-point #xe000))
334 (if (and c (aref utf-8-translation-table-for-decode c)) 336 (make-char 'mule-unicode-e000-ffff
335 (aref utf-8-translation-table-for-decode c) 337 (+ (/ code-point 96) 32)
336 c))))) 338 (+ (% code-point 96) 32))))))
339 (when c
340 (or (aref (get 'utf-translation-table-for-decode
341 'translation-table) c)
342 c)))))))
337 343
338(defun encode-char (char ccs &optional restriction) 344(defun encode-char (char ccs &optional restriction)
339 "Return code-point in coded character set CCS that corresponds to CHAR. 345 "Return code-point in coded character set CCS that corresponds to CHAR.
340Return nil if CHAR is not included in CCS. 346Return nil if CHAR is not included in CCS.
341Currently the only supported coded character set is `ucs' (ISO/IEC 347Currently the only supported coded character set is `ucs' (ISO/IEC
34210646: Universal Multi-Octet Coded Character Set), and CHAR is first 34810646: Universal Multi-Octet Coded Character Set), and CHAR is first
343translated through the char-table `ucs-mule-to-mule-unicode'. 349translated through the translation-table named
350`utf-translation-table-for-encode' or the translation-hash-table named
351`utf-subst-table-for-encode'.
344 352
345CHAR should be in one of these charsets: 353CHAR should be in one of these charsets:
346 ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff, 354 ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff,
@@ -353,25 +361,29 @@ code-point in CCS. Currently not supported and just ignored."
353 (charset (car split)) 361 (charset (car split))
354 trans) 362 trans)
355 (cond ((eq ccs 'ucs) 363 (cond ((eq ccs 'ucs)
356 (setq trans (aref ucs-mule-to-mule-unicode char)) 364 (or (gethash char (get 'utf-subst-table-for-encode
357 (if trans 365 'translation-hash-table))
358 (setq split (split-char trans) 366 (let ((table (get 'utf-translation-table-for-encode
359 charset (car split))) 367 'translation-table)))
360 (cond ((eq charset 'ascii) 368 (setq trans (aref table char))
361 char) 369 (if trans
362 ((eq charset 'latin-iso8859-1) 370 (setq split (split-char trans)
363 (+ (nth 1 split) 128)) 371 charset (car split)))
364 ((eq charset 'mule-unicode-0100-24ff) 372 (cond ((eq charset 'ascii)
365 (+ #x0100 (+ (* (- (nth 1 split) 32) 96) 373 char)
366 (- (nth 2 split) 32)))) 374 ((eq charset 'latin-iso8859-1)
367 ((eq charset 'mule-unicode-2500-33ff) 375 (+ (nth 1 split) 128))
368 (+ #x2500 (+ (* (- (nth 1 split) 32) 96) 376 ((eq charset 'mule-unicode-0100-24ff)
369 (- (nth 2 split) 32)))) 377 (+ #x0100 (+ (* (- (nth 1 split) 32) 96)
370 ((eq charset 'mule-unicode-e000-ffff) 378 (- (nth 2 split) 32))))
371 (+ #xe000 (+ (* (- (nth 1 split) 32) 96) 379 ((eq charset 'mule-unicode-2500-33ff)
372 (- (nth 2 split) 32)))) 380 (+ #x2500 (+ (* (- (nth 1 split) 32) 96)
373 ((eq charset 'eight-bit-control) 381 (- (nth 2 split) 32))))
374 char)))))) 382 ((eq charset 'mule-unicode-e000-ffff)
383 (+ #xe000 (+ (* (- (nth 1 split) 32) 96)
384 (- (nth 2 split) 32))))
385 ((eq charset 'eight-bit-control)
386 char))))))))
375 387
376 388
377;; Coding system stuff 389;; Coding system stuff