X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchar-db-util.el;h=89e99e564bd1c066e13e62b18c2b38e596f7aec3;hb=69e7f8641ebcf3026cbad95e545c9463223b14ac;hp=b0d07b7a1d4c0d9b75f92bc1ccbd39ab5f0b3a15;hpb=b5ebdf2c6a17025483ceff54d9d893e4ffe88a5d;p=chise%2Fxemacs-chise.git

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index b0d07b7..89e99e5 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -71,6 +71,34 @@
 	(aset v 34 (make-char 'chinese-gb2312 #x62 #x3A)))
     v))
 
+;;;###autoload
+(defun char-ref-p (obj)
+  (and (consp obj)
+       (keywordp (car obj))))
+
+;;;###autoload
+(defun char-ref= (cr1 cr2)
+  (cond ((char-ref-p cr1)
+	 (if (char-ref-p cr2)
+	     (char-spec= (plist-get cr1 :char)
+			 (plist-get cr2 :char))
+	   (char-spec= (plist-get cr1 :char) cr2)))
+	(t
+	 (char-spec= cr1
+		     (if (char-ref-p cr2)
+			 (plist-get cr2 :char)
+		       cr2)))))
+
+;;;###autoload
+(defun char-spec= (cs1 cs2)
+  (if (characterp cs1)
+      (if (characterp cs2)
+	  (eq cs1 cs2)
+	(eq cs1 (find-char cs2)))
+    (if (characterp cs2)
+	(eq (find-char cs1) cs2)
+      (eq (find-char cs1) (find-char cs2)))))
+
 (defun char-attribute-name< (ka kb)
   (cond
    ((find-charset ka)
@@ -116,6 +144,28 @@
    ((symbolp kb)
     nil)))
 
+(defvar char-db-coded-charset-priority-list
+  (let ((rest default-coded-charset-priority-list)
+	dest)
+    (while rest
+      (when (symbolp (car rest))
+	(cond ((memq (car rest)
+		     '(latin-viscii-lower
+		       latin-viscii-upper
+		       ipa
+		       lao
+		       ethiopic
+		       arabic-digit
+		       arabic-1-column
+		       arabic-2-column)))
+	      ((string-match "^ideograph-gt-pj-" (symbol-name (car rest)))
+	       (unless (memq 'ideograph-gt dest)
+		 (setq dest (cons 'ideograph-gt dest))))
+	      (t
+	       (setq dest (cons (car rest) dest)))))
+      (setq rest (cdr rest)))
+    (sort dest #'char-attribute-name<)))
+
 (defun char-db-insert-char-spec (char &optional readable column)
   (unless column
     (setq column (current-column)))
@@ -127,13 +177,18 @@
 		  (if (setq ret (get-char-attribute char 'name))
 		      (setq char-spec (cons (cons 'name ret) char-spec)))
 		  )
-		 ((setq ret (split-char char))
+		 ((setq ret
+			(let ((default-coded-charset-priority-list
+				char-db-coded-charset-priority-list))
+			  (split-char char)))
 		  (setq char-spec (list ret))
 		  (dolist (ccs (delq (car ret) (charset-list)))
 		    (if (or (and (>= (charset-iso-final-char ccs) ?0)
 				 (setq ret (get-char-attribute char ccs)))
 			    (eq ccs 'ideograph-daikanwa))
 			(setq char-spec (cons (cons ccs ret) char-spec))))
+		  (if (null char-spec)
+		      (setq char-spec (split-char char)))
 		  (if (setq ret (get-char-attribute char 'name))
 		      (setq char-spec (cons (cons 'name ret) char-spec)))
 		  )))
@@ -579,6 +634,24 @@
 		      line-breaking))
       (setq attributes (delq '->mojikyo attributes))
       )
+    (when (and (memq 'hanyu-dazidian-vol attributes)
+	       (setq value (get-char-attribute char 'hanyu-dazidian-vol)))
+      (insert (format "(hanyu-dazidian-vol  . %d)%s"
+		      value line-breaking))
+      (setq attributes (delq 'hanyu-dazidian-vol attributes))
+      )
+    (when (and (memq 'hanyu-dazidian-page attributes)
+	       (setq value (get-char-attribute char 'hanyu-dazidian-page)))
+      (insert (format "(hanyu-dazidian-page . %d)%s"
+		      value line-breaking))
+      (setq attributes (delq 'hanyu-dazidian-page attributes))
+      )
+    (when (and (memq 'hanyu-dazidian-char attributes)
+	       (setq value (get-char-attribute char 'hanyu-dazidian-char)))
+      (insert (format "(hanyu-dazidian-char . %d)%s"
+		      value line-breaking))
+      (setq attributes (delq 'hanyu-dazidian-char attributes))
+      )
     (setq rest ccs-attributes)
     (while (and rest
 		(progn
@@ -601,6 +674,7 @@
 		((memq name '(->lowercase
 			      ->uppercase ->titlecase
 			      ->fullwidth <-fullwidth
+			      ->identical
 			      ->vulgar-ideograph <-vulgar-ideograph
 			      ->ancient-ideograph <-ancient-ideograph
 			      ->original-ideograph <-original-ideograph
@@ -727,7 +801,8 @@
 	       (setq value (get-char-attribute char name)))
 	  (insert
 	   (format
-	    (cond ((memq name '(ideograph-daikanwa ideograph-gt))
+	    (cond ((memq name '(ideograph-daikanwa ideograph-gt
+						   ideograph-cbeta))
 		   (if has-long-ccs-name
 		       "(%-26s . %05d)\t; %c%s"
 		     "(%-18s . %05d)\t; %c%s"))
@@ -867,6 +942,9 @@
     (condition-case err
 	(progn
 	  (insert-char-data-with-variant char 'printable)
+	  (unless (char-attribute-alist char)
+	    (insert (format ";; = %c\n"
+			    (apply #'make-char (split-char char)))))
           ;; (char-db-update-comment)
 	  (set-buffer-modified-p nil)
 	  (view-mode the-buf (lambda (buf)