(char-db-make-char-spec): New function.
authortomo <tomo>
Wed, 30 Oct 2002 03:30:29 +0000 (03:30 +0000)
committertomo <tomo>
Wed, 30 Oct 2002 03:30:29 +0000 (03:30 +0000)
(char-db-insert-char-spec): Use `char-db-make-char-spec'; fix problem
when CHAR does not have available coded-charsets.

lisp/utf-2000/char-db-util.el

index 202670a..78887c1 100644 (file)
     (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))))
                      (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)))
       (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))