X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=est-eval.el;h=3635eafb67271e538590193d662e39b377cbbe80;hb=7cf6374f08c1ced6f96a76e18b1ba51011d20caf;hp=fb850d1208543e238a18643c0d35c8265bb54976;hpb=26fd74ac7468cc847006a0ff0509198b78b4d756;p=chise%2Fest.git

diff --git a/est-eval.el b/est-eval.el
index fb850d1..3635eaf 100644
--- a/est-eval.el
+++ b/est-eval.el
@@ -1,6 +1,8 @@
 ;; -*- coding: utf-8-mcs-er -*-
 (require 'cwiki-common)
 
+(defvar est-eval-list-feature-items-limit 20)
+
 (defun ruimoku-format-volume (spec value year lang)
   (when (stringp spec)
     (setq spec (car (read-from-string spec))))
@@ -12,16 +14,16 @@
 	((eq spec 02) (concat value "å·»"))
 	((eq spec 03) (concat value "号"))
 	((eq spec 04) (concat value "ç·¨"))
-	((eq spec 05) (concat value "&GT-33870;"))
+	((eq spec 05) (concat value "&HD-JA-4A53;"))
 	((eq spec 06) (concat value "集"))
 	((eq spec 07) (concat value "輯"))
-	((eq spec 08) (concat value "&GT-53119;"))
-	((eq spec 09) (concat value "&GT-53119;分"))
+	((eq spec 08) (concat value "部"))
+	((eq spec 09) (concat value "部分"))
 	((eq spec 10) (concat value "冊"))
 	((eq spec 11) (concat value "分冊"))
-	((eq spec 12) (concat value "&J90-3C21;"))
-	((eq spec 13) (concat value "&GT-18140;号"))
-	((eq spec 14) (concat value "特&GT-56392;号"))
+	((eq spec 12) (concat value "次"))
+	((eq spec 13) (concat value "月号"))
+	((eq spec 14) (concat value "特集号"))
 	((eq spec 15) (concat value "本"))
 	((eq spec 16) (concat value "分"))
 	((eq spec 51) (concat "Vol." value))
@@ -71,17 +73,17 @@
 ;;         ((string= spec "01") `((decimal (:feature ,feature)) "期"))
 ;;         ((string= spec "02") `((decimal (:feature ,feature)) "å·»"))
 ;;         ((string= spec "03") `((decimal (:feature ,feature)) "号"))
-;;         ((string= spec "04") `((decimal (:feature ,feature)) "&GT-35694;"))
-;;         ((string= spec "05") `((decimal (:feature ,feature)) "&GT-33870;"))
-;;         ((string= spec "06") `((decimal (:feature ,feature)) "&GT-56392;"))
+;;         ((string= spec "04") `((decimal (:feature ,feature)) "&HD-JA-4A54;"))
+;;         ((string= spec "05") `((decimal (:feature ,feature)) "&HD-JA-4A53;"))
+;;         ((string= spec "06") `((decimal (:feature ,feature)) "集"))
 ;;         ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
-;;         ((string= spec "08") `((decimal (:feature ,feature)) "&GT-53119;"))
-;;         ((string= spec "09") `((decimal (:feature ,feature)) "&GT-53119;分"))
+;;         ((string= spec "08") `((decimal (:feature ,feature)) "部"))
+;;         ((string= spec "09") `((decimal (:feature ,feature)) "部分"))
 ;;         ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
 ;;         ((string= spec "11") `((decimal (:feature ,feature)) "分冊"))
-;;         ((string= spec "12") `((decimal (:feature ,feature)) "&J90-3C21;"))
-;;         ((string= spec "13") `((decimal (:feature ,feature)) "&GT-18140;号"))
-;;         ((string= spec "14") `((decimal (:feature ,feature)) "特&GT-56392;号"))
+;;         ((string= spec "12") `((decimal (:feature ,feature)) "次"))
+;;         ((string= spec "13") `((decimal (:feature ,feature)) "月号"))
+;;         ((string= spec "14") `((decimal (:feature ,feature)) "特集号"))
 ;;         ((string= spec "15") `((decimal (:feature ,feature)) "本"))
 ;;         ((string= spec "16") `((decimal (:feature ,feature)) "分"))
 ;;         ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
@@ -381,10 +383,61 @@
 	(error (format "%s" value)))
     (format "%s" value)))
 
+(defun est-eval-value-as-composition-list (value &optional separator subtype)
+  (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)
+		      (list 'list nil
+			    "+ "
+			    (list 'object (list :object (car cell))
+				  (format "U+%04X" (car cell)))
+			    " : "
+			    (est-eval-value-as-object (cdr cell))))
+		    (sort value
+			  (lambda (a b)
+			    (< (car a)(car b)))))))
+	(error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-decomposition-list (value)
+  (if (and (listp value)
+	   (listp (cdr value)))
+      (condition-case nil
+	  (let (props)
+	    (list* 'list props
+		   (mapconcat #'char-to-string value "")
+		   (list
+		    " ("
+		    (list* 'list '(:separator " + ")
+			   (mapcar
+			    (lambda (chr)
+			      (list 'object (list :object chr)
+				    (format "U+%04X" chr)))
+			    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))
+;;     (format "%s" value)))
 (defun est-eval-value-as-ids (value)
   (if (listp value)
-      (list 'ids nil (ideographic-structure-to-ids value))
-    (format "%s" value)))
+      (list* 'ids
+	     nil
+	     (mapcar #'est-eval-value-as-object
+		     (ideographic-structure-to-ids value))
+	     )
+    (est-eval-value-default value)))
 
 (defun est-eval-value-as-space-separated-ids (value)
   (if (listp value)
@@ -426,7 +479,7 @@
 				   '=id item 'article@ruimoku)
 				  (intern unit)))))
 		      )
-		     ((eq source 'zob1968)
+		     ((memq source '(zob1959 zob1968))
 		      (if (and (symbolp item)
 			       (setq num (symbol-name item))
 			       (string-match
@@ -480,7 +533,8 @@
 			    (list (est-eval-value-as-object (intern unit))))
 		      ))
 		    (list* 'res-link
-			   (list :source source :item item)
+			   (list :separator " "
+				 :source source :item item)
 			   source-objs)
 		    )
 		   (t
@@ -614,11 +668,17 @@
 	  (est-eval-value-as-kangxi-radical value))
 	 ((eq format 'ids)
 	  (est-eval-value-as-ids value))
+	 ((eq format 'decomposition)
+	  (est-eval-value-as-decomposition-list value))
+	 ((eq format 'composition)
+	  (est-eval-value-as-composition-list value))
 	 ((or (eq format 'space-separated)
 	      (eq format 'space-separated-char-list))
 	  (est-eval-value-as-object-list value " "))
 	 ((eq format 'unordered-list)
 	  (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 'space-separated-ids)
 	  (est-eval-value-as-space-separated-ids value))
 	 ((eq format 'space-separated-domain-list)
@@ -644,9 +704,11 @@
     (setq value (www-get-feature-value object feature-name)))
   (unless format
     (setq format (www-feature-value-format feature-name)))
-  (if (consp value)
+  (if (and (consp value)
+	   est-eval-list-feature-items-limit
+	   (not (eq feature-name 'sources)))
       (let ((ret (condition-case nil
-		     (nthcdr 255 value)
+		     (nthcdr est-eval-list-feature-items-limit value)
 		   (error nil nil))))
 	(when ret
 	  (setcdr ret