From: MORIOKA Tomohiko <tomo.git@chise.org>
Date: Fri, 20 May 2022 09:06:28 +0000 (+0900)
Subject: (est-eval-value-as-object-with-description): New function.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=5fcf4c8e5e2cf4c045afc86293edab2889c2c036;p=chise%2Fest.git

(est-eval-value-as-object-with-description): New function.
(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'.
---

diff --git a/est-eval.el b/est-eval.el
index 10ff991..0d4be34 100644
--- a/est-eval.el
+++ b/est-eval.el
@@ -388,6 +388,53 @@
 	    (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)
@@ -605,6 +652,51 @@
 	(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))
@@ -1010,6 +1102,24 @@
 	  (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)