Assign genre `hng-card'.

[chise/est.git] / est-eval.el

diff --git a/est-eval.el b/est-eval.el
index fb850d1..3635eaf 100644 (file)
--- a/est-eval.el
+++ b/est-eval.el
@@ -1,6 +1,8 @@
 ;; -*- coding: utf-8-mcs-er -*-
 (require 'cwiki-common)
 
 ;; -*- 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))))
 (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 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 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 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))
        ((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 "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 "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 "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)))))
 ;;         ((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)))
 
        (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)
 (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)
 
 (defun est-eval-value-as-space-separated-ids (value)
   (if (listp value)

@@ -426,7 +479,7 @@
                                   '=id item 'article@ruimoku)
                                  (intern unit)))))
                      )
                                   '=id item 'article@ruimoku)
                                  (intern unit)))))
                      )

-                    ((eq source 'zob1968)
+                    ((memq source '(zob1959 zob1968))

                      (if (and (symbolp item)
                               (setq num (symbol-name item))
                               (string-match
                      (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 (est-eval-value-as-object (intern unit))))
                      ))
                    (list* 'res-link

-                          (list :source source :item item)
+                          (list :separator " "
+                                :source source :item item)

                           source-objs)
                    )
                   (t
                           source-objs)
                    )
                   (t

@@ -614,11 +668,17 @@
          (est-eval-value-as-kangxi-radical value))
         ((eq format 'ids)
          (est-eval-value-as-ids value))
          (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))
         ((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)
         ((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)))
     (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
       (let ((ret (condition-case nil

-                    (nthcdr 255 value)
+                    (nthcdr est-eval-list-feature-items-limit value)

                   (error nil nil))))
        (when ret
          (setcdr ret
                   (error nil nil))))
        (when ret
          (setcdr ret