X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=blobdiff_plain;f=est-eval.el;h=8076a4325c244493c840de00b1b8fc9a6f4365ec;hp=65ce97ffe541f8aaa0980f865b1e873ee4132b7f;hb=HEAD;hpb=064fb21a731624826bc09b70f426f2cf031e7c12

diff --git a/est-eval.el b/est-eval.el
index 65ce97f..0d4be34 100644
--- a/est-eval.el
+++ b/est-eval.el
@@ -1,6 +1,51 @@
 ;; -*- 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))))
+  (cond ((eq spec 'YY) (if (eq lang 'cjk)
+				 (format "%då¹´" year)
+			       (format "%d" year)))
+	((eq spec 00) value)
+	((eq spec 01) (concat value "期"))
+	((eq spec 02) (concat value "å·»"))
+	((eq spec 03) (concat value "号"))
+	((eq spec 04) (concat value "ç·¨"))
+	((eq spec 05) (concat value "&MJ019590;"))
+	((eq spec 06) (concat value "集"))
+	((eq spec 07) (concat value "輯"))
+	((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 "次"))
+	((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 52) (concat "No." value))
+	((eq spec 53) (concat "Part " value))
+	((eq spec 54) (concat "Issue " value))
+	((eq spec 55) (concat "Tome " value))
+	((eq spec 56) (concat "Tomo " value))
+	((eq spec 57) (concat "Tomus " value))
+	((eq spec 58) (concat "Fasc." value))
+	((eq spec 59) (concat "Livre " value))
+	((eq spec 60) (concat "Année " value))
+	((eq spec 61) (concat "Bd." value))
+	((eq spec 62) (concat "Heft " value))
+	((eq spec 63) (concat "Nr." value))
+	((eq spec 64) (concat "Jahrg." value))
+	((eq spec 65) (concat "Jaarg." value))
+	((eq spec 66) (concat "Trimestre" value))
+	(t "")
+	))
+
+
 ;;; @ Feature value presentation
 ;;;
 
@@ -9,38 +54,403 @@
 
 (defun est-eval-value-default (value)
   (if (listp value)
-      (list* 'list
-	     '(:separator " ")
-	     (mapcar
-	      (lambda (unit)
-		(format "%S" unit))
-	      value))
+      (if (eq (car value) 'omitted)
+	  value
+	(list* 'list
+	       '(:separator " ")
+	       (mapcar
+		(lambda (unit)
+		  (format "%S" unit))
+		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)))
+;;   (cond ((string= spec "YY") `((decimal (:feature
+;;                                          ->published/date*year)) "å¹´"))
+;;         ((string= spec "00") `((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)) "&AJ1-03620;"))
+;;         ((string= spec "05") `((decimal (:feature ,feature)) "&MJ019590;"))
+;;         ((string= spec "06") `((decimal (:feature ,feature)) "集"))
+;;         ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
+;;         ((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)) "次"))
+;;         ((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 "52") `("No." ((decimal (:feature ,feature)))))
+;;         ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
+;;         ((string= spec "54") `("Issue " ((decimal (:feature ,feature)))))
+;;         ((string= spec "55") `("Tome " ((decimal (:feature ,feature)))))
+;;         ((string= spec "56") `("Tomo " ((decimal (:feature ,feature)))))
+;;         ((string= spec "57") `("Tomus " ((decimal (:feature ,feature)))))
+;;         ((string= spec "58") `("Fasc." ((decimal (:feature ,feature)))))
+;;         ((string= spec "59") `("Livre " ((decimal (:feature ,feature)))))
+;;         ((string= spec "60") `("Année " ((decimal (:feature ,feature)))))
+;;         ((string= spec "61") `("Bd." ((decimal (:feature ,feature)))))
+;;         ((string= spec "62") `("Heft " ((decimal (:feature ,feature)))))
+;;         ((string= spec "63") `("Nr." ((decimal (:feature ,feature)))))
+;;         ((string= spec "64") `("Jahrg." ((decimal (:feature ,feature)))))
+;;         ((string= spec "65") `("Jaarg." ((decimal (:feature ,feature)))))
+;;         ((string= spec "66") `("Trimestre" ((decimal (:feature ,feature)))))
+;;         (t nil)
+;;         ))
+
+(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
+	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)
+;;   (est-eval-list
+;;    '((value (:feature ->name))
+;;      (string (:feature role*name)))
+;;    value nil))
+  
 (defun est-eval-value-as-object (value)
   (if (or (characterp value)
 	  (concord-object-p value))
       (list 'object (list :object value)
 	    (if (characterp value)
 		(char-to-string value)
-	      (let ((genre-o (concord-decode-object
-			      '=id (concord-object-genre value)
-			      'genre))
+	      (let ((genre (concord-object-genre value))
+		    genre-o
 		    format)
-		(or (and genre-o
-			 (setq format
-			       (concord-object-get
-				genre-o 'object-representative-format))
-			 (est-eval-list format value nil))
-		    (www-get-feature-value
-		     value
-		     (or (and genre-o
-			      (www-get-feature-value
-			       genre-o 'object-representative-feature))
-			 'name))
-		    (est-eval-value-default value)))))
+		(cond
+		 ((eq genre 'journal-volume@ruimoku)
+		  ;; (est-eval-list
+		  ;;  (est-journal-volume-get-object-format value)
+		  ;;  value nil)
+		  (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 '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
+				 (concord-object-get
+				  genre-o 'object-representative-format))
+			   (est-eval-list format value nil))
+		      (www-get-feature-value
+		       value
+		       (or (and genre-o
+				(www-get-feature-value
+				 genre-o 'object-representative-feature))
+			   'name))
+		      (www-get-feature-value value '=name)
+		      (www-get-feature-value value '=title)
+		      (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-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)
+	   (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))
@@ -64,25 +474,241 @@
 	    (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-shuowen-radical (value)
+  (if (and (integerp value)
+	   (<= 0 value)
+	   (<= value 540))
+      (list 'shuowen-radical
+	    nil
+	    (format "%c" (shuowen-radical value)))
+    (est-eval-value-as-S-exp value)))
+
+(defun daijiten-page-number-to-ndl-950498 (page)
+  (+ (/ page 2)
+     (cond ((< page 229)
+	    23)
+	   ((< page 261)
+	    24)
+	   ((< page 263)
+	    25)
+	   ((< page 516) ; 284=285
+	    26)
+	   (t
+	    27))))
+
+(defun est-eval-value-as-daijiten-page (value)
+  (if (integerp value)
+      (list 'link
+	    (list :ref
+		  (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/950498/manifest.json&tify={%%22pages%%22:[%d]}"
+			  (daijiten-page-number-to-ndl-950498 value)))
+	    value)))
+
+(defun est-eval-value-as-ndl-page-by-tify (value)
+  (if (symbolp value)
+      (setq value (symbol-name value)))
+  (if (stringp value)
+      (if (string-match "/" value)
+	  (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json&tify={%%22pages%%22:[%s]}"
+		  (substring value 0 (match-beginning 0))
+		  (substring value (match-end 0)))
+	(format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json"
+		value))
+    value))
+
+(defun est-eval-value-as-Web-yunzi-char (value)
+  (if (char-or-char-int-p value)
+      (list 'link
+	    (list :ref
+		  (format "http://suzukish.s252.xrea.com/search/inkyo/yunzi/%c"
+			  value))
+	    (format "/%s/" (char-to-string value)))))
+
+(defun est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number (value)
+  (if (symbolp value)
+      (setq value (symbol-name value)))
+  (if (and (stringp value)
+	   (string-match
+	    "^Y\\([0-9][0-9]\\)\\([0-9][0-9][0-9]\\)\\([0-9][0-9][0-9]\\)-\\([0-9]\\)$"
+	    value))
+      (format "%d巻 %d紙 %d列 %d字目 (%s)"
+	      (string-to-int (match-string 1 value))
+	      (string-to-int (match-string 2 value))
+	      (string-to-int (match-string 3 value))
+	      (string-to-int (match-string 4 value))
+	      value)
+    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)))
 
+(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-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))
+;;     (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)
@@ -124,7 +750,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
@@ -178,7 +804,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
@@ -187,6 +814,193 @@
 		value)))
     (est-eval-value-default value)))
 
+(defun est-eval-value-as-sources (value)
+  (if (listp value)
+      (let (unit-str
+	    source item source-objs source0 start end num
+	    source-cobj title)
+	(list* 'res-list
+	       '(:separator " ")
+	       (mapcar
+		(lambda (unit)
+		  (setq unit-str
+			(if (symbolp unit)
+			    (symbol-name unit)
+			  (format "%s" unit)))
+		  (if (string-match "=" unit-str)
+		      (setq source (intern
+				    (substring unit-str 0 (match-beginning 0)))
+			    item (car (read-from-string
+				       (substring unit-str (match-end 0)))))
+		    (setq source unit
+			  item nil))
+		  (cond
+		   ((and (setq source-cobj (concord-decode-object
+					    '=chise-bib-id source 'bibliography))
+			 (setq title (concord-object-get source-cobj '=title)))
+		    (setq source-objs
+			  (if item
+			      (list (est-eval-value-as-object source-cobj)
+				    "="
+				    item)
+			    (list (est-eval-value-as-object source-cobj))))
+		    )
+		   ((eq source 'bos)
+		    (setq source-objs
+			  (list
+			   (est-eval-value-as-object
+			    (or (concord-decode-object
+				 '=id item 'book@ruimoku)
+				(concord-decode-object
+				 '=id item 'article@ruimoku)
+				unit))))
+		    )
+		   ((memq source '(zob1959 zob1968))
+		    (if (and (symbolp item)
+			     (setq num (symbol-name item))
+			     (string-match
+			      "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
+			(setq start (string-to-number
+				     (match-string 1 num))
+			      end (string-to-number
+				   (match-string 2 num)))
+		      (setq start item
+			    end item))
+		    (if (not (numberp start))
+			(setq source-objs
+			      (list
+			       (est-eval-value-as-object unit)))
+		      (if (eq source source0)
+			  (setq source-objs
+				(list
+				 (list 'link
+				       (list :ref
+					     (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
+						     start))
+				       start)))
+			(setq source0 source)
+			(setq source-objs
+			      (list
+			       (list 'link
+				       (list :ref
+					     (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
+						     start))
+				       start)
+			       "="
+			       '(link
+				 (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
+				 "\u4EAC大人\u6587研甲\u9AA8")))
+			)
+		      (setq num (1+ start))
+		      (while (<= num end)
+			(setq source-objs
+			      (cons
+			       (list 'link
+				     (list :ref
+					   (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
+						   num))
+				     num)
+			       source-objs))
+			(setq num (1+ num)))
+		      (setq source-objs (nreverse source-objs)))
+		    )
+		   (t
+		    (setq source-objs
+			  (list (est-eval-value-as-object unit)))
+		    ))
+		  (list* 'res-link
+			 (list :separator " "
+			       :source source :item item)
+			 source-objs)
+		  )
+		value)))
+    (est-eval-value-default value)))
+
+(defun est-eval-value-as-daijiten-page-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-daijiten-page value)))
+	(error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-Web-yunzi-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-Web-yunzi-char value)))
+	(error (format "%s" value)))
+    (format "%s" value)))
+
+(defun est-eval-value-as-creators-names (value &optional subtype)
+  (if (listp value)
+      (let (role-name)
+	(list* 'creator-name
+	       (if subtype
+		   '(:subtype unordered-list)
+		 '(:separator " "))
+	       (mapcar (lambda (creator)
+			 (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)))
+
+(defun est-eval-value-as-created-works (value &optional subtype)
+  (if (listp value)
+      (list* 'creator-name
+	     (if subtype
+		 '(:subtype unordered-list)
+	       '(:separator " "))
+	     (mapcar (lambda (creator)
+		       (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)))
+
 
 ;;; @ format evaluator
 ;;;
@@ -248,6 +1062,10 @@
 	 ((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)
 	  )
@@ -255,15 +1073,74 @@
 	  (est-eval-value-as-kuten value))
 	 ((eq format 'kangxi-radical)
 	  (est-eval-value-as-kangxi-radical value))
+	 ((eq format 'tify-url-for-ndl)
+	  (est-eval-value-as-ndl-page-by-tify value)
+	  )
+	 ((eq format 'hdic-yy-readable)
+	  (est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number value)
+	  )
+	 ((eq format 'shuowen-radical)
+	  (est-eval-value-as-shuowen-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 '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 '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)
-	  (est-eval-value-as-domain-list value))
+          ;; (est-eval-value-as-domain-list value)
+	  (est-eval-value-as-sources value))
+	 ((eq format 'space-separated-source-list)
+	  (est-eval-value-as-sources 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 '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))
+	 ((eq format 'space-separated-daijiten-page-list)
+	  (est-eval-value-as-daijiten-page-list value " "))
+	 ((eq format 'space-separated-Web-yunzi-char-list)
+	  (est-eval-value-as-Web-yunzi-char-list value " "))
 	 (t
 	  (est-eval-value-default value)
 	  ))
@@ -275,6 +1152,17 @@
     (setq value (www-get-feature-value object feature-name)))
   (unless format
     (setq format (www-feature-value-format feature-name)))
+  (if (and (consp value)
+	   est-eval-list-feature-items-limit
+	   (not (eq feature-name 'sources)))
+      (let ((ret (condition-case nil
+		     (nthcdr est-eval-list-feature-items-limit value)
+		   (error nil nil))))
+	(when ret
+	  (setcdr ret
+		  (list (list 'omitted
+			      (list :object object :feature feature-name)
+			      "..."))))))
   (cond
    ((symbolp format)
     (est-eval-apply-value object feature-name
@@ -308,8 +1196,10 @@
    ((null exp) "")
    ((consp exp)
     (cond
-     ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
-			      S-exp string default))
+     ((memq (car exp) '(value decimal hex HEX ku-ten
+			      kangxi-radical shuowen-radical
+			      S-exp string default
+			      tify-url-for-ndl hdic-yy-readable))
       (let ((fn (plist-get (nth 1 exp) :feature))
 	    domain domain-fn ret)
 	(when fn
@@ -349,6 +1239,7 @@
       )
      ((eq (car exp) 'name-url)
       (let ((fn (plist-get (nth 1 exp) :feature))
+	    (object (plist-get (nth 1 exp) :object))
 	    domain domain-fn)
 	(when fn
 	  (setq domain (char-feature-name-domain feature-name))
@@ -358,6 +1249,7 @@
 	  (setq feature-name domain-fn)))
       (list 'name-url (list :feature feature-name)
 	    (www-uri-make-feature-name-url
+	     (est-object-genre object)
 	     (www-uri-encode-feature-name feature-name)
 	     uri-object))
       )
@@ -367,6 +1259,11 @@
 	    (format "@%s" domain)
 	  ""))
       )
+     ((eq (car exp) 'omitted)
+      (list 'omitted
+	    (list :object object :feature feature-name)
+	    "...")
+      )
      ((eq (car exp) 'prev-char)
       (list 'prev-char
 	    (list :object object :feature feature-name)
@@ -389,7 +1286,7 @@
       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
@@ -397,7 +1294,7 @@
 		(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)))