Modify the coding system compound-text-with-extensions to conform to the spec of Compound Text.

4 files changed, 104 insertions, 81 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 670f07c2683..775ddcdc2e7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2010-08-04  Kenichi Handa  <handa@m17n.org>
+
+        * language/cyrillic.el: Don't add "microsoft-cp1251" to
+        ctext-non-standard-encodings-alist here.
+
+        * international/mule.el (ctext-non-standard-encodings-alist): Add
+        "koi8-r" and "microsoft-cp1251".
+        (ctext-standard-encodings): New variable.
+        (ctext-non-standard-encodings-table): List only elements for
+        non-standard encodings.
+        (ctext-pre-write-conversion): Adjusted for the above change.
+        Check ctext-standard-encodings.
+
+        * international/mule-conf.el (compound-text): Doc fix.
+        (ctext-no-compositions): Doc fix.
+        (compound-text-with-extensions): Doc fix.
+
 2010-07-23  Juanma Barranquero  <lekktu@gmail.com>
 
         * help-fns.el (find-lisp-object-file-name): Doc fix (bug#6494).
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index f53b69eed8b..9ee8d22463a 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1410,9 +1410,10 @@ is treated as a character."
   :flags '(ascii-at-eol ascii-at-cntl designation single-shift composition))
 
 (define-coding-system 'compound-text
-  "Compound text based generic encoding for decoding unknown messages.
-
-This coding system does not support extended segments of CTEXT."
+  "Compound text based generic encoding.
+This coding system is an extension of X's \"Compound Text Encoding\".
+It encodes many characters using the normal ISO-2022 designation sequences,
+but it doesn't support extended segments of CTEXT."
   :coding-type 'iso-2022
   :mnemonic ?x
   :charset-list 'iso-2022
@@ -1432,7 +1433,7 @@ This coding system does not support extended segments of CTEXT."
 ;; not have a mime-charset property, to prevent it from showing up
 ;; close to the beginning of coding systems ordered by priority.
 (define-coding-system 'ctext-no-compositions
- "Compound text based generic encoding for decoding unknown messages.
+ "Compound text based generic encoding.
 
 Like `compound-text', but does not produce escape sequences for compositions."
   :coding-type 'iso-2022
@@ -1445,8 +1446,9 @@ Like `compound-text', but does not produce escape sequences for compositions."
 (define-coding-system 'compound-text-with-extensions
  "Compound text encoding with ICCCM Extended Segment extensions.
 
-See the variable `ctext-non-standard-encodings-alist' for the
-detail about how extended segments are handled.
+See the variables `ctext-standard-encodings' and
+`ctext-non-standard-encodings-alist' for the detail about how
+extended segments are handled.
 
 This coding system should be used only for X selections.  It is inappropriate
 for decoding and encoding files, process I/O, etc."
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 7e7e55728c8..e030acbef02 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1408,7 +1408,9 @@ This function is provided for backward compatibility."
   '(("big5-0" big5 2 big5)
     ("ISO8859-14" iso-8859-14 1 latin-iso8859-14)
     ("ISO8859-15" iso-8859-15 1 latin-iso8859-15)
-    ("gbk-0" gbk 2 chinese-gbk)))
+    ("gbk-0" gbk 2 chinese-gbk)
+    ("koi8-r" koi8-r 1 koi8-r)
+    ("microsoft-cp1251" windows-1251 1 windows-1251)))
   "Alist of non-standard encoding names vs the corresponding usages in CTEXT.
 
 It controls how extended segments of a compound text are handled
@@ -1497,6 +1499,20 @@ Each element must be one of the names listed in the variable
       (goto-char (point-min))
       (- (point-max) (point)))))
 
+(defvar ctext-standard-encodings
+  '(ascii latin-jisx0201 katakana-jisx0201
+          latin-iso8859-1 latin-iso8859-2 latin-iso8859-3 latin-iso8859-4
+          greek-iso8859-7 arabic-iso8859-6 hebrew-iso8859-8 cyrillic-iso8859-5
+          latin-iso8859-9
+          chinese-gb2312 japanese-jisx0208 korean-ksc5601)
+  "List of approved standard encodings (i.e. charsets) of X's Compound Text.
+Coding-system `compound-text-with-extensions' encodes a character
+belonging to any of those charsets using the normal ISO2022
+designation sequence unless the current language environment or
+the variable `ctext-non-standard-encodings' decide to use an extended
+segment of CTEXT for that character.  See also the documentation
+of `ctext-non-standard-encodings-alist'.")
+
 ;; Return an alist of CHARSET vs CTEXT-USAGE-INFO generated from
 ;; `ctext-non-standard-encodings' and a list specified by the key
 ;; `ctext-non-standard-encodings' for the currrent language
@@ -1508,77 +1524,74 @@ Each element must be one of the names listed in the variable
 ;; is encoded using UTF-8 encoding extention.
 
 (defun ctext-non-standard-encodings-table ()
-  (let (table)
-    ;; Setup charsets specified by the key
-    ;; `ctext-non-standard-encodings' for the current language
-    ;; environment and in `ctext-non-standard-encodings'.
-    (dolist (encoding (append
-                        (get-language-info current-language-environment
-                                           'ctext-non-standard-encodings)
-                        ctext-non-standard-encodings))
-      (let* ((slot (assoc encoding ctext-non-standard-encodings-alist))
+  (let* ((table (append ctext-non-standard-encodings
+                        (copy-sequence
+                         (get-language-info current-language-environment
+                                            'ctext-non-standard-encodings))))
+         (tail table)
+         elt)
+    (while tail
+      (setq elt (car tail))
+      (let* ((slot (assoc elt ctext-non-standard-encodings-alist))
              (charset (nth 3 slot)))
         (if (charsetp charset)
-            (push (cons charset slot) table)
-          (dolist (cs charset)
-            (push (cons cs slot) table)))))
-
-    ;; Next prepend charsets for ISO2022 designation sequence.
-    (dolist (charset charset-list)
-      (let ((final (plist-get (charset-plist charset) :iso-final-char)))
-        (if (and (integerp final)
-                 (>= final #x40) (<= final #x7e)
-                 ;; Exclude ascii and chinese-cns11643-X.
-                 (not (eq charset 'ascii))
-                 (not (string-match "cns11643" (symbol-name charset))))
-            (push (cons charset nil) table))))
-
-    ;; Returned reversed list so that the charsets specified by the
-    ;; key `ctext-non-standard-encodings' for the current language
-    ;; have the highest priority.
-    (nreverse table)))
+            (setcar tail (cons charset slot))
+          (setcar tail (cons (car charset) slot))
+          (dolist (cs (cdr charset))
+            (setcdr tail
+                    (cons (cons (car cs) slot) (cdr tail)))
+            (setq tail (cdr tail))))
+        (setq tail (cdr tail))))
+    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."
+If FROM is a 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.
     (when (stringp from)
       (set-buffer (generate-new-buffer " *temp"))
       (set-buffer-multibyte (multibyte-string-p from))
-      (insert from))
-
-    ;; 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 ch)
-      (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)
-              ch (char-after last-pos)
-              last-encoding-info (catch 'tag
-                                   (dolist (elt encoding-table)
-                                     (if (encode-char ch (car elt))
-                                         (throw 'tag (cdr elt))))
-                                   'utf-8))
-        (set-marker end-pos (match-end 0))
-        (goto-char (1+ last-pos))
-        (catch 'tag
-          (while t
-            (setq encoding-info
-                  (if (< (point) end-pos)
-                      (catch 'tag
-                        (setq ch (following-char))
-                        (dolist (elt encoding-table)
-                          (if (encode-char ch (car elt))
-                              (throw 'tag (cdr elt))))
-                        'utf-8)))
+      (insert from)
+      (setq from 1 to (point-max)))
+    (save-restriction
+      (narrow-to-region from to)
+      (let ((encoding-table (ctext-non-standard-encodings-table))
+            (charset-list ctext-standard-encodings)
+            last-coding-system-used
+            last-pos last-encoding-info
+            encoding-info end-pos ch charset)
+        (dolist (elt encoding-table)
+          (push (car elt) charset-list))
+        (goto-char (setq last-pos from))
+        (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)
+                ch (char-after last-pos)
+                charset (char-charset ch charset-list)
+                last-encoding-info
+                (if charset
+                    (or (cdr (assq charset encoding-table))
+                        charset)
+                  'utf-8))
+          (set-marker end-pos (match-end 0))
+          (goto-char (1+ last-pos))
+          (while (marker-position end-pos)
+            (if (< (point) end-pos)
+                (progn
+                  (setq charset (char-charset (following-char) charset-list)
+                        encoding-info
+                        (if charset
+                            (or (cdr (assq charset encoding-table))
+                                charset)
+                          'utf-8))
+                  (forward-char 1))
+              (setq encoding-info nil)
+              (set-marker end-pos nil))
             (unless (eq last-encoding-info encoding-info)
               (cond ((consp last-encoding-info)
                      ;; Encode the previous range using an extended
@@ -1609,14 +1622,12 @@ and convert it in the temporary buffer.  Otherwise, convert in-place."
                      (save-excursion
                        (goto-char last-pos)
                        (insert "\e%G"))
-                     (insert "\e%@")))
+                     (insert "\e%@"))
+                    (t
+                     (put-text-property last-pos (point) 'charset charset)))
               (setq last-pos (point)
-                    last-encoding-info encoding-info))
-            (if (< (point) end-pos)
-                (forward-char 1)
-              (throw 'tag nil)))))
-      (set-marker end-pos nil)
-      (goto-char (point-min))))
+                    last-encoding-info encoding-info))))
+        (goto-char (point-min)))))
   ;; Must return nil, as build_annotations_2 expects that.
   nil)
 
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index 7d2f082579f..b293ad1ff0b 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -239,13 +239,6 @@ Support for Russian using koi8-r and the russian-computer input method.")
            (documentation . "Support for Tajik using KOI8-T."))
  '("Cyrillic"))
 
-(let ((elt `("microsoft-cp1251" windows-1251 1
-             ,(get 'encode-windows-1251 'translation-table)))
-      (slot (assoc "microsoft-cp1251" ctext-non-standard-encodings-alist)))
-  (if slot
-      (setcdr slot (cdr elt))
-    (push elt ctext-non-standard-encodings-alist)))
-
 (set-language-info-alist
  "Bulgarian" `((coding-system windows-1251)
                (coding-priority windows-1251)