;; -*- 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
;;;

(defun est-eval-value-as-S-exp (value)
  (list 'S-exp nil (format "%S" value)))

(defun est-eval-value-default (value)
  (if (listp 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 (concord-object-genre value))
		    genre-o
		    format)
		(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))
    (est-eval-value-as-S-exp value)))

(defun est-eval-value-as-kuten (value)
  (if (integerp value)
      (list 'ku-ten
	    nil
	    (format "%02d-%02d"
		    (- (lsh value -8) 32)
		    (- (logand value 255) 32)))
    (est-eval-value-as-S-exp value)))

(defun est-eval-value-as-kangxi-radical (value)
  (if (and (integerp value)
	   (<= 0 value)
	   (<= value 214))
      (list 'kangxi-radical
	    nil
	    (format "%c" (ideographic-radical value)))
    (est-eval-value-as-S-exp 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
	     (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)
      (list* 'ids
	     '(:separator " ")
	     ;; (mapconcat #'char-to-string
	     ;;            (ideographic-structure-to-ids value)
	     ;;            " ")
	     (mapcar #'est-eval-value-as-object
		     (ideographic-structure-to-ids value))
	     )
    (est-eval-value-default value)))

(defun est-eval-value-as-domain-list (value)
  (if (listp value)
      (let (source item source-objs source0 start end num)
	(list* 'res-list
	       '(:separator " ")
	       (mapcar
		(lambda (unit)
		  (setq unit
			(if (symbolp unit)
			    (symbol-name unit)
			  (format "%s" unit)))
		  (cond
		   ((string-match "=" unit)
		    (setq source (intern
				  (substring unit 0 (match-beginning 0)))
			  item (car (read-from-string
				     (substring unit (match-end 0)))))
		    (cond
		     ((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)
				  (intern 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 (intern 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 (intern unit))))
		      ))
		    (list* 'res-link
			   (list :separator " "
				 :source source :item item)
			   source-objs)
		    )
		   (t
		    (list 'res-link nil unit)
		    )))
		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
;;;

;; (defun est-make-env (object feature-name)
;;   (list (cons 'object object)
;;         (cons 'feature-name feature-name)))

;; (defun est-env-push-item (env item value)
;;   (cons (cons item value)
;;         env))

;; (defun est-env-get-item (env item)
;;   (cdr (assq item env)))

;; (defun est-env-current-value (env)
;;   (let ((obj (est-env-get-item env 'object))
;;         (feature (est-env-get-item env 'feature-name)))
;;     (if (characterp obj)
;;         (char-feature obj feature)
;;       (concord-object-get obj feature))))


(defun est-eval-props-to-string (props &optional format)
  (unless format
    (setq format (plist-get props :format)))
  (concat "%"
	  (plist-get props :flag)
  	  (if (plist-get props :len)
	      (format "0%d"
		      (let ((ret (plist-get props :len)))
			(if (stringp ret)
			    (string-to-int ret)
			  ret))))
	  (cond
	   ((eq format 'decimal) "d")
	   ((eq format 'hex) "x")
	   ((eq format 'HEX) "X")
	   ((eq format 'S-exp) "S")
	   (t "s"))))	   

(defun est-eval-apply-value (object feature-name format props value
				    &optional uri-object)
  (list 'value
	(list :object object
	      :feature feature-name)
	(cond
	 ((memq format '(decimal hex HEX))
	  (if (integerp value)
	      (list format
		    nil
		    (format (est-eval-props-to-string props format)
			    value))
	    (format "%s" value))
	  )
	 ((eq format 'string)
	  (list 'string nil (format "%s" value))
	  )
	 ((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 'ku-ten)
	  (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-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)
	  ))
	))

(defun est-eval-feature-value (object feature-name
				      &optional format lang uri-object value)
  (unless value
    (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
			  format nil value
			  uri-object)
    )
   ((consp format)
    (cond
     ((null (cdr format))
      (setq format (car format))
      (est-eval-apply-value object feature-name
			    (car format) (nth 1 format) value
			    uri-object)
      )
     (t
      (est-eval-list format object feature-name lang uri-object)
      )))))

(defun est-eval-unit (exp object feature-name
				 &optional lang uri-object value)
  (unless value
    (setq value (www-get-feature-value object feature-name)))
  (unless uri-object
    (setq uri-object (www-uri-encode-object object)))
  (cond
   ((stringp exp) exp)
   ((or (characterp exp)
	(concord-object-p exp))
    (est-eval-value-as-object exp)
    )
   ((null exp) "")
   ((consp exp)
    (cond
     ((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
	  (when (stringp fn)
	    (setq fn (intern fn)))
	  (setq domain (char-feature-name-domain feature-name))
	  (setq domain-fn (char-feature-name-at-domain fn domain))
	  (if (setq ret (www-get-feature-value object domain-fn))
	      (setq feature-name domain-fn
		    value ret)
	    (setq feature-name fn
		  value (www-get-feature-value object fn)))
	  (push feature-name chise-wiki-displayed-features)
          ))
      (if (eq (car exp) 'value)
	  (est-eval-feature-value object feature-name
					 (plist-get (nth 1 exp) :format)
					 lang uri-object value)
	(est-eval-apply-value
	 object feature-name
	 (car exp) (nth 1 exp) value
	 uri-object))
      )
     ((eq (car exp) 'name)
      (let ((fn (plist-get (nth 1 exp) :feature))
	    domain domain-fn)
	(when fn
	  (setq domain (char-feature-name-domain feature-name))
	  (when (stringp fn)
	    (setq fn (intern fn)))
	  (setq domain-fn (char-feature-name-at-domain fn domain))
	  (setq feature-name domain-fn)))
      (list 'feature-name
	    (list :object object
		  :feature feature-name)
	    (www-format-feature-name* feature-name lang))
      )
     ((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))
	  (when (stringp fn)
	    (setq fn (intern fn)))
	  (setq domain-fn (char-feature-name-at-domain fn domain))
	  (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))
      )
     ((eq (car exp) 'domain-name)
      (let ((domain (char-feature-name-domain feature-name)))
	(if domain
	    (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)
	    '(input (:type "submit" :value "-")))
      )
     ((eq (car exp) 'next-char)
      (list 'next-char
	    (list :object object :feature feature-name)
	    '(input (:type "submit" :value "+")))
      )
     ((eq (car exp) 'link)
      (list 'link
	    (list :ref 
		  (est-eval-list (plist-get (nth 1 exp) :ref)
					object feature-name lang uri-object))
	    (est-eval-list (nthcdr 2 exp)
				  object feature-name lang uri-object))
      )
     (t
      exp)))))

(defun est-eval-list (format-list object feature-name
				  &optional lang uri-object list-props)
  (if (consp format-list)
      (let ((ret
	     (mapcar
	      (lambda (exp)
		(est-eval-unit exp object feature-name lang uri-object nil))
	      format-list)))
	(if (cdr ret)
	    (list* 'list list-props ret)
	  (car ret)))
    (est-eval-unit format-list object feature-name lang uri-object nil)))


;;; @ End.
;;;

(provide 'est-eval)

;;; est-eval.el ends here