(est-eval-value-as-object-with-description): New function.
authorMORIOKA Tomohiko <tomo.git@chise.org>
Fri, 20 May 2022 09:06:28 +0000 (18:06 +0900)
committerMORIOKA Tomohiko <tomo.git@chise.org>
Fri, 10 Jun 2022 04:11:54 +0000 (13:11 +0900)
(est-eval-value-as-hdic-tsj-character-with-description): New function.
(est-eval-value-as-entry-character-list): New function.
(est-eval-value-as-hdic-tsj-entry-character-list): New function.
(est-eval-apply-value):
- Use `est-eval-value-as-entry-character-list' for
  `entry-character-list' and `unordered-entry-character-list'.
- Use `est-eval-value-as-hdic-tsj-entry-character-list' for
  `hdic-tsj-entry-character-list'.

est-eval.el

index 10ff991..0d4be34 100644 (file)
            (mapconcat #'char-to-string ret ""))
     (est-eval-value-as-object value))))
 
+(defun est-eval-value-as-object-with-description (value
+                                                 object feature-name
+                                                 &optional lang uri-object list-props)
+  (let (ret)
+    (cond
+     ((characterp value)
+      (setq ret (or (get-char-attribute value 'description)
+                   (get-char-attribute value 'hdic-syp-description)
+                   (get-char-attribute value 'hdic-ktb-description)))
+      )
+     ((concord-object-p value)
+      (setq ret (concord-object-get value 'description))
+      ))
+    (if ret
+       (list 'list nil
+             (est-eval-value-as-object value)
+             (est-eval-list ret
+                            object feature-name
+                            lang uri-object list-props))
+      (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-hdic-tsj-character-with-description (value
+                                                             object feature-name
+                                                             &optional
+                                                             lang uri-object list-props)
+  (let (word desc ret)
+    (cond
+     ((characterp value)
+      (when (setq word (get-char-attribute value 'hdic-tsj-word))
+       (if (and (= (length word) 1)
+                (setq ret (get-char-attribute value '<-HDIC-TSJ))
+                (memq (aref word 0) ret))
+           (setq desc (or (get-char-attribute value 'hdic-tsj-word-description)
+                          (get-char-attribute value 'description)))
+         (setq desc (list "(" word ")"))))
+      )
+     ((concord-object-p value)
+      (setq desc (concord-object-get value 'description))
+      ))
+    (if desc
+       (list 'list nil
+             (est-eval-value-as-object value)
+             (est-eval-list (append desc '("  "))
+                            object feature-name
+                            lang uri-object list-props))
+      (est-eval-value-as-object value))))
+
 (defun est-eval-value-as-location (value)
   (let (ret)
   (if (and (concord-object-p value)
        (error (format "%s" value)))
     (format "%s" value)))
 
+(defun est-eval-value-as-entry-character-list (value
+                                              object feature-name
+                                              &optional separator subtype
+                                              lang uri-object list-props)
+  (if (and (listp value)
+          (listp (cdr value)))
+      (condition-case nil
+         (let (props)
+           (if separator
+               (setq props (list :separator separator)))
+           (if subtype
+               (setq props (list* :subtype subtype props)))
+           (list* 'list props
+                  (mapcar (lambda (cell)
+                            (est-eval-value-as-object-with-description
+                             cell
+                             object feature-name
+                             lang uri-object list-props))
+                          value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-hdic-tsj-entry-character-list (value
+                                                       object feature-name
+                                                       &optional separator subtype
+                                                       lang uri-object list-props)
+  (if (and (listp value)
+          (listp (cdr value)))
+      (condition-case nil
+         (let (props)
+           (if separator
+               (setq props (list :separator separator)))
+           (if subtype
+               (setq props (list* :subtype subtype props)))
+           (list* 'list props
+                  (mapcar (lambda (cell)
+                            (est-eval-value-as-hdic-tsj-character-with-description
+                             cell
+                             object feature-name
+                             lang uri-object list-props))
+                          value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+  
+
 ;; (defun est-eval-value-as-ids (value)
 ;;   (if (listp value)
 ;;       (list 'ids nil (ideographic-structure-to-ids value))
          (est-eval-value-as-object-list value nil 'unordered-list))
         ((eq format 'unordered-composition-list)
          (est-eval-value-as-composition-list value nil 'unordered-list))
+        ((eq format 'entry-character-list)
+         (est-eval-value-as-entry-character-list
+          value
+          object feature-name
+          nil nil
+          lang uri-object list-props))
+        ((eq format 'unordered-entry-character-list)
+         (est-eval-value-as-entry-character-list
+          value
+          object feature-name
+          nil 'unordered-list
+          lang uri-object list-props))
+        ((eq format 'hdic-tsj-entry-character-list)
+         (est-eval-value-as-hdic-tsj-entry-character-list
+          value
+          object feature-name
+          nil nil
+          lang uri-object list-props))
         ((eq format 'space-separated-ids)
          (est-eval-value-as-space-separated-ids value))
         ((eq format 'space-separated-domain-list)