Mercurial > emacs
comparison lisp/international/mule.el @ 46505:005d282a48ed
(decode-char): Use utf-8-translation-table-for-decode.
(encode-char): Use ucs-mule-to-mule-unicode.
| author | Dave Love <fx@gnu.org> |
|---|---|
| date | Wed, 17 Jul 2002 19:20:01 +0000 |
| parents | 2d28ee240bd7 |
| children | 253e228beb5f |
comparison
equal
deleted
inserted
replaced
| 46504:2d28ee240bd7 | 46505:005d282a48ed |
|---|---|
| 305 | 305 |
| 306 (defun decode-char (ccs code-point &optional restriction) | 306 (defun decode-char (ccs code-point &optional restriction) |
| 307 "Return character specified by coded character set CCS and CODE-POINT in it. | 307 "Return character specified by coded character set CCS and CODE-POINT in it. |
| 308 Return nil if such a character is not supported. | 308 Return nil if such a character is not supported. |
| 309 Currently the only supported coded character set is `ucs' (ISO/IEC | 309 Currently the only supported coded character set is `ucs' (ISO/IEC |
| 310 10646: Universal Multi-Octet Coded Character Set). | 310 10646: Universal Multi-Octet Coded Character Set), and the result is |
| 311 translated through the char table `utf-8-translation-table-for-decode'. | |
| 311 | 312 |
| 312 Optional argument RESTRICTION specifies a way to map the pair of CCS | 313 Optional argument RESTRICTION specifies a way to map the pair of CCS |
| 313 and CODE-POINT to a character. Currently not supported and just ignored." | 314 and CODE-POINT to a character. Currently not supported and just ignored." |
| 314 (cond ((eq ccs 'ucs) | 315 (cond |
| 315 (cond ((< code-point 160) | 316 ((eq ccs 'ucs) |
| 316 code-point) | 317 (let ((c (cond |
| 317 ((< code-point 256) | 318 ((< code-point 160) |
| 318 (make-char 'latin-iso8859-1 code-point)) | 319 code-point) |
| 319 ((< code-point #x2500) | 320 ((< code-point 256) |
| 320 (setq code-point (- code-point #x0100)) | 321 (make-char 'latin-iso8859-1 code-point)) |
| 321 (make-char 'mule-unicode-0100-24ff | 322 ((< code-point #x2500) |
| 322 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) | 323 (setq code-point (- code-point #x0100)) |
| 323 ((< code-point #x3400) | 324 (make-char 'mule-unicode-0100-24ff |
| 324 (setq code-point (- code-point #x2500)) | 325 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) |
| 325 (make-char 'mule-unicode-2500-33ff | 326 ((< code-point #x3400) |
| 326 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) | 327 (setq code-point (- code-point #x2500)) |
| 327 ((and (>= code-point #xe000) (< code-point #x10000)) | 328 (make-char 'mule-unicode-2500-33ff |
| 328 (setq code-point (- code-point #xe000)) | 329 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) |
| 329 (make-char 'mule-unicode-e000-ffff | 330 ((and (>= code-point #xe000) (< code-point #x10000)) |
| 330 (+ (/ code-point 96) 32) (+ (% code-point 96) 32))) | 331 (setq code-point (- code-point #xe000)) |
| 331 )))) | 332 (make-char 'mule-unicode-e000-ffff |
| 333 (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))))) | |
| 334 (if (and c (aref utf-8-translation-table-for-decode c)) | |
| 335 (aref utf-8-translation-table-for-decode c) | |
| 336 c))))) | |
| 332 | 337 |
| 333 (defun encode-char (char ccs &optional restriction) | 338 (defun encode-char (char ccs &optional restriction) |
| 334 "Return code-point in coded character set CCS that corresponds to CHAR. | 339 "Return code-point in coded character set CCS that corresponds to CHAR. |
| 335 Return nil if CHAR is not included in CCS. | 340 Return nil if CHAR is not included in CCS. |
| 336 Currently the only supported coded character set is `ucs' (ISO/IEC | 341 Currently the only supported coded character set is `ucs' (ISO/IEC |
| 337 10646: Universal Multi-Octet Coded Character Set). | 342 10646: Universal Multi-Octet Coded Character Set), and CHAR is first |
| 343 translated through the char-table `ucs-mule-to-mule-unicode'. | |
| 338 | 344 |
| 339 CHAR should be in one of these charsets: | 345 CHAR should be in one of these charsets: |
| 340 ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff, | 346 ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff, |
| 341 mule-unicode-e000-ffff, eight-bit-control | 347 mule-unicode-e000-ffff, eight-bit-control |
| 342 Otherwise, return nil. | 348 Otherwise, return nil. |
| 343 | 349 |
| 344 Optional argument RESTRICTION specifies a way to map CHAR to a | 350 Optional argument RESTRICTION specifies a way to map CHAR to a |
| 345 code-point in CCS. Currently not supported and just ignored." | 351 code-point in CCS. Currently not supported and just ignored." |
| 346 (let* ((split (split-char char)) | 352 (let* ((split (split-char char)) |
| 347 (charset (car split))) | 353 (charset (car split)) |
| 354 trans) | |
| 348 (cond ((eq ccs 'ucs) | 355 (cond ((eq ccs 'ucs) |
| 356 (setq trans (aref ucs-mule-to-mule-unicode char)) | |
| 357 (if trans | |
| 358 (setq split (split-char trans) | |
| 359 charset (car split))) | |
| 349 (cond ((eq charset 'ascii) | 360 (cond ((eq charset 'ascii) |
| 350 char) | 361 char) |
| 351 ((eq charset 'latin-iso8859-1) | 362 ((eq charset 'latin-iso8859-1) |
| 352 (+ (nth 1 split) 128)) | 363 (+ (nth 1 split) 128)) |
| 353 ((eq charset 'mule-unicode-0100-24ff) | 364 ((eq charset 'mule-unicode-0100-24ff) |