26 |
|
|
27 |
;;; Commentary: |
;;; Commentary: |
28 |
|
|
29 |
;; The coding-system `mule-utf-8' supports encoding/decoding of the |
;; The coding-system `mule-utf-8' basically supports encoding/decoding |
30 |
;; following character sets to and from UTF-8: |
;; of the following character sets to and from UTF-8: |
31 |
;; |
;; |
32 |
;; ascii |
;; ascii |
33 |
;; eight-bit-control |
;; eight-bit-control |
36 |
;; mule-unicode-2500-33ff |
;; mule-unicode-2500-33ff |
37 |
;; mule-unicode-e000-ffff |
;; mule-unicode-e000-ffff |
38 |
;; |
;; |
|
;; Characters of other character sets cannot be encoded with |
|
|
;; mule-utf-8. Note that the mule-unicode charsets currently lack |
|
|
;; case and syntax information, so things like `downcase' will only |
|
|
;; work for characters from ASCII and Latin-1. |
|
|
;; |
|
39 |
;; On decoding, Unicode characters that do not fit into the above |
;; On decoding, Unicode characters that do not fit into the above |
40 |
;; character sets are handled as `eight-bit-control' or |
;; character sets are handled as `eight-bit-control' or |
41 |
;; `eight-bit-graphic' characters to retain the information about the |
;; `eight-bit-graphic' characters to retain the information about the |
42 |
;; original byte sequence. |
;; original byte sequence. |
43 |
|
;; |
44 |
|
;; Characters from other character sets can be encoded with |
45 |
|
;; mule-utf-8 by populating the table `ucs-mule-to-mule-unicode' and |
46 |
|
;; registering the translation with `register-char-codings'. |
47 |
|
|
48 |
;; UTF-8 is defined in RFC 2279. A sketch of the encoding is: |
;; UTF-8 is defined in RFC 2279. A sketch of the encoding is: |
49 |
|
|
56 |
|
|
57 |
;;; Code: |
;;; Code: |
58 |
|
|
59 |
|
(defvar ucs-mule-to-mule-unicode (make-translation-table) |
60 |
|
"Translation table for encoding to `mule-utf-8'.") |
61 |
|
;; Could have been done by ucs-tables loaded before. |
62 |
|
(unless (get 'ucs-mule-to-mule-unicode 'translation-table) |
63 |
|
(define-translation-table 'ucs-mule-to-mule-unicode ucs-mule-to-mule-unicode)) |
64 |
(define-ccl-program ccl-decode-mule-utf-8 |
(define-ccl-program ccl-decode-mule-utf-8 |
65 |
;; |
;; |
66 |
;; charset | bytes in utf-8 | bytes in emacs |
;; charset | bytes in utf-8 | bytes in emacs |
234 |
(if (r5 < 0) |
(if (r5 < 0) |
235 |
((r1 = -1) |
((r1 = -1) |
236 |
(read-multibyte-character r0 r1) |
(read-multibyte-character r0 r1) |
237 |
(translate-character ucs-mule-8859-to-mule-unicode r0 r1)) |
(translate-character ucs-mule-to-mule-unicode r0 r1)) |
238 |
(;; We have already done read-multibyte-character. |
(;; We have already done read-multibyte-character. |
239 |
(r0 = r5) |
(r0 = r5) |
240 |
(r1 = r6) |
(r1 = r6) |
348 |
|
|
349 |
;; Dummy definition so that the CCL can be checked correctly; the |
;; Dummy definition so that the CCL can be checked correctly; the |
350 |
;; actual data are loaded on demand. |
;; actual data are loaded on demand. |
351 |
(define-translation-table 'ucs-mule-8859-to-mule-unicode) |
(unless (boundp 'ucs-mule-8859-to-mule-unicode) ; don't zap it |
352 |
|
(define-translation-table 'ucs-mule-8859-to-mule-unicode)) |
353 |
|
|
354 |
(defsubst utf-8-untranslated-to-ucs () |
(defsubst utf-8-untranslated-to-ucs () |
355 |
(let ((b1 (char-after)) |
(let ((b1 (char-after)) |
400 |
(compose-region (point) (+ l (point)) subst) |
(compose-region (point) (+ l (point)) subst) |
401 |
l))) |
l))) |
402 |
|
|
403 |
|
(defcustom utf-8-compose-scripts nil |
404 |
|
"*Non-nil means compose various scipts on decoding utf-8 text." |
405 |
|
:group 'mule |
406 |
|
:type 'boolean) |
407 |
|
|
408 |
|
(autoload 'lao-post-read-conversion "lao-util") ; omitted in Emacs 21.1 |
409 |
|
|
410 |
(defun utf-8-post-read-conversion (length) |
(defun utf-8-post-read-conversion (length) |
411 |
"Compose untranslated utf-8 sequences into single characters." |
"Compose untranslated utf-8 sequences into single characters. |
412 |
|
Also compose particular scripts if `utf-8-compose-scripts' is non-nil." |
413 |
(save-excursion |
(save-excursion |
414 |
(while (and (skip-chars-forward |
(while (and (skip-chars-forward |
415 |
(eval-and-compile ; missing optimization |
(eval-and-compile ; missing optimization |
416 |
(string-as-multibyte "^\341-\377"))) |
(string-as-multibyte "^\341-\377"))) |
417 |
(not (eobp))) |
(not (eobp))) |
418 |
(forward-char (utf-8-compose)))) |
(forward-char (utf-8-compose)))) |
419 |
|
(when (and utf-8-compose-scripts (> length 1)) |
420 |
|
;; These currently have definitions which cover the relevant |
421 |
|
;; Unicodes. We could avoid loading thai-util &c by checking |
422 |
|
;; whether the region contains any characters with the appropriate |
423 |
|
;; categories. |
424 |
|
(save-excursion (diacritic-post-read-conversion length)) |
425 |
|
(save-excursion (thai-post-read-conversion length)) |
426 |
|
(save-excursion (lao-post-read-conversion length))) |
427 |
length) |
length) |
428 |
|
|
429 |
|
;;; (defun utf-8-pre-write-conversion (beg end) |
430 |
|
;;; (require 'ucs-tables) ; ensure translation table is loaded |
431 |
|
;;; (let ((oldbuff (current-buffer))) |
432 |
|
;;; (set-buffer (generate-new-buffer " *temp*")) |
433 |
|
;;; (if (stringp beg) |
434 |
|
;;; (insert beg) |
435 |
|
;;; (insert-buffer-substring beg end oldbuff)) |
436 |
|
;;; ;; Look for 8-bit-graphic characters that haven't been marked as |
437 |
|
;;; ;; untranslated, and UTF-8-encode them. |
438 |
|
;;; (goto-char (point-min)) |
439 |
|
;;; (while (and (skip-chars-forward (eval-and-compile |
440 |
|
;;; (string-as-multibyte "^\240-\377"))) |
441 |
|
;;; (not (eobp))) |
442 |
|
;;; (if (get-text-property (point) 'untranslated-utf-8) |
443 |
|
;;; (forward-char) |
444 |
|
;;; (let ((c (char-after))) |
445 |
|
;;; (delete-char 1) |
446 |
|
;;; (insert (make-char 'latin-iso8859-1 (- c 128))))))) |
447 |
|
;;; nil) |
448 |
|
|
449 |
(defun utf-8-pre-write-conversion (beg end) |
(defun utf-8-pre-write-conversion (beg end) |
450 |
(require 'ucs-tables) ; ensure translation table is loaded |
"Semi-dummy pre-write function effectively to autoload ucs-tables." |
451 |
(when (stringp beg) |
;; Ensure translation table is loaded. |
452 |
(set-buffer (generate-new-buffer " *temp*")) |
(require 'ucs-tables) |
453 |
(insert beg) |
;; Don't do this again. |
454 |
(setq end (1+ (length beg))) |
(coding-system-put 'mule-utf-8 'pre-write-conversion nil) |
|
(setq beg 1)) |
|
|
;; Look for 8-bit-graphic characters that haven't been marked as |
|
|
;; untranslated, and UTF-8-encode them. |
|
|
(save-excursion |
|
|
(save-restriction |
|
|
(narrow-to-region beg end) |
|
|
(goto-char beg) |
|
|
(while (and (skip-chars-forward (eval-and-compile |
|
|
(string-as-multibyte "^\240-\377"))) |
|
|
(not (eobp))) |
|
|
(if (get-text-property (point) 'untranslated-utf-8) |
|
|
(forward-char) |
|
|
(let ((c (char-after))) |
|
|
(delete-char 1) |
|
|
(insert (make-char 'latin-iso8859-1 (- c 128)))))))) |
|
455 |
nil) |
nil) |
456 |
|
|
457 |
(make-coding-system |
(make-coding-system |
458 |
'mule-utf-8 4 ?u |
'mule-utf-8 4 ?u |
459 |
"UTF-8 encoding for Emacs-supported Unicode characters. |
"UTF-8 encoding for Emacs-supported Unicode characters. |
460 |
The supported Emacs character sets are the following, determined by the |
The supported Emacs character sets are the following, plus others |
461 |
translation table `ucs-mule-8859-to-mule-unicode': |
which may be included in the translation table |
462 |
ascii |
`ucs-mule-8859-to-mule-unicode': |
463 |
eight-bit-control |
ascii |
464 |
eight-bit-graphic |
eight-bit-control |
465 |
latin-iso8859-1 |
eight-bit-graphic |
466 |
latin-iso8859-2 |
latin-iso8859-1 |
467 |
latin-iso8859-3 |
latin-iso8859-2 |
468 |
latin-iso8859-4 |
latin-iso8859-3 |
469 |
cyrillic-iso8859-5 |
latin-iso8859-4 |
470 |
greek-iso8859-7 |
cyrillic-iso8859-5 |
471 |
hebrew-iso8859-8 |
greek-iso8859-7 |
472 |
latin-iso8859-9 |
hebrew-iso8859-8 |
473 |
latin-iso8859-14 |
latin-iso8859-9 |
474 |
latin-iso8859-15 |
latin-iso8859-14 |
475 |
mule-unicode-0100-24ff |
latin-iso8859-15 |
476 |
mule-unicode-2500-33ff |
mule-unicode-0100-24ff |
477 |
mule-unicode-e000-ffff |
mule-unicode-2500-33ff |
478 |
|
mule-unicode-e000-ffff |
479 |
|
|
480 |
Unicode characters out of the ranges U+0000-U+33FF and U+E200-U+FFFF |
Unicode characters out of the ranges U+0000-U+33FF and U+E200-U+FFFF |
481 |
are decoded into sequences of eight-bit-control and eight-bit-graphic |
are decoded into sequences of eight-bit-control and eight-bit-graphic |
482 |
characters to preserve their byte sequences and composed to behave as |
characters to preserve their byte sequences and composed to display as |
483 |
a single character when editing. Emacs characters out of these ranges |
a single character. Emacs characters that can't be encoded to these |
484 |
are encoded into U+FFFD." |
ranges are encoded as U+FFFD." |
485 |
|
|
486 |
'(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8) |
'(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8) |
487 |
'((safe-charsets |
'((safe-charsets |
504 |
(mime-charset . utf-8) |
(mime-charset . utf-8) |
505 |
(coding-category . coding-category-utf-8) |
(coding-category . coding-category-utf-8) |
506 |
(valid-codes (0 . 255)) |
(valid-codes (0 . 255)) |
507 |
(post-read-conversion . utf-8-post-read-conversion) |
(pre-write-conversion . utf-8-pre-write-conversion) |
508 |
(pre-write-conversion . utf-8-pre-write-conversion))) |
(post-read-conversion . utf-8-post-read-conversion))) |
509 |
|
|
510 |
(define-coding-system-alias 'utf-8 'mule-utf-8) |
(define-coding-system-alias 'utf-8 'mule-utf-8) |
511 |
|
|
512 |
;; I think this needs special private charsets defined for the |
;; I think this needs special private charsets defined for the |
513 |
;; untranslated sequences, if it's going to work well. |
;; untranslated sequences, if it's going to work well. |
514 |
|
|
515 |
;; (defun utf-8-compose-function (pos to pattern &optional string) |
;;; (defun utf-8-compose-function (pos to pattern &optional string) |
516 |
;; (let* ((prop (get-char-property pos 'composition string)) |
;;; (let* ((prop (get-char-property pos 'composition string)) |
517 |
;; (l (and prop (- (cadr prop) (car prop))))) |
;;; (l (and prop (- (cadr prop) (car prop))))) |
518 |
;; (cond ((and l (> l (- to pos))) |
;;; (cond ((and l (> l (- to pos))) |
519 |
;; (delete-region pos to)) |
;;; (delete-region pos to)) |
520 |
;; ((and (> (char-after pos) 224) |
;;; ((and (> (char-after pos) 224) |
521 |
;; (< (char-after pos) 256) |
;;; (< (char-after pos) 256) |
522 |
;; (save-restriction |
;;; (save-restriction |
523 |
;; (narrow-to-region pos to) |
;;; (narrow-to-region pos to) |
524 |
;; (utf-8-compose))) |
;;; (utf-8-compose))) |
525 |
;; t)))) |
;;; t)))) |
526 |
|
|
527 |
;; (dotimes (i 96) |
;;; (dotimes (i 96) |
528 |
;; (aset composition-function-table |
;;; (aset composition-function-table |
529 |
;; (+ 128 i) |
;;; (+ 128 i) |
530 |
;; `((,(string-as-multibyte "[\200-\237\240-\377]") |
;;; `((,(string-as-multibyte "[\200-\237\240-\377]") |
531 |
;; . utf-8-compose-function)))) |
;;; . utf-8-compose-function)))) |
532 |
|
|
533 |
;;; utf-8.el ends here |
;;; utf-8.el ends here |