(insert-char-data): Change order.

(insert-char-range-data): Insert variants.
(char-db-update-comment): Fix problem with ascii and
non-ISO-2022-sets; don't insert control-characters.

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index dc740d2..75a9326 100644 (file)
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -158,30 +158,99 @@
            (setq data (del-alist 'numeric-value data))
            )
          )
-       (setq data (sort data
-                        (lambda (a b)
-                          (let ((ka (car a))
-                                (kb (car b)))
-                            (cond ((find-charset ka)
-                                   (cond ((find-charset kb)
-                                          (cond ((= (charset-dimension ka)
-                                                    (charset-dimension kb))
-                                                 (< (charset-final ka)
-                                                    (charset-final kb)))
-                                                (t
-                                                 (< (charset-dimension ka)
-                                                    (charset-dimension kb))
-                                                 )))
-                                         (t)))
-                                  ((find-charset kb)
-                                   t)
-                                  ((symbolp ka)
-                                   (cond ((symbolp kb)
-                                          (string< (symbol-name ka)
-                                                   (symbol-name kb)))
-                                         (t)))
-                                  ((symbolp kb)
-                                   nil))))))
+       (when (setq cell (assq '->decomposition data))
+         (setq cell (cdr cell))
+         (insert (format "(->decomposition\t%s)
+    "
+                         (mapconcat (lambda (code)
+                                      (cond ((symbolp code)
+                                             (symbol-name code))
+                                            ((integerp code)
+                                             (format "#x%04X" code))
+                                            (t
+                                             (format "\n     %S" code))))
+                                    cell " ")))
+         (setq data (del-alist '->decomposition data))
+         )
+       (when (setq cell (assq '->uppercase data))
+         (setq cell (cdr cell))
+         (insert (format "(->uppercase\t%s)
+    "
+                         (mapconcat (lambda (code)
+                                      (cond ((symbolp code)
+                                             (symbol-name code))
+                                            ((integerp code)
+                                             (format "#x%04X" code))
+                                            (t
+                                             (format "\n     %S" code))))
+                                    cell " ")))
+         (setq data (del-alist '->uppercase data))
+         )
+       (when (setq cell (assq '->titlecase data))
+         (setq cell (cdr cell))
+         (insert (format "(->titlecase\t%s)
+    "
+                         (mapconcat (lambda (code)
+                                      (cond ((symbolp code)
+                                             (symbol-name code))
+                                            ((integerp code)
+                                             (format "#x%04X" code))
+                                            (t
+                                             (format "\n     %S" code))))
+                                    cell " ")))
+         (setq data (del-alist '->titlecase data))
+         )
+       (when (setq cell (assq '->lowercase data))
+         (setq cell (cdr cell))
+         (insert (format "(->lowercase\t%s)
+    "
+                         (mapconcat (lambda (code)
+                                      (cond ((symbolp code)
+                                             (symbol-name code))
+                                            ((integerp code)
+                                             (format "#x%04X" code))
+                                            (t
+                                             (format "\n     %S" code))))
+                                    cell " ")))
+         (setq data (del-alist '->lowercase data))
+         )
+       (setq data
+             (sort data
+                   (lambda (a b)
+                     (let ((ka (car a))
+                           (kb (car b)))
+                       (cond ((find-charset ka)
+                              (cond ((find-charset kb)
+                                     (cond ((= (charset-dimension ka)
+                                               (charset-dimension kb))
+                                            (cond
+                                             ((>= (charset-final ka) ?@)
+                                              (if (>= (charset-final kb) ?@)
+                                                  (< (charset-final ka)
+                                                     (charset-final kb))
+                                                t))
+                                             ((>= (charset-final ka) ?0)
+                                              (cond
+                                               ((>= (charset-final kb) ?@)
+                                                nil)
+                                               ((>= (charset-final kb) ?0)
+                                                (< (charset-final ka)
+                                                   (charset-final kb)))
+                                               (t)))))
+                                           (t
+                                            (< (charset-dimension ka)
+                                               (charset-dimension kb))
+                                            )))
+                                    (t)))
+                             ((find-charset kb)
+                              t)
+                             ((symbolp ka)
+                              (cond ((symbolp kb)
+                                     (string< (symbol-name ka)
+                                              (symbol-name kb)))
+                                    (t)))
+                             ((symbolp kb)
+                              nil))))))
        (setq rest data)
        (while (and rest
                    (progn
@@ -240,9 +309,16 @@
        ))))
 
 (defun insert-char-range-data (min max)
-  (let ((code min))
+  (let ((code min)
+       char
+       variants)
     (while (<= code max)
-      (insert-char-data (int-char code))
+      (setq char (int-char code))
+      (insert-char-data char)
+      (setq variants (char-variants char))
+      (while variants
+       (insert-char-data (car variants))
+       (setq variants (cdr variants)))
       (setq code (1+ code))
       )))
 
@@ -251,22 +327,32 @@
     (insert-char-range-data min max)
     (write-region (point-min)(point-max) file)))
 
+;;;###autoload
 (defun char-db-update-comment ()
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (let (cdef table)
+    (let (cdef table char)
       (while (re-search-forward "^[ \t]*\\(([^.()]+)\\)" nil t)
        (goto-char (match-beginning 1))
        (setq cdef (read (current-buffer)))
        (when (find-charset (car cdef))
          (goto-char (match-end 0))
-         (if (setq table (charset-mapping-table (car cdef)))
-             (set-charset-mapping-table (car cdef) nil))
-         (delete-region (point) (point-at-eol))
-         (insert (format "\t; %c" (apply #'make-char cdef)))
-         (if table
-             (set-charset-mapping-table (car cdef) table))
+         (setq char
+               (if (or (eq (car cdef) 'ascii)
+                       (= (char-int (charset-final (car cdef))) 0))
+                   (apply (function make-char) cdef)
+                 (if (setq table (charset-mapping-table (car cdef)))
+                     (set-charset-mapping-table (car cdef) nil))
+                 (prog1
+                     (apply (function make-char) cdef)
+                   (if table
+                       (set-charset-mapping-table (car cdef) table)))))
+         (when (not (or (< (char-int char) 32)
+                        (and (<= (char-int char) 128)
+                             (< (char-int char) 160))))
+           (delete-region (point) (point-at-eol))
+           (insert (format "\t; %c" char)))
          )))))
 
 ;;;###autoload