(DOUBLE QUESTION MARK): New character.

[chise/xemacs-chise.git-] / lisp / utf-2000 / update-cdb.el

diff --git a/lisp/utf-2000/update-cdb.el b/lisp/utf-2000/update-cdb.el
index 51b98d2..efae357 100644 (file)
--- a/lisp/utf-2000/update-cdb.el
+++ b/lisp/utf-2000/update-cdb.el
@@ -59,8 +59,9 @@
          (setq i (1+ i))))
       (concat dest (substring filename base len))))
 
-  (when (or load-ignore-elc-files
-           (not (file-exists-p system-char-database-directory)))
+  (cond
+   ((or load-ignore-elc-files
+       (not (file-exists-p system-char-database-directory)))
     (if (file-exists-p system-char-database-directory)
        (delete-file-with-children system-char-database-directory))
 
@@ -72,22 +73,66 @@
       (save-char-attribute-table attribute))
 
     (dolist (ccs (charset-list))
-      (save-charset-mapping-table ccs)))
-
-  (mapcar (lambda (file)
-           (reset-char-attribute-table
-            (intern (file-name-char-attribute-name file))))
-         (directory-files
-          (expand-file-name "system-char-id"
-                            system-char-database-directory)
-          nil nil t t))
-  )
+      (save-charset-mapping-table ccs))
+    )
+   (t
+    (mapcar (lambda (file)
+             (mount-char-attribute-table
+              (intern (file-name-char-attribute-name file))))
+           (directory-files
+            (expand-file-name "system-char-id"
+                              system-char-database-directory)
+            nil nil t t))
+    (dolist (ccs (charset-list))
+      (reset-charset-mapping-table ccs))
+    )))
  (t
   (load "dumped-chars.el")
   (dolist (file system-char-db-source-file-list)
     (pureload file))
   ))
 
+(defun char-ref= (cr1 cr2 &optional tester)
+  (cond ((char-ref-p cr1)
+        (if (char-ref-p cr2)
+            (char-spec= (plist-get cr1 :char)
+                        (plist-get cr2 :char) tester)
+          (char-spec= (plist-get cr1 :char) cr2 tester)))
+       (t
+        (char-spec= cr1
+                    (if (char-ref-p cr2)
+                        (plist-get cr2 :char)
+                      cr2)
+                    tester))))
+
+(defun char-spec= (cs1 cs2 &optional tester)
+  (unless tester
+    (setq tester #'eq))
+  (if (characterp cs1)
+      (if (characterp cs2)
+         (funcall tester cs1 cs2)
+       (funcall tester cs1 (find-char cs2)))
+    (if (characterp cs2)
+       (funcall tester (find-char cs1) cs2)
+      (funcall tester (find-char cs1) (find-char cs2)))))
+
+(let (ret)
+  (map-char-attribute
+   (lambda (c dc)
+     (if (consp dc)
+        (setq dc (car dc)))
+     (if (listp dc)
+        (if (setq ret (find-char dc))
+            (setq dc ret)))
+     (when (characterp dc)
+       (setq ret (get-char-attribute dc '->uppercase))
+       (if (if (listp ret)
+              (member* c ret :test #'char-ref=)
+            (char-ref= c ret))
+          (put-case-table-pair c dc (standard-case-table))))
+     nil)
+   '->lowercase))
+
 (garbage-collect)
 
 ;;; update-cdb.el ends here