update.

[chise/ids.git] / ids-find.el

diff --git a/ids-find.el b/ids-find.el
index c7276b7..a4acb71 100644 (file)
--- a/ids-find.el
+++ b/ids-find.el
@@ -599,16 +599,20 @@
 (defun ideographic-character-get-structure (character)
   "Return ideographic-structure of CHARACTER.
 CHARACTER can be a character or char-spec."
-  (let (ret)
-    (cond ((characterp character)
-          (get-char-attribute character 'ideographic-structure)
-          )
-         ((setq ret (assq 'ideographic-structure character))
-          (cdr ret)
-          )
-         ((setq ret (find-char character))
-          (get-char-attribute ret 'ideographic-structure)
-          ))))
+  (mapcar (lambda (cell)
+           (or (and (listp cell)
+                    (find-char cell))
+               cell))
+         (let (ret)
+           (cond ((characterp character)
+                  (get-char-attribute character 'ideographic-structure)
+                  )
+                 ((setq ret (assq 'ideographic-structure character))
+                  (cdr ret)
+                  )
+                 ((setq ret (find-char character))
+                  (get-char-attribute ret 'ideographic-structure)
+                  )))))
 
 ;;;###autoload
 (defun ideographic-char-match-component (char component)
@@ -768,9 +772,15 @@ COMPONENT can be a character or char-spec."
                    (setq sub cell)
                    )))
        (setq cell
-             (if (setq ret (ideographic-structure-find-chars sub))
-                 (car ret)
-               (list (cons 'ideographic-structure sub))))
+             (cond ((setq ret (ideographic-structure-find-chars sub))
+                    (car ret)
+                    )
+                   ((setq ret (ideographic-structure-compact sub))
+                    (list (cons 'ideographic-structure ret))
+                    )
+                   (t
+                    (list (cons 'ideographic-structure sub))))
+             )
        ))
       (setq dest (cons cell dest)))
     (nreverse dest)))
@@ -778,7 +788,8 @@ COMPONENT can be a character or char-spec."
 (defun ideographic-structure-compare-functional-and-apparent (structure
                                                              &optional char
                                                              conversion-only)
-  (let (enc enc-str enc2-str new-str new-str-c f-res a-res ret code)
+  (let (enc enc-str enc2-str enc3-str new-str new-str-c
+           f-res a-res ret code)
     (cond
      ((eq (car structure) ?⿸)
       (setq enc (nth 1 structure))
@@ -839,12 +850,12 @@ COMPONENT can be a character or char-spec."
                (list
                 (cond
                  ((characterp (nth 2 enc-str))
-                  (if (or (eq (encode-char (nth 2 enc-str) '=>ucs@component)
-                              #x20087)
-                          (eq (encode-char (nth 2 enc-str) '=>ucs@component)
-                              #x5382)
-                          (eq (encode-char (nth 2 enc-str) '=>ucs@component)
+                  (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
+                                '(#x20087 #x5382 #x4E06))
+                          (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
                               #x4E06)
+                          (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
+                              #x2E282)
                           (eq (encode-char (nth 2 enc-str) '=big5-cdp)
                               #x89CE)
                           (eq (encode-char (nth 2 enc-str) '=>big5-cdp)
@@ -993,6 +1004,26 @@ COMPONENT can be a character or char-spec."
                  a-res
                  (list ?⿱ new-str-c (nth 2 enc-str))
                  320))
+         )
+        ((eq (car enc-str) ?⿰)
+         (unless conversion-only
+           (setq f-res (ids-find-chars-including-ids enc-str)))
+         (setq new-str (list ?⿱
+                             (nth 2 structure)
+                             (nth 1 enc-str)))
+         (setq new-str-c
+               (if (setq ret (ideographic-structure-find-chars new-str))
+                   (car ret)
+                 (list (cons 'ideographic-structure new-str))))
+         (if conversion-only
+             (list ?⿰ new-str-c (nth 2 enc-str))
+           (setq a-res (ids-find-chars-including-ids new-str))
+           (list enc
+                 f-res
+                 new-str-c
+                 a-res
+                 (list ?⿰ new-str-c (nth 2 enc-str))
+                 330))
          ))
        )
       )
@@ -1194,7 +1225,50 @@ COMPONENT can be a character or char-spec."
                    (list ?⿱  new-str-c (nth 3 enc-str))
                    419))
            ))
-         )))
+         )
+        ((eq (car enc-str) ?⿰)
+         (cond
+          ((equal (nth 1 enc-str)(nth 2 enc-str))
+           (unless conversion-only
+             (setq f-res (ids-find-chars-including-ids enc-str)))
+           (setq new-str (list ?⿲
+                               (nth 1 enc-str)
+                               (nth 2 structure)
+                               (nth 2 enc-str)))
+           (setq new-str-c
+                 (list (cons 'ideographic-structure new-str)))
+           (if conversion-only
+               new-str
+             (setq a-res (ids-find-chars-including-ids new-str))
+             (list enc
+                   f-res
+                   new-str-c
+                   a-res
+                   new-str
+                   421))
+           )
+          (t
+           (unless conversion-only
+             (setq f-res (ids-find-chars-including-ids enc-str)))
+           (setq new-str (list ?⿰
+                               (nth 2 structure)
+                               (nth 2 enc-str)))
+           (setq new-str-c
+                 (if (setq ret (ideographic-structure-find-chars new-str))
+                     (car ret)
+                   (list (cons 'ideographic-structure new-str))))
+           (if conversion-only
+               (list ?⿰ (nth 1 enc-str) new-str-c)
+             (setq a-res (ids-find-chars-including-ids new-str))
+             (list enc
+                   f-res
+                   new-str-c
+                   a-res
+                   (list ?⿰ (nth 1 enc-str) new-str-c)
+                   422))
+           ))
+         ))
+       )
       )
      ((eq (car structure) ?⿶)
       (setq enc (nth 1 structure))
@@ -1311,16 +1385,16 @@ COMPONENT can be a character or char-spec."
                         (cdr (assq 'ideographic-structure enc))
                         )))
        (cond
-        ((eq (car enc-str) ?⿱)
-         (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
-         (when (and enc2-str
-                    (eq (car enc2-str) ?⿰))
+        ((eq (car enc-str) ?⿱)         
+         (cond
+          ((and (characterp (nth 2 enc-str))
+                (memq (char-ucs (nth 2 enc-str))
+                      '(#x9580 #x9B25)))
            (unless conversion-only
              (setq f-res (ids-find-chars-including-ids enc-str)))
-           (setq new-str (list ?⿲
-                               (nth 1 enc2-str)
-                               (nth 2 structure)
-                               (nth 2 enc2-str)))
+           (setq new-str (list ?⿵
+                               (nth 2 enc-str)
+                               (nth 2 structure)))
            (setq new-str-c
                  (if (setq ret (ideographic-structure-find-chars new-str))
                      (car ret)
@@ -1333,8 +1407,73 @@ COMPONENT can be a character or char-spec."
                    new-str-c
                    a-res
                    (list ?⿱ (nth 1 enc-str) new-str-c)
-                   611))
+                   601))
            )
+          ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
+                (cond
+                 ((eq (car enc2-str) ?⿰)
+                  (setq code 611)
+                  )
+                 ((eq (car enc2-str) ?⿲)
+                  (setq code 614)
+                  )
+                 ((and (eq (car enc2-str) ?⿱)
+                       (setq enc3-str
+                             (ideographic-character-get-structure (nth 2 enc2-str)))
+                       (eq (car enc3-str) ?⿰))
+                  (setq code 613)
+                  )))
+           (unless conversion-only
+             (setq f-res (ids-find-chars-including-ids enc-str)))
+           (setq new-str
+                 (cond ((eq code 611)
+                        (list ?⿲
+                              (nth 1 enc2-str)
+                              (nth 2 structure)
+                              (nth 2 enc2-str))
+                        )
+                       ((eq code 613)
+                        (list ?⿲
+                              (nth 1 enc3-str)
+                              (nth 2 structure)
+                              (nth 2 enc3-str))
+                        )
+                       ((eq code 614)
+                        (list ?⿲
+                              (nth 1 enc2-str)
+                              (list (list 'ideographic-structure
+                                          ?⿱
+                                          (nth 2 enc2-str)
+                                          (nth 2 structure)))
+                              (nth 3 enc2-str))
+                        )))
+           (setq new-str-c
+                 (if (setq ret (ideographic-structure-find-chars new-str))
+                     (car ret)
+                   (list (cons 'ideographic-structure
+                               (ideographic-structure-compact new-str)))))
+           (if conversion-only
+               (cond ((or (eq code 611)
+                          (eq code 614))
+                      (list ?⿱ (nth 1 enc-str) new-str-c)
+                      )
+                     ((eq code 613)
+                      (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
+                      ))
+             (setq a-res (ids-find-chars-including-ids new-str))
+             (list enc
+                   f-res
+                   new-str-c
+                   a-res
+                   (cond ((or (eq code 611)
+                              (eq code 614))
+                          (list ?⿱ (nth 1 enc-str) new-str-c)
+                          )
+                         ((eq code 613)
+                          (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
+                          ))
+                   code))
+           ))
          )
         ((eq (car enc-str) ?⿳)
          (setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
@@ -1441,11 +1580,19 @@ COMPONENT can be a character or char-spec."
       (setq enc (nth 1 structure))
       (when (setq enc-str
                  (cond ((characterp enc)
-                        (get-char-attribute enc 'ideographic-structure)
+                        (or (get-char-attribute enc 'ideographic-structure)
+                            (get-char-attribute enc 'ideographic-structure@apparent))
                         )
                        ((consp enc)
-                        (cdr (assq 'ideographic-structure enc))
+                        (or (cdr (assq 'ideographic-structure enc))
+                            (cdr (assq 'ideographic-structure@apparent enc)))
                         )))
+        ;; (setq enc-str
+        ;;       (mapcar (lambda (cell)
+        ;;                 (or (and (listp cell)
+        ;;                          (find-char cell))
+        ;;                     cell))
+        ;;               enc-str))
        (cond
         ((eq (car enc-str) ?⿱)
          (cond
@@ -1477,7 +1624,8 @@ COMPONENT can be a character or char-spec."
            )
           ((and (characterp (nth 2 enc-str))
                 (memq (char-ucs (nth 2 enc-str))
-                      '(#x706C
+                      '(#x4E00
+                        #x706C
                         #x65E5 #x66F0 #x5FC3
                         #x2123C #x58EC #x738B #x7389)))
            (unless conversion-only