From: tomo <tomo>
Date: Wed, 30 Oct 2002 03:30:29 +0000 (+0000)
Subject: (char-db-make-char-spec): New function.
X-Git-Tag: r21-2-44-utf-2000-m0_18-jis-x0208-common~10
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0e91db9b80027f95a3ece0fa72de7b52de3c7869;p=chise%2Fxemacs-chise.git-

(char-db-make-char-spec): New function.
(char-db-insert-char-spec): Use `char-db-make-char-spec'; fix problem
when CHAR does not have available coded-charsets.
---

diff --git a/lisp/utf-2000/char-db-util.el b/lisp/utf-2000/char-db-util.el
index 202670a..78887c1 100644
--- a/lisp/utf-2000/char-db-util.el
+++ b/lisp/utf-2000/char-db-util.el
@@ -167,10 +167,8 @@
     (append (sort dest #'char-attribute-name<)
 	    '(chinese-big5-cdp chinese-big5-eten chinese-big5))))
 
-(defun char-db-insert-char-spec (char &optional readable column)
-  (unless column
-    (setq column (current-column)))
-  (let (char-spec ret al cal key temp-char)
+(defun char-db-make-char-spec (char)
+  (let (ret char-spec)
     (cond ((characterp char)
 	   (cond ((and (setq ret (get-char-attribute char 'ucs))
 		       (not (and (<= #xE000 ret)(<= ret #xF8FF))))
@@ -192,11 +190,42 @@
 		      (setq char-spec (split-char char)))
 		  (if (setq ret (get-char-attribute char 'name))
 		      (setq char-spec (cons (cons 'name ret) char-spec)))
-		  )))
+		  ))
+	   char-spec)
 	  ((consp char)
-	   (setq char-spec char)
-	   (setq char nil)))
-    (unless (or char
+	   char))))
+    
+(defun char-db-insert-char-spec (char &optional readable column)
+  (unless column
+    (setq column (current-column)))
+  (let (char-spec ret al cal key temp-char)
+    (setq char-spec (char-db-make-char-spec char))
+    ;; (cond ((characterp char)
+    ;;        (cond ((and (setq ret (get-char-attribute char 'ucs))
+    ;;                    (not (and (<= #xE000 ret)(<= ret #xF8FF))))
+    ;;               (setq char-spec (list (cons 'ucs ret)))
+    ;;               (if (setq ret (get-char-attribute char 'name))
+    ;;                   (setq char-spec (cons (cons 'name ret) char-spec)))
+    ;;               )
+    ;;              ((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)
+    ;;                              (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)))
+    ;;               )))
+    ;;       ((consp char)
+    ;;        (setq char-spec char)
+    ;;        (setq char nil)))
+    (unless (or (characterp char) ; char
 		(condition-case nil
 		    (setq char (find-char char-spec))
 		  (error nil)))
@@ -212,9 +241,20 @@
       (setq key (car (car char-spec)))
       (unless (memq key char-db-ignored-attributes)
 	(if (find-charset key)
-	    (setq cal (cons key cal))
+	    (if (get-char-attribute char key)
+		(setq cal (cons key cal)))
 	  (setq al (cons key al))))
       (setq char-spec (cdr char-spec)))
+    (unless cal
+      (setq char-spec (char-db-make-char-spec char))
+      (while char-spec
+	(setq key (car (car char-spec)))
+	(unless (memq key char-db-ignored-attributes)
+	  (if (find-charset key)
+	      (setq cal (cons key cal))
+	    (setq al (cons key al))))
+	(setq char-spec (cdr char-spec)))
+      )
     (unless (or cal
 		(memq 'ideographic-structure al))
       (push 'ideographic-structure al))