update.

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

diff --git a/est-eval.el b/est-eval.el
index a99bb10..8076a43 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))))

@@ -11,19 +13,19 @@
        ((eq spec 01) (concat value "期"))
        ((eq spec 02) (concat value "巻"))
        ((eq spec 03) (concat value "号"))
        ((eq spec 01) (concat value "期"))
        ((eq spec 02) (concat value "巻"))
        ((eq spec 03) (concat value "号"))

-       ((eq spec 04) (concat value "&GT-35694;"))
-       ((eq spec 05) (concat value "&GT-33870;"))
-       ((eq spec 06) (concat value "&GT-56392;"))
+       ((eq spec 04) (concat value "編"))
+       ((eq spec 05) (concat value "&MJ019590;"))
+       ((eq spec 06) (concat value "集"))

        ((eq spec 07) (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 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 11) (concat value "分冊"))
+       ((eq spec 12) (concat value "次"))
+       ((eq spec 13) (concat value "月号"))
+       ((eq spec 14) (concat value "特集号"))

        ((eq spec 15) (concat value "本"))
        ((eq spec 15) (concat value "本"))

-       ((eq spec 16) (concat value "分󠄀"))
+       ((eq spec 16) (concat value "分"))

        ((eq spec 51) (concat "Vol." value))
        ((eq spec 52) (concat "No." value))
        ((eq spec 53) (concat "Part " value))
        ((eq spec 51) (concat "Vol." value))
        ((eq spec 52) (concat "No." value))
        ((eq spec 53) (concat "Part " value))

@@ -62,6 +64,33 @@
                value)))
     (est-eval-value-as-S-exp value)))
 
                value)))
     (est-eval-value-as-S-exp value)))
 

+(defun est-eval-value-as-image-resource (value &optional accept-full-image)
+  (let ((name (concord-object-get value 'name)))
+    (cond
+     ((concord-object-get value 'image-offset-x)
+      (list 'img (list* :src (or (concord-object-get value '=location@iiif)
+                                (concord-object-get value '=location))
+                       (if name
+                           (list :alt name))))
+      )
+     (accept-full-image
+      (list 'img (list* :src (concord-object-get value '=location)
+                       (if name
+                           (list :alt name))))
+      )
+     (t
+      name))))
+
+(defun est-eval-value-as-glyph-image (value)
+  (let ((image-resource (car (concord-object-get value '->image-resource))))
+    (est-eval-value-as-image-resource image-resource)))
+
+(defun est-eval-value-as-image-object (value)
+  (let ((image-resource (car (concord-object-get value '->image-resource))))
+    (list 'object (list :object value)
+         (est-eval-value-as-image-resource
+          image-resource 'accept-full-image))))
+

 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
 ;;   (when (integerp spec)
 ;;     (setq spec (format "%02d" spec)))
 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
 ;;   (when (integerp spec)
 ;;     (setq spec (format "%02d" spec)))

@@ -71,19 +100,19 @@
 ;;         ((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)) "&AJ1-03620;"))
+;;         ((string= spec "05") `((decimal (:feature ,feature)) "&MJ019590;"))
+;;         ((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 "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 "11") `((decimal (:feature ,feature)) "分冊"))
+;;         ((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 "15") `((decimal (:feature ,feature)) "本"))

-;;         ((string= spec "16") `((decimal (:feature ,feature)) "分󠄀"))
+;;         ((string= spec "16") `((decimal (:feature ,feature)) "分"))

 ;;         ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
 ;;         ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
 ;;         ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
 ;;         ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
 ;;         ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
 ;;         ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))

@@ -103,29 +132,195 @@
 ;;         (t nil)
 ;;         ))
 
 ;;         (t nil)
 ;;         ))
 

-(defun est-eval-journal-volume (value)
-  (let ((journal (car (concord-object-get value '<-volume)))
+(defun est-eval-value-as-journal-volume (value &optional short)
+  (let ((journal (car (or (concord-object-get value '<-journal/volume)
+                         (concord-object-get value '<-volume))))
+       (vol-name (concord-object-get value '<-journal/volume*name))

        volume-type number-type
        volume-type number-type

-       year)
-    (setq volume-type (concord-object-get journal 'volume/type/code)
-         number-type (concord-object-get journal 'number/type/code))
-    (setq year (concord-object-get value '->published/date*year))
-    ;; (append (list (concord-object-get journal 'name))
-    ;;         (est-journal-volume-object-get-volume-format
-    ;;          volume-type '<-volume*volume)
-    ;;         (est-journal-volume-object-get-volume-format
-    ;;          number-type '<-volume*number)
-    ;;         )
-    (concat (concord-object-get journal 'name)
-           " "
-           (ruimoku-format-volume
-            volume-type
-            (concord-object-get value '<-volume*volume)
-            year 'cjk)
-           (ruimoku-format-volume
-            number-type
-            (concord-object-get value '<-volume*number)
-            year 'cjk))
+       year
+       dest ret title subtitle)
+    (cond
+     (journal
+      (if vol-name
+         (setq dest
+               (list
+                (list 'object (list :object value)
+                      vol-name)))
+       (setq volume-type (concord-object-get journal 'volume/type/code)
+             number-type (concord-object-get journal 'number/type/code))
+       (setq year (or (concord-object-get value '->published/date*year)
+                      (concord-object-get
+                       (car (concord-object-get value 'date)) 'year)))
+       (setq dest
+             (list
+              (list 'object
+                    (list :object value)
+                    (ruimoku-format-volume
+                     volume-type
+                     (or (concord-object-get value '<-journal/volume*volume)
+                         (concord-object-get value '<-volume*volume))
+                     year 'cjk)
+                    (ruimoku-format-volume
+                     number-type
+                     (or (concord-object-get value '<-journal/volume*number)
+                         (concord-object-get value '<-volume*number))
+                     year 'cjk))))
+       )
+      (unless short
+       (if (setq ret (est-eval-value-as-object journal))
+           (setq dest
+                 (list* ret " " dest))))
+      (list* 'list '(:subtype sequence :separator "") dest)
+      )
+     ((setq title (concord-object-get value 'title))
+      (setq subtitle (concord-object-get value 'title/subtitle))
+      (list* 'object
+             (list :object value)
+             (if (eq (concord-object-get value 'writing-system) 'cjk)
+                 (list
+                  "「"
+                  (list 'object (list :object value)
+                        (if subtitle
+                            (concat title " — " subtitle)
+                          title))
+                  "」")
+               (list
+                " ‘"
+                (list 'object (list :object value)
+                      (if subtitle
+                          (concat title " — " subtitle)
+                        title))
+                "’")))
+      )
+     (t
+      (est-eval-value-default value)
+      ))
+    ;; (concat (concord-object-get journal 'name)
+    ;;         " "
+    ;;         (ruimoku-format-volume
+    ;;          volume-type
+    ;;          (or (concord-object-get value '<-journal/volume*volume)
+    ;;              (concord-object-get value '<-volume*volume))
+    ;;          year 'cjk)
+    ;;         (ruimoku-format-volume
+    ;;          number-type
+    ;;          (or (concord-object-get value '<-journal/volume*number)
+    ;;              (concord-object-get value '<-volume*number))
+    ;;          year 'cjk))
+    ))
+
+(defun est-eval-value-as-article (value)
+  (let ((journal-volume (car (concord-object-get value '<-article)))
+       (page (concord-object-get value 'page))
+       date ret dest)
+    (when journal-volume
+      (setq date (car (concord-object-get journal-volume 'date)))
+      (if (and date
+              (setq ret (est-eval-value-as-object date)))
+         (setq dest (list ", " ret))))
+    (if page
+       (setq dest (list* ", pp." page dest)))
+    (when (and journal-volume
+              (setq ret (est-eval-value-as-journal-volume journal-volume)))
+      (setq dest (cons ret dest)))
+    (if (setq ret (est-eval-value-as-book value))
+       (setq dest (list* ret " " dest)))
+    (list* 'list '(:subtype sequence :separator "") dest))
+  ;; (let ((creators (concord-object-get value '->creator))
+  ;;       (title (concord-object-get value 'title))
+  ;;       creator-name creator-role)
+  ;;   (concat
+  ;;    (mapconcat
+  ;;     (lambda (creator)
+  ;;       (setq creator-name
+  ;;             (concord-object-get
+  ;;              (car (concord-object-get creator '->creator/name))
+  ;;              '=name))
+  ;;       (setq creator-role
+  ;;             (or (concord-object-get creator 'role*name)
+  ;;                 (format "(%s)"
+  ;;                         (concord-object-get creator 'role*type))))
+  ;;       (concat creator-name " " creator-role))
+  ;;     creators ", ")
+  ;;    (if (eq (concord-object-get value 'writing-system) 'cjk)
+  ;;        (concat  "「" title "」")
+  ;;      (concat " ‘" title "’"))))
+  )
+
+(defun est-eval-value-as-book (value)
+  (let ((creators (concord-object-get value '->creator))
+       (title (concord-object-get value 'title))
+       (subtitle (concord-object-get value 'title/subtitle))
+       (series (concord-object-get value 'series))
+       (publisher (car (concord-object-get value 'publisher)))
+       (date (car (concord-object-get value 'date)))
+        ;; creator-name creator-role
+       dest ret)
+    (if (and date
+            (setq ret (est-eval-value-as-object date)))
+       (setq dest (list ", " ret)))
+    (if (and publisher
+            (setq ret (est-eval-value-as-object publisher)))
+       (setq dest (list* " " ret dest)))
+    (if series
+       (setq dest (list* series "," dest)))
+    (setq dest
+         (if title
+             (if (eq (concord-object-get value 'writing-system) 'cjk)
+                 (list*
+                  "「"
+                (list 'object (list :object value)
+                      (if subtitle
+                          (concat title " — " subtitle)
+                        title))
+                "」" dest)
+             (list*
+              " ‘"
+              (list 'object (list :object value)
+                    (if subtitle
+                        (concat title " — " subtitle)
+                      title))
+              "’" dest))
+           (list* " "
+                  (list 'object (list :object value)
+                        "(review)")
+                  dest)))
+    (when (and creators
+              (setq ret (est-eval-value-as-creators-names creators)))
+      (setq dest (cons ret dest)))
+    (list* 'list '(:subtype sequence :separator "") dest)
+    ;; (concat
+    ;;  (mapconcat
+    ;;   (lambda (creator)
+    ;;     (setq creator-name
+    ;;           (concord-object-get
+    ;;            (car (concord-object-get creator '->creator/name))
+    ;;            '=name))
+    ;;     (setq creator-role
+    ;;           (or (concord-object-get creator 'role*name)
+    ;;               (format "(%s)"
+    ;;                       (concord-object-get creator 'role*type))))
+    ;;     (concat creator-name " " creator-role))
+    ;;   creators ", ")
+    ;;  (if (eq (concord-object-get value 'writing-system) 'cjk)
+    ;;      (concat  "「" title
+    ;;               (if subtitle
+    ;;                   (concat " — " subtitle))
+    ;;               "」")
+    ;;    (concat " ‘" title
+    ;;            (if subtitle
+    ;;                (concat " — " subtitle))
+    ;;            "’"))
+    ;;  (if series
+    ;;      (concat " " series))
+    ;;  (if publisher
+    ;;      (concat ", "
+    ;;              (concord-object-get
+    ;;               (car (concord-object-get
+    ;;                     publisher '->publisher/name))
+    ;;               '=name)))
+    ;;  (if date
+    ;;      (concat ", " (concord-object-get date 'name)))))

     ))
 
 ;; (defun est-eval-creator (value)
     ))
 
 ;; (defun est-eval-creator (value)

@@ -148,12 +343,24 @@
                  ;; (est-eval-list
                  ;;  (est-journal-volume-get-object-format value)
                  ;;  value nil)
                  ;; (est-eval-list
                  ;;  (est-journal-volume-get-object-format value)
                  ;;  value nil)

-                 (est-eval-journal-volume value)
+                 (est-eval-value-as-journal-volume value)
+                 )
+                 ((eq genre 'article@ruimoku)
+                 (est-eval-value-as-article value)
+                 )
+                 ((eq genre 'book@ruimoku)
+                 (est-eval-value-as-book value)

                  )
                  ;; ((eq genre 'creator@ruimoku)
                  ;;  (est-eval-creator value)
                  ;;  )
                  )
                  ;; ((eq genre 'creator@ruimoku)
                  ;;  (est-eval-creator value)
                  ;;  )

-                (t
+                ((eq genre 'image-resource)
+                 (est-eval-value-as-image-resource value)
+                 )
+                 ((eq genre 'glyph-image)
+                 (est-eval-value-as-glyph-image value)
+                 )
+                 (t

                  (setq genre-o (concord-decode-object '=id genre 'genre))
                  (or (and genre-o
                           (setq format
                  (setq genre-o (concord-decode-object '=id genre 'genre))
                  (or (and genre-o
                           (setq format

@@ -166,11 +373,36 @@
                                (www-get-feature-value
                                 genre-o 'object-representative-feature))
                           'name))
                                (www-get-feature-value
                                 genre-o 'object-representative-feature))
                           'name))

+                     (www-get-feature-value value '=name)

                      (est-eval-value-default value))
                  ))
                )))
     (est-eval-value-default value)))
 
                      (est-eval-value-default value))
                  ))
                )))
     (est-eval-value-default value)))
 

+(defun est-eval-value-as-character (value)
+  (let (ret)
+  (if (and (concord-object-p value)
+          (setq ret (concord-object-get value 'character)))
+      (list 'object (list :object value)
+           (mapconcat #'char-to-string ret ""))
+    (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-location (value)
+  (let (ret)
+  (if (and (concord-object-p value)
+          (setq ret (concord-object-get value '=location)))
+      (list 'object (list :object value)
+           ret)
+    (est-eval-value-as-object value))))
+
+(defun est-eval-value-as-name (value)
+  (let (ret)
+  (if (and (concord-object-p value)
+          (setq ret (concord-object-get value 'name)))
+      (list 'object (list :object value)
+           ret)
+    (est-eval-value-as-object value))))
+

 (defun est-eval-value-as-HEX (value)
   (if (integerp value)
       (list 'HEX nil (format "%X" value))
 (defun est-eval-value-as-HEX (value)
   (if (integerp value)
       (list 'HEX nil (format "%X" value))

@@ -194,25 +426,131 @@
            (format "%c" (ideographic-radical value)))
     (est-eval-value-as-S-exp value)))
 
            (format "%c" (ideographic-radical value)))
     (est-eval-value-as-S-exp value)))
 

-(defun est-eval-value-as-object-list (value &optional separator)
-  (if (listp value)
-      (list* 'list
-            (if separator
-                (list :separator separator))
-             ;; (mapcar
-             ;;  (lambda (unit)
-             ;;    (if (characterp unit)
-             ;;        (list 'char-link nil (format "%c" unit))
-             ;;      (format "%s" unit)))
-             ;;  value)
-            (mapcar #'est-eval-value-as-object value)
-            )
+(defun est-eval-value-as-object-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 #'est-eval-value-as-object value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-char-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 #'est-eval-value-as-character value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-location-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 #'est-eval-value-as-location value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-name-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 #'est-eval-value-as-name value)))
+       (error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-image-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* 'image-list props
+                  (mapcar #'est-eval-value-as-image-object value)))
+       (error (format "%s" value)))

     (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)

@@ -254,7 +592,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

@@ -308,7 +646,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

@@ -317,38 +656,60 @@
                value)))
     (est-eval-value-default value)))
 
                value)))
     (est-eval-value-default value)))
 

-(defun est-eval-value-as-creators-names (value)
+(defun est-eval-value-as-creators-names (value &optional subtype)

   (if (listp value)
       (let (role-name)
        (list* 'creator-name
   (if (listp value)
       (let (role-name)
        (list* 'creator-name

-              '(:separator " ")
+              (if subtype
+                  '(:subtype unordered-list)
+                '(:separator " "))

               (mapcar (lambda (creator)
               (mapcar (lambda (creator)

-                        (setq role-name
-                              (concord-object-get creator
-                                                  'role*name))
-                        (est-eval-list
-                         (list
-                          '(value (:feature ->name))
-                          (list
-                           'object (list :object creator)
-                           (or role-name
-                               (format "(%s)"
-                                       (concord-object-get creator
-                                                           'role*type)))))
-                         creator nil)
-                        )
+                        (cond
+                         ((concord-object-p creator)
+                          (setq role-name
+                                (concord-object-get
+                                 creator 'role*name))
+                          (est-eval-list
+                           (list
+                            '(value (:feature ->creator/name))
+                            (list
+                             'object (list :object creator)
+                             (or role-name
+                                 (format "(%s)"
+                                         (concord-object-get creator
+                                                             'role*type)))))
+                           creator nil)
+                          )
+                         (t creator)))

                       value)
               ))
     (est-eval-value-default value)))
 
                       value)
               ))
     (est-eval-value-default value)))
 

-(defun est-eval-value-as-created-works (value)
+(defun est-eval-value-as-created-works (value &optional subtype)

   (if (listp value)
       (list* 'creator-name
   (if (listp value)
       (list* 'creator-name

-            '(:separator " ")
+            (if subtype
+                '(:subtype unordered-list)
+              '(:separator " "))

             (mapcar (lambda (creator)
             (mapcar (lambda (creator)

-                      (est-eval-list
-                       '((value (:feature ->created)))
-                       creator nil))
+                      (if (concord-object-p creator)
+                          (est-eval-list
+                           '((value (:feature <-creator)))
+                           creator nil)
+                        (est-eval-value-default creator)))
+                    value))
+    (est-eval-value-default value)))
+
+(defun est-eval-value-as-journal-volumes (value &optional subtype)
+  (if (listp value)
+      (list* 'journal-volumes
+            (if subtype
+                '(:subtype unordered-list)
+              '(:separator " "))
+            (mapcar (lambda (volume)
+                      (if (concord-object-p volume)
+                          (est-eval-value-as-journal-volume volume 'short)
+                        volume))

                     value))
     (est-eval-value-default value)))
 
                     value))
     (est-eval-value-default value)))
 

@@ -413,6 +774,10 @@
         ((eq format 'wiki-text)
          (est-eval-list value object feature-name nil uri-object)
          )
         ((eq format 'wiki-text)
          (est-eval-list value object feature-name nil uri-object)
          )

+        ((eq format 'unordered-link-list)
+         (est-eval-list value object feature-name nil uri-object
+                        '(:subtype unordered-list :separator " "))
+         )

         ((eq format 'S-exp)
          (est-eval-value-as-S-exp value)
          )
         ((eq format 'S-exp)
          (est-eval-value-as-S-exp value)
          )

@@ -422,17 +787,39 @@
          (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 " "))
         ((or (eq format 'space-separated)
              (eq format 'space-separated-char-list))
          (est-eval-value-as-object-list value " "))

+        ((eq format 'char-list)
+         (est-eval-value-as-char-list value nil))
+        ((eq format 'location-list)
+         (est-eval-value-as-location-list value nil))
+        ((eq format 'name-list)
+         (est-eval-value-as-name-list value nil))
+        ((eq format 'image-list)
+         (est-eval-value-as-image-list value nil))
+        ((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)
          (est-eval-value-as-domain-list value))
         ((eq format 'space-separated-creator-name-list)
          (est-eval-value-as-creators-names value))
         ((eq format 'space-separated-ids)
          (est-eval-value-as-space-separated-ids value))
         ((eq format 'space-separated-domain-list)
          (est-eval-value-as-domain-list value))
         ((eq format 'space-separated-creator-name-list)
          (est-eval-value-as-creators-names value))

+        ((eq format 'unordered-creator-name-list)
+         (est-eval-value-as-creators-names value 'unordered-list))

         ((eq format 'space-separated-created-work-list)
          (est-eval-value-as-created-works value))
         ((eq format 'space-separated-created-work-list)
          (est-eval-value-as-created-works value))

+        ((eq format 'unordered-created-work-list)
+         (est-eval-value-as-created-works value 'unordered-list))
+        ((eq format 'journal-volume-list)
+         (est-eval-value-as-journal-volumes value))

         (t
          (est-eval-value-default value)
          ))
         (t
          (est-eval-value-default value)
          ))

@@ -444,9 +831,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 127 value)
+                    (nthcdr est-eval-list-feature-items-limit value)

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

@@ -574,7 +963,7 @@
       exp)))))
 
 (defun est-eval-list (format-list object feature-name
       exp)))))
 
 (defun est-eval-list (format-list object feature-name

-                                 &optional lang uri-object)
+                                 &optional lang uri-object list-props)

   (if (consp format-list)
       (let ((ret
             (mapcar
   (if (consp format-list)
       (let ((ret
             (mapcar

@@ -582,7 +971,7 @@
                (est-eval-unit exp object feature-name lang uri-object nil))
              format-list)))
        (if (cdr ret)
                (est-eval-unit exp object feature-name lang uri-object nil))
              format-list)))
        (if (cdr ret)

-           (list* 'list nil ret)
+           (list* 'list list-props ret)

          (car ret)))
     (est-eval-unit format-list object feature-name lang uri-object nil)))
 
          (car ret)))
     (est-eval-unit format-list object feature-name lang uri-object nil)))