Changeset 3500

Timestamp:

10/11/04 11:07:08 (4 years ago)

Author:

miyoshi

Message:

* ccl.c: Sync up with Emacs CVS HEAD.

* ccl.h: Ditto.

* data.c (Fdefalias): Ditto.

* lisp/international/ccl.el: Ditto.

* lisp/international/mule.el: Ditto.

* lisp/international/ucs-tables.el: Ditto.

* lisp/international/utf-16.el: Ditto.

* lisp/international/utf-8.el: Ditto.

* lisp/international/utf-7.el: New file from Emacs CVS HEAD.

* cus-load.el: Update.

* loaddefs.el: Ditto.

* files.el (set-auto-mode-1): New function from Emacs CVS HEAD.

Files:

• branches/2.2/lisp/ChangeLog.Meadow (modified) (1 diff)
• branches/2.2/lisp/cus-load.el (modified) (5 diffs)
• branches/2.2/lisp/files.el (modified) (1 diff)
• branches/2.2/lisp/international/ccl.el (modified) (13 diffs)
• branches/2.2/lisp/international/mule.el (modified) (35 diffs)
• branches/2.2/lisp/international/ucs-tables.el (modified) (16 diffs)
• branches/2.2/lisp/international/utf-16.el (modified) (6 diffs)
• branches/2.2/lisp/international/utf-7.el (added)
• branches/2.2/lisp/international/utf-8.el (modified) (8 diffs)
• branches/2.2/lisp/loaddefs.el (modified) (25 diffs)
• branches/2.2/src/ChangeLog.Meadow (modified) (1 diff)
• branches/2.2/src/ccl.c (modified) (57 diffs)
• branches/2.2/src/ccl.h (modified) (2 diffs)
• branches/2.2/src/data.c (modified) (1 diff)

branches/2.2/lisp/ChangeLog.Meadow

@@ +1 @@
+2004-10-11  MIYOSHI Masanori  <miyoshi@meadowy.org>
+
+        * international/ccl.el: Sync up with Emacs CVS HEAD.
+
+        * lisp/international/ccl.el: Ditto.
+
+        * lisp/international/mule.el: Ditto.
+
+        * lisp/international/ucs-tables.el: Ditto.
+
+        * lisp/international/utf-16.el: Ditto.
+
+        * lisp/international/utf-8.el: Ditto.
+
+        * lisp/international/utf-7.el: New file from Emacs CVS HEAD.
+
+        * cus-load.el: Update.
+
+        * loaddefs.el: Ditto.
+
+        * files.el (set-auto-mode-1): New function from Emacs CVS HEAD.
+
-2004-10-03  MIYOSHI Masanori  <miyoshi@meadowy.org>
-

branches/2.2/lisp/cus-load.el

@@ -564 +564 @@
-(put 'viper-search 'custom-loads '("viper-init"))
-(put 'ls-lisp 'custom-loads '("ls-lisp"))
-
+utf-8" "
-(put 'glasses 'custom-loads '("glasses"))
-(put 'vhdl-style 'custom-loads '("vhdl-mode"))
@@ -676 +676 @@
-(custom-put-if-not 'ps-line-number-color 'custom-version "21.1")
-(custom-put-if-not 'ps-line-number-color 'standard-value t)
+(custom-put-if-not 'utf-fragment-on-decoding 'custom-version "21.4")
+(custom-put-if-not 'utf-fragment-on-decoding 'standard-value t)
-(custom-put-if-not 'confirm-kill-emacs 'custom-version "21.1")
-(custom-put-if-not 'confirm-kill-emacs 'standard-value t)
@@ -803 +805 @@
-(custom-put-if-not 'gnus-extra-headers 'custom-version "21.1")
-(custom-put-if-not 'gnus-extra-headers 'standard-value t)
+(custom-put-if-not 'utf-8-compose-scripts 'custom-version "21.4")
+(custom-put-if-not 'utf-8-compose-scripts 'standard-value t)
-(custom-put-if-not 'speedbar-use-images 'custom-version "21.1")
-(custom-put-if-not 'speedbar-use-images 'standard-value t)
@@ -1021 +1025 @@
-(custom-put-if-not 'rmail-movemail-flags 'custom-version "20.3")
-(custom-put-if-not 'rmail-movemail-flags 'standard-value t)
-1
+4
-(custom-put-if-not 'keyboard-coding-system 'standard-value t)
-(custom-put-if-not 'sql-sybase-options 'custom-version "20.8")
@@ -1122 +1126 @@
-(custom-put-if-not 'eval-expression-print-level 'standard-value t)
-
-dired" "ange-ftp") ("20.3" "desktop" "easymenu" "dabbrev" "ffap" "rmail" "paren" "mailabbrev" "frame" "uce" "mouse" "diary-lib" "sendmail" "simple" "debug" "hexl" "vcursor" "vc" "compile" "etags" "browse-url" "add-log" "find-func" "cus-edit" "replace") ("21.1" "server" "debug" "rmailedit" "dabbrev" "isearch" "gnus-start" "mule
+mule" "dired" "ange-ftp" "utf-8") ("20.3" "desktop" "easymenu" "dabbrev" "ffap" "rmail" "paren" "mailabbrev" "frame" "uce" "mouse" "diary-lib" "sendmail" "simple" "debug" "hexl" "vcursor" "vc" "compile" "etags" "browse-url" "add-log" "find-func" "cus-edit" "replace") ("21.1" "server" "debug" "rmailedit" "dabbrev" "isearch" "gnus-start
- "For internal use by custom.")
-

branches/2.2/lisp/files.el

@@ -1766 +1766 @@
-                        (funcall (cdr elt))))))))))))
-
+
+(defun set-auto-mode-1 ()
+  "Find the -*- spec in the buffer.
+Call with point at the place to start searching from.
+If one is found, set point to the beginning
+and return the position of the end.
+Otherwise, return nil; point may be changed."
+  (let (beg end)
+    (and
+     ;; Don't look for -*- if this file name matches any
+     ;; of the regexps in inhibit-first-line-modes-regexps.
+     (let ((temp inhibit-first-line-modes-regexps)
+           (name (if buffer-file-name
+                     (file-name-sans-versions buffer-file-name)
+                   (buffer-name))))
+       (while (let ((sufs inhibit-first-line-modes-suffixes))
+                (while (and sufs (not (string-match (car sufs) name)))
+                  (setq sufs (cdr sufs)))
+                sufs)
+         (setq name (substring name 0 (match-beginning 0))))
+       (while (and temp
+                   (not (string-match (car temp) name)))
+         (setq temp (cdr temp)))
+       (not temp))
+
+     (search-forward "-*-" (save-excursion
+                             ;; If the file begins with "#!"
+                             ;; (exec interpreter magic), look
+                             ;; for mode frobs in the first two
+                             ;; lines.  You cannot necessarily
+                             ;; put them in the first line of
+                             ;; such a file without screwing up
+                             ;; the interpreter invocation.
+                             (end-of-line (and (looking-at "^#!") 2))
+                             (point)) t)
+     (progn
+       (skip-chars-forward " \t")
+       (setq beg (point))
+       (search-forward "-*-"
+                       (save-excursion (end-of-line) (point))
+                       t))
+     (progn
+       (forward-char -3)
+       (skip-chars-backward " \t")
+       (setq end (point))
+       (goto-char beg)
+       end))))
+
-(defun hack-local-variables-prop-line ()
-  "Set local variables specified in the -*- line.

branches/2.2/lisp/international/ccl.el

@@ -3 +3 @@
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Keywords: CCL, mule, multilingual, character set, coding-system
@@ -26 +27 @@
-
-;; CCL (Code Conversion Language) is a simple programming language to
-
-
-of
+A 
+the 
+in
-;;
-;; CCL is used for code conversion at process I/O and file I/O for
-
-a code point of X's font from a character code
+s
+code points of X fonts from character codes
-;; However, since CCL is designed as a powerful programming language,
-;; it can be used for more generic calculation.  For instance,
-;; combination of three or more arithmetic operations can be
-
+in 
-;;
-Syntax and semantics of CCL program is
+The syntax and semantics of CCL programs are
-;; documentation of `define-ccl-program'.
-
@@ -53 +54 @@
-      read-multibyte-character write-multibyte-character
-      translate-character
-
+
+
-  "Vector of CCL commands (symbols).")
-
@@ -108 +110 @@
-   map-multiple
-   map-single
+   lookup-int-const-tbl
+   lookup-char-const-tbl
-   ]
-  "Vector of CCL extended compiled codes (symbols).")
@@ -197 +201 @@
-;; Embed pair of SYMBOL and PROP where (get SYMBOL PROP) should give
-;; proper index number for SYMBOL.  PROP should be
-code-conversion-map-id', or
-
+translation-hash-table-id'
+ode-conversion-map-id', or `c
-(defun ccl-embed-symbol (symbol prop)
-  (ccl-embed-data (cons symbol prop)))
@@ -771 +775 @@
-               (ccl-embed-code 'write-expr-register 0
-                               (logior (ash op 3)
-
+
+
-
-          (t
@@ -832 +837 @@
-           (ccl-check-register Rrr cmd)
-           (ccl-embed-extended-command 'translate-character rrr RRR Rrr))))
+  nil)
+
+;; Compile lookup-integer
+(defun ccl-compile-lookup-integer (cmd)
+  (if (/= (length cmd) 4)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (let ((Rrr (nth 1 cmd))
+        (RRR (nth 2 cmd))
+        (rrr (nth 3 cmd)))
+    (ccl-check-register RRR cmd)
+    (ccl-check-register rrr cmd)
+    (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number)))
+           (ccl-embed-extended-command 'lookup-int-const-tbl
+                                       rrr RRR 0)
+           (ccl-embed-symbol Rrr 'translation-hash-table-id))
+          (t
+           (error "CCL: non-constant table: %s" cmd)
+           ;; not implemented:
+           (ccl-check-register Rrr cmd)
+           (ccl-embed-extended-command 'lookup-int rrr RRR 0))))
+  nil)
+
+;; Compile lookup-character
+(defun ccl-compile-lookup-character (cmd)
+  (if (/= (length cmd) 4)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (let ((Rrr (nth 1 cmd))
+        (RRR (nth 2 cmd))
+        (rrr (nth 3 cmd)))
+    (ccl-check-register RRR cmd)
+    (ccl-check-register rrr cmd)
+    (cond ((and (symbolp Rrr) (not (get Rrr 'ccl-register-number)))
+           (ccl-embed-extended-command 'lookup-char-const-tbl
+                                       rrr RRR 0)
+           (ccl-embed-symbol Rrr 'translation-hash-table-id))
+          (t
+           (error "CCL: non-constant table: %s" cmd)
+           ;; not implemented:
+           (ccl-check-register Rrr cmd)
+           (ccl-embed-extended-command 'lookup-char rrr RRR 0))))
-  nil)
-
@@ -906 +951 @@
-
-
-affs
+uff
-
-;; To avoid byte-compiler warning.
@@ -1076 +1121 @@
-
-(defun ccl-dump-call (ignore cc)
-
+
+
-
-(defun ccl-dump-write-const-string (rrr cc)
@@ -1193 +1239 @@
-    (insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr))))
-
+(defun ccl-dump-lookup-int-const-tbl (rrr RRR Rrr)
+  (let ((tbl (ccl-get-next-code)))
+    (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
+
+(defun ccl-dump-lookup-char-const-tbl (rrr RRR Rrr)
+  (let ((tbl (ccl-get-next-code)))
+    (insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
+
-(defun ccl-dump-iterate-multiple-map (rrr RRR Rrr)
-  (let ((notbl (ccl-get-next-code))
@@ -1272 +1326 @@
-STATEMENT :=
-        SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL
-
+MAP | LOOKUP | 
-
-SET :=  (REG = EXPRESSION)
@@ -1439 +1493 @@
-        | (translate-character SYMBOL REG(charset) REG(codepoint))
-        ;; SYMBOL must refer to a table defined by `define-translation-table'.
+LOOKUP :=
+        (lookup-character SYMBOL REG(charset) REG(codepoint))
+        | (lookup-integer SYMBOL REG(integer))
+        ;; SYMBOL refers to a table defined by `define-translation-hash-table'.
-MAP :=
-     (iterate-multiple-map REG REG MAP-IDs)
@@ -1484 +1542 @@
-(provide 'ccl)
-
+;;; arch-tag: 836bcd27-63a1-4a56-b232-1145ecf823fb
-;;; ccl.el ends here

branches/2.2/lisp/international/mule.el

@@ -2 +2 @@
-
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
-
-;; Keywords: mule, multilingual, character set, coding system
@@ -65 +65 @@
-          (message "Loading %s..." file)))
-      (when purify-flag
-setq preloaded-file-list (cons file preloaded-file-list)
+push file preloaded-file-list
-      (unwind-protect
-          (let ((load-file-name fullname)
@@ -270 +270 @@
-code in CHARSET.
-
-
+
+
+
+
+
-  (make-char-internal (charset-id charset) code1 code2))
-
@@ -304 +308 @@
-Return nil if such a character is not supported.
-Currently the only supported coded character set is `ucs' (ISO/IEC
-
+
+
+
+
-
-Optional argument RESTRICTION specifies a way to map the pair of CCS
-and CODE-POINT to a character.  Currently not supported and just ignored."
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-(defun encode-char (char ccs &optional restriction)
@@ -333 +347 @@
-10646: Universal Multi-Octet Coded Character Set), and CHAR is first
-translated through the translation-table named
-
+
+
-
-CHAR should be in one of these charsets:
@@ -343 +358 @@
-code-point in CCS.  Currently not supported and just ignored."
-  (let* ((split (split-char char))
-
+
+
-    (cond ((eq ccs 'ucs)
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
@@ -495 +512 @@
-  (get coding-system 'eol-type))
-
+(defun coding-system-eol-type-mnemonic (coding-system)
+  "Return the string indicating end-of-line format of CODING-SYSTEM."
+  (let* ((eol-type (coding-system-eol-type coding-system))
+         (val (cond ((eq eol-type 0) eol-mnemonic-unix)
+                    ((eq eol-type 1) eol-mnemonic-dos)
+                    ((eq eol-type 2) eol-mnemonic-mac)
+                    (t eol-mnemonic-undecided))))
+    (if (stringp val)
+        val
+      (char-to-string val))))
+
-(defun coding-system-lessp (x y)
-  (cond ((eq x 'no-conversion) t)
@@ -563 +591 @@
-                 (make-char charset (+ i start) (+ start chars -1)))))))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-(defun make-subsidiary-coding-system (coding-system)
@@ -692 +712 @@
-TYPE is an integer value indicating the type of the coding system as follows:
-  0: Emacs internal format,
-
+s
-  2: ISO-2022 including many variants,
-
+s
-  4: private, CCL programs provide encoding/decoding algorithm,
-  5: Raw-text, which means that text contains random 8-bit codes.
@@ -744 +764 @@
-
-  o post-read-conversion
-
+
-  The value is a function to call after some text is inserted and
-  decoded by the coding system itself and before any functions in
@@ -751 +771 @@
-  `after-insert-file-functions', i.e. LENGTH of the text inserted,
-  with point at the head of the text to be decoded.
-
+
-  o pre-write-conversion
-
+
-  The value is a function to call after all functions in
-  `write-region-annotate-functions' and `buffer-file-format' are
@@ -760 +780 @@
-  in `write-region-annotate-functions', i.e. FROM and TO, specifying
-  a region of text.
-
+
-  o translation-table-for-decode
-
+
-  The value is a translation table to be applied on decoding.  See
-  the function `make-translation-table' for the format of translation
-  table.  This is not applicable to type 4 (CCL-based) coding systems.
-
+
-  o translation-table-for-encode
-
+
-  The value is a translation table to be applied on encoding.  This is
-  not applicable to type 4 (CCL-based) coding systems.
-
+
-  o safe-chars
-
+
-  The value is a char table.  If a character has non-nil value in it,
-  the character is safely supported by the coding system.  This
@@ -786 +806 @@
-  it just means that some other receiver of text encoded
-  in the coding system won't be able to handle that charset.
-
+
-  o mime-charset
-
-of which name is
+
+whose name is the
-  the coding system.
-
+
+
+
+
+
+
-  o valid-codes (meaningful only for a coding system based on CCL)
-
+
-  The value is a list to indicate valid byte ranges of the encoded
-  file.  Each element of the list is an integer or a cons of integer.
-  In the former case, the integer value is a valid byte code.  In the
-
+
+
+
+
+
+
-
-These properties are set in PLIST, a property list.  This function
@@ -993 +1023 @@
-                         (get val 'translation-table))
-                    (setq safe-chars (get val 'translation-table)))
-                (register-char-codings coding-system safe-chars)
-                (setq val safe-chars)))
-          (plist-put plist prop val)))
@@ -1027 +1056 @@
-  (put coding-system 'eol-type eol-type)
-
+  (define-coding-system-internal coding-system)
+
-  ;; At last, register CODING-SYSTEM in `coding-system-list' and
-  ;; `coding-system-alist'.
@@ -1055 +1086 @@
-  coding-system)
-
+(put 'safe-chars 'char-table-extra-slots 0)
+
-(defun define-coding-system-alias (alias coding-system)
-  "Define ALIAS as an alias for coding system CODING-SYSTEM."
-  (put alias 'coding-system (coding-system-spec coding-system))
-  (nconc (coding-system-get alias 'alias-coding-systems) (list alias))
-  (add-to-coding-system-list alias)
-  (setq coding-system-alist (cons (list (symbol-name alias))
@@ -1064 +1096 @@
-  (let ((eol-type (coding-system-eol-type coding-system)))
-    (if (vectorp eol-type)
-
+
+
+
-      (put alias 'eol-type eol-type))))
+
+(defun merge-coding-systems (first second)
+  "Fill in any unspecified aspects of coding system FIRST from SECOND.
+Return the resulting coding system."
+  (let ((base (coding-system-base second))
+        (eol (coding-system-eol-type second)))
+    ;; If FIRST doesn't specify text conversion, merge with that of SECOND.
+    (if (eq (coding-system-base first) 'undecided)
+        (setq first (coding-system-change-text-conversion first base)))
+    ;; If FIRST doesn't specify eol conversion, merge with that of SECOND.
+    (if (and (vectorp (coding-system-eol-type first))
+             (numberp eol) (>= eol 0) (<= eol 2))
+        (setq first (coding-system-change-eol-conversion
+                     first eol)))
+    first))
+
+(defun autoload-coding-system (symbol form)
+  "Define SYMBOL as a coding-system that is defined on demand.
+
+FROM is a form to evaluate to define the coding-system."
+  (put symbol 'coding-system-define-form form)
+  (setq coding-system-alist (cons (list (symbol-name symbol))
+                                  coding-system-alist)))
-
-(defun set-buffer-file-coding-system (coding-system &optional force)
@@ -1073 +1130 @@
-use \\[list-coding-systems].
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-This marks the buffer modified so that the succeeding \\[save-buffer]
@@ -1088 +1140 @@
-don't want to mark the buffer modified, just set the variable
-`buffer-file-coding-system' directly."
+  (interactive "zCoding system for saving file (default, nil): \nP")
+  (check-coding-system coding-system)
+  (if (and coding-system buffer-file-coding-system (null force))
+      (setq coding-system
+            (merge-coding-systems coding-system buffer-file-coding-system)))
+  (setq buffer-file-coding-system coding-system)
+  ;; This is in case of an explicit call.  Normally, `normal-mode' and
+  ;; `set-buffer-major-mode-hook' take care of setting the table.
+  (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
+      (ucs-set-table-for-input))
+  (set-buffer-modified-p t)
+  (force-mode-line-update))
+
+(defun revert-buffer-with-coding-system (coding-system &optional force)
+  "Visit the current buffer's file again using coding system CODING-SYSTEM.
+For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
+
+If CODING-SYSTEM leaves the text conversion unspecified, or if it
+leaves the end-of-line conversion unspecified, FORCE controls what to
+do.  If FORCE is nil, get the unspecified aspect (or aspects) from the
+buffer's previous `buffer-file-coding-system' value (if it is
+specified there).  Otherwise, determine it from the file contents as
+usual for visiting a file."
-  (interactive "zCoding system for visited file (default, nil): \nP")
-  (check-coding-system coding-system)
-  (if (and coding-system buffer-file-coding-system (null force))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-(defvar default-terminal-coding-system nil
@@ -1172 +1243 @@
-See Info node `Specify Coding' and Info node `Single-Byte Character Support'.
-
+On non-windowing terminals, this is set from the locale by default.
+
-Setting this variable directly does not take effect;
-M-x customize
+\\[customize]
-  :type '(coding-system :tag "Coding system")
-  :link '(info-link "(emacs)Specify Coding")
@@ -1182 +1255 @@
-             (set-keyboard-coding-system value)
-           (set-default 'keyboard-coding-system nil))) ; must initialize
-1
+4
-  :group 'keyboard
-  :group 'mule)
@@ -1251 +1324 @@
-    (set-coding-priority-internal)))
-
+;;; X selections
+
+(defvar ctext-non-standard-encodings-alist
+  '(("big5-0" big5 2 (chinese-big5-1 chinese-big5-2))
+    ("ISO8859-14" iso-8859-14 1 latin-iso8859-14)
+    ("ISO8859-15" iso-8859-15 1 latin-iso8859-15))
+  "Alist of non-standard encoding names vs the corresponding usages in CTEXT.
+
+It controls how extended segments of a compound text are handled
+by the coding system `compound-text-with-extensions'.
+
+Each element has the form (ENCODING-NAME CODING-SYSTEM N-OCTET CHARSET).
+
+ENCODING-NAME is an encoding name of an \"extended segments\".
+
+CODING-SYSTEM is the coding-system to encode (or decode) the
+characters into (or from) the extended segment.
+
+N-OCTET is the number of octets (bytes) that encodes a character
+in the segment.  It can be 0 (meaning the number of octets per
+character is variable), 1, 2, 3, or 4.
+
+CHARSET is a charater set containing characters that are encoded
+in the segment.  It can be a list of character sets.  It can also
+be a char-table, in which case characters that have non-nil value
+in the char-table are the target.
+
+On decoding CTEXT, all encoding names listed here are recognized.
+
+On encoding CTEXT, encoding names in the variable
+`ctext-non-standard-encodings' (which see) and in the information
+listed for the current language environment under the key
+`ctext-non-standard-encodings' are used.")
+
+(defvar ctext-non-standard-encodings
+  '("big5-0")
+  "List of non-standard encoding names used in extended segments of CTEXT.
+Each element must be one of the names listed in the variable
+`ctext-non-standard-encodings-alist' (which see).")
+
+(defvar ctext-non-standard-encodings-regexp
+  (string-to-multibyte
+   (concat
+    ;; For non-standard encodings.
+    "\\(\e%/[0-4][\200-\377][\200-\377]\\([^\002]+\\)\002\\)"
+    "\\|"
+    ;; For UTF-8 encoding.
+    "\\(\e%G[^\e]*\e%@\\)")))
+
+;; Functions to support "Non-Standard Character Set Encodings" defined
+;; by the COMPOUND-TEXT spec.  They also support "The UTF-8 encoding"
+;; described in the section 7 of the documentation of COMPOUND-TEXT
+;; distributed with XFree86.
+
+(defun ctext-post-read-conversion (len)
+  "Decode LEN characters encoded as Compound Text with Extended Segments."
+  (save-match-data
+    (save-restriction
+      (let ((case-fold-search nil)
+            (in-workbuf (string= (buffer-name) " *code-converting-work*"))
+            last-coding-system-used
+            pos bytes)
+        (or in-workbuf
+            (narrow-to-region (point) (+ (point) len)))
+        (if in-workbuf
+            (set-buffer-multibyte t))
+        (while (re-search-forward ctext-non-standard-encodings-regexp
+                                  nil 'move)
+          (setq pos (match-beginning 0))
+          (if (match-beginning 1)
+              ;; ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
+              (let* ((M (char-after (+ pos 4)))
+                     (L (char-after (+ pos 5)))
+                     (encoding (match-string 2))
+                     (encoding-info (assoc-string
+                                     encoding
+                                     ctext-non-standard-encodings-alist t))
+                     (coding (if encoding-info
+                                 (nth 1 encoding-info)
+                               (setq encoding (intern (downcase encoding)))
+                               (and (coding-system-p encoding)
+                                    encoding))))
+                (setq bytes (- (+ (* (- M 128) 128) (- L 128))
+                               (- (point) (+ pos 6))))
+                (when coding
+                  (delete-region pos (point))
+                  (forward-char bytes)
+                  (decode-coding-region (- (point) bytes) (point) coding)))
+            ;; ESC % G --UTF-8-BYTES-- ESC % @
+            (delete-char -3)
+            (delete-region pos (+ pos 3))
+            (decode-coding-region pos (point) 'utf-8))))
+      (goto-char (point-min))
+      (- (point-max) (point)))))
+
+;; Return a char table of extended segment usage for each character.
+;; Each value of the char table is nil, one of the elements of
+;; `ctext-non-standard-encodings-alist', or the symbol `utf-8'.
+
+(defun ctext-non-standard-encodings-table ()
+  (let ((table (make-char-table 'translation-table)))
+    (aset table (make-char 'mule-unicode-0100-24ff) 'utf-8)
+    (aset table (make-char 'mule-unicode-2500-33ff) 'utf-8)
+    (aset table (make-char 'mule-unicode-e000-ffff) 'utf-8)
+    (dolist (encoding (reverse
+                       (append
+                        (get-language-info current-language-environment
+                                           'ctext-non-standard-encodings)
+                        ctext-non-standard-encodings)))
+      (let* ((slot (assoc encoding ctext-non-standard-encodings-alist))
+             (charset (nth 3 slot)))
+        (if charset
+            (cond ((charsetp charset)
+                   (aset table (make-char charset) slot))
+                  ((listp charset)
+                   (dolist (elt charset)
+                     (aset table (make-char elt) slot)))
+                  ((char-table-p charset)
+                   (map-char-table #'(lambda (k v)
+                                   (if (and v (> k 128)) (aset table k slot)))
+                                   charset))))))
+    table))
+
+(defun ctext-pre-write-conversion (from to)
+  "Encode characters between FROM and TO as Compound Text w/Extended Segments.
+
+If FROM is a string, or if the current buffer is not the one set up for us
+by encode-coding-string, generate a new temp buffer, insert the
+text, and convert it in the temporary buffer.  Otherwise, convert in-place."
+  (save-match-data
+    ;; Setup a working buffer if necessary.
+    (cond ((stringp from)
+           (let ((buf (current-buffer)))
+             (set-buffer (generate-new-buffer " *temp"))
+             (set-buffer-multibyte (multibyte-string-p from))
+             (insert from)))
+          ((not (string= (buffer-name) " *code-converting-work*"))
+           (let ((buf (current-buffer))
+                 (multibyte enable-multibyte-characters))
+             (set-buffer (generate-new-buffer " *temp"))
+             (set-buffer-multibyte multibyte)
+             (insert-buffer-substring buf from to))))
+
+    ;; Now we can encode the whole buffer.
+    (let ((encoding-table (ctext-non-standard-encodings-table))
+          last-coding-system-used
+          last-pos last-encoding-info
+          encoding-info end-pos)
+      (goto-char (setq last-pos (point-min)))
+      (setq end-pos (point-marker))
+      (while (re-search-forward "[^\000-\177]+" nil t)
+        ;; Found a sequence of non-ASCII characters.
+        (setq last-pos (match-beginning 0)
+              last-encoding-info (aref encoding-table (char-after last-pos)))
+        (set-marker end-pos (match-end 0))
+        (goto-char (1+ last-pos))
+        (catch 'tag
+          (while t
+            (setq encoding-info