1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'cwiki-common)
4 (defvar est-eval-list-feature-items-limit 20)
6 (defun ruimoku-format-volume (spec value year lang)
8 (setq spec (car (read-from-string spec))))
9 (cond ((eq spec 'YY) (if (eq lang 'cjk)
13 ((eq spec 01) (concat value "期"))
14 ((eq spec 02) (concat value "巻"))
15 ((eq spec 03) (concat value "号"))
16 ((eq spec 04) (concat value "編"))
17 ((eq spec 05) (concat value "&MJ019590;"))
18 ((eq spec 06) (concat value "集"))
19 ((eq spec 07) (concat value "輯"))
20 ((eq spec 08) (concat value "部"))
21 ((eq spec 09) (concat value "部分"))
22 ((eq spec 10) (concat value "冊"))
23 ((eq spec 11) (concat value "分冊"))
24 ((eq spec 12) (concat value "次"))
25 ((eq spec 13) (concat value "月号"))
26 ((eq spec 14) (concat value "特集号"))
27 ((eq spec 15) (concat value "本"))
28 ((eq spec 16) (concat value "分"))
29 ((eq spec 51) (concat "Vol." value))
30 ((eq spec 52) (concat "No." value))
31 ((eq spec 53) (concat "Part " value))
32 ((eq spec 54) (concat "Issue " value))
33 ((eq spec 55) (concat "Tome " value))
34 ((eq spec 56) (concat "Tomo " value))
35 ((eq spec 57) (concat "Tomus " value))
36 ((eq spec 58) (concat "Fasc." value))
37 ((eq spec 59) (concat "Livre " value))
38 ((eq spec 60) (concat "Année " value))
39 ((eq spec 61) (concat "Bd." value))
40 ((eq spec 62) (concat "Heft " value))
41 ((eq spec 63) (concat "Nr." value))
42 ((eq spec 64) (concat "Jahrg." value))
43 ((eq spec 65) (concat "Jaarg." value))
44 ((eq spec 66) (concat "Trimestre" value))
49 ;;; @ Feature value presentation
52 (defun est-eval-value-as-S-exp (value)
53 (list 'S-exp nil (format "%S" value)))
55 (defun est-eval-value-default (value)
57 (if (eq (car value) 'omitted)
65 (est-eval-value-as-S-exp value)))
67 (defun est-eval-value-as-image-resource (value &optional accept-full-image)
68 (let ((name (concord-object-get value 'name)))
70 ((concord-object-get value 'image-offset-x)
71 (list 'img (list* :src (or (concord-object-get value '=location@iiif)
72 (concord-object-get value '=location))
77 (list 'img (list* :src (concord-object-get value '=location)
84 (defun est-eval-value-as-glyph-image (value)
85 (let ((image-resource (car (concord-object-get value '->image-resource))))
86 (est-eval-value-as-image-resource image-resource)))
88 (defun est-eval-value-as-image-object (value)
89 (let ((image-resource (car (concord-object-get value '->image-resource))))
90 (list 'object (list :object value)
91 (est-eval-value-as-image-resource
92 image-resource 'accept-full-image))))
94 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
95 ;; (when (integerp spec)
96 ;; (setq spec (format "%02d" spec)))
97 ;; (cond ((string= spec "YY") `((decimal (:feature
98 ;; ->published/date*year)) "年"))
99 ;; ((string= spec "00") `((decimal (:feature ,feature))))
100 ;; ((string= spec "01") `((decimal (:feature ,feature)) "期"))
101 ;; ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
102 ;; ((string= spec "03") `((decimal (:feature ,feature)) "号"))
103 ;; ((string= spec "04") `((decimal (:feature ,feature)) "&AJ1-03620;"))
104 ;; ((string= spec "05") `((decimal (:feature ,feature)) "&MJ019590;"))
105 ;; ((string= spec "06") `((decimal (:feature ,feature)) "集"))
106 ;; ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
107 ;; ((string= spec "08") `((decimal (:feature ,feature)) "部"))
108 ;; ((string= spec "09") `((decimal (:feature ,feature)) "部分"))
109 ;; ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
110 ;; ((string= spec "11") `((decimal (:feature ,feature)) "分冊"))
111 ;; ((string= spec "12") `((decimal (:feature ,feature)) "次"))
112 ;; ((string= spec "13") `((decimal (:feature ,feature)) "月号"))
113 ;; ((string= spec "14") `((decimal (:feature ,feature)) "特集号"))
114 ;; ((string= spec "15") `((decimal (:feature ,feature)) "本"))
115 ;; ((string= spec "16") `((decimal (:feature ,feature)) "分"))
116 ;; ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
117 ;; ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
118 ;; ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
119 ;; ((string= spec "54") `("Issue " ((decimal (:feature ,feature)))))
120 ;; ((string= spec "55") `("Tome " ((decimal (:feature ,feature)))))
121 ;; ((string= spec "56") `("Tomo " ((decimal (:feature ,feature)))))
122 ;; ((string= spec "57") `("Tomus " ((decimal (:feature ,feature)))))
123 ;; ((string= spec "58") `("Fasc." ((decimal (:feature ,feature)))))
124 ;; ((string= spec "59") `("Livre " ((decimal (:feature ,feature)))))
125 ;; ((string= spec "60") `("Année " ((decimal (:feature ,feature)))))
126 ;; ((string= spec "61") `("Bd." ((decimal (:feature ,feature)))))
127 ;; ((string= spec "62") `("Heft " ((decimal (:feature ,feature)))))
128 ;; ((string= spec "63") `("Nr." ((decimal (:feature ,feature)))))
129 ;; ((string= spec "64") `("Jahrg." ((decimal (:feature ,feature)))))
130 ;; ((string= spec "65") `("Jaarg." ((decimal (:feature ,feature)))))
131 ;; ((string= spec "66") `("Trimestre" ((decimal (:feature ,feature)))))
135 (defun est-eval-value-as-journal-volume (value &optional short)
136 (let ((journal (car (or (concord-object-get value '<-journal/volume)
137 (concord-object-get value '<-volume))))
138 (vol-name (concord-object-get value '<-journal/volume*name))
139 volume-type number-type
141 dest ret title subtitle)
147 (list 'object (list :object value)
149 (setq volume-type (concord-object-get journal 'volume/type/code)
150 number-type (concord-object-get journal 'number/type/code))
151 (setq year (or (concord-object-get value '->published/date*year)
153 (car (concord-object-get value 'date)) 'year)))
158 (ruimoku-format-volume
160 (or (concord-object-get value '<-journal/volume*volume)
161 (concord-object-get value '<-volume*volume))
163 (ruimoku-format-volume
165 (or (concord-object-get value '<-journal/volume*number)
166 (concord-object-get value '<-volume*number))
170 (if (setq ret (est-eval-value-as-object journal))
172 (list* ret " " dest))))
173 (list* 'list '(:subtype sequence :separator "") dest)
175 ((setq title (concord-object-get value 'title))
176 (setq subtitle (concord-object-get value 'title/subtitle))
179 (if (eq (concord-object-get value 'writing-system) 'cjk)
182 (list 'object (list :object value)
184 (concat title " — " subtitle)
189 (list 'object (list :object value)
191 (concat title " — " subtitle)
196 (est-eval-value-default value)
198 ;; (concat (concord-object-get journal 'name)
200 ;; (ruimoku-format-volume
202 ;; (or (concord-object-get value '<-journal/volume*volume)
203 ;; (concord-object-get value '<-volume*volume))
205 ;; (ruimoku-format-volume
207 ;; (or (concord-object-get value '<-journal/volume*number)
208 ;; (concord-object-get value '<-volume*number))
212 (defun est-eval-value-as-article (value)
213 (let ((journal-volume (car (concord-object-get value '<-article)))
214 (page (concord-object-get value 'page))
217 (setq date (car (concord-object-get journal-volume 'date)))
219 (setq ret (est-eval-value-as-object date)))
220 (setq dest (list ", " ret))))
222 (setq dest (list* ", pp." page dest)))
223 (when (and journal-volume
224 (setq ret (est-eval-value-as-journal-volume journal-volume)))
225 (setq dest (cons ret dest)))
226 (if (setq ret (est-eval-value-as-book value))
227 (setq dest (list* ret " " dest)))
228 (list* 'list '(:subtype sequence :separator "") dest))
229 ;; (let ((creators (concord-object-get value '->creator))
230 ;; (title (concord-object-get value 'title))
231 ;; creator-name creator-role)
235 ;; (setq creator-name
236 ;; (concord-object-get
237 ;; (car (concord-object-get creator '->creator/name))
239 ;; (setq creator-role
240 ;; (or (concord-object-get creator 'role*name)
242 ;; (concord-object-get creator 'role*type))))
243 ;; (concat creator-name " " creator-role))
245 ;; (if (eq (concord-object-get value 'writing-system) 'cjk)
246 ;; (concat "「" title "」")
247 ;; (concat " ‘" title "’"))))
250 (defun est-eval-value-as-book (value)
251 (let ((creators (concord-object-get value '->creator))
252 (title (concord-object-get value 'title))
253 (subtitle (concord-object-get value 'title/subtitle))
254 (series (concord-object-get value 'series))
255 (publisher (car (concord-object-get value 'publisher)))
256 (date (car (concord-object-get value 'date)))
257 ;; creator-name creator-role
260 (setq ret (est-eval-value-as-object date)))
261 (setq dest (list ", " ret)))
263 (setq ret (est-eval-value-as-object publisher)))
264 (setq dest (list* " " ret dest)))
266 (setq dest (list* series "," dest)))
269 (if (eq (concord-object-get value 'writing-system) 'cjk)
272 (list 'object (list :object value)
274 (concat title " — " subtitle)
279 (list 'object (list :object value)
281 (concat title " — " subtitle)
285 (list 'object (list :object value)
289 (setq ret (est-eval-value-as-creators-names creators)))
290 (setq dest (cons ret dest)))
291 (list* 'list '(:subtype sequence :separator "") dest)
295 ;; (setq creator-name
296 ;; (concord-object-get
297 ;; (car (concord-object-get creator '->creator/name))
299 ;; (setq creator-role
300 ;; (or (concord-object-get creator 'role*name)
302 ;; (concord-object-get creator 'role*type))))
303 ;; (concat creator-name " " creator-role))
305 ;; (if (eq (concord-object-get value 'writing-system) 'cjk)
308 ;; (concat " — " subtitle))
310 ;; (concat " ‘" title
312 ;; (concat " — " subtitle))
315 ;; (concat " " series))
318 ;; (concord-object-get
319 ;; (car (concord-object-get
320 ;; publisher '->publisher/name))
323 ;; (concat ", " (concord-object-get date 'name)))))
326 ;; (defun est-eval-creator (value)
328 ;; '((value (:feature ->name))
329 ;; (string (:feature role*name)))
332 (defun est-eval-value-as-object (value)
333 (if (or (characterp value)
334 (concord-object-p value))
335 (list 'object (list :object value)
336 (if (characterp value)
337 (char-to-string value)
338 (let ((genre (concord-object-genre value))
342 ((eq genre 'journal-volume@ruimoku)
344 ;; (est-journal-volume-get-object-format value)
346 (est-eval-value-as-journal-volume value)
348 ((eq genre 'article@ruimoku)
349 (est-eval-value-as-article value)
351 ((eq genre 'book@ruimoku)
352 (est-eval-value-as-book value)
354 ;; ((eq genre 'creator@ruimoku)
355 ;; (est-eval-creator value)
357 ((eq genre 'image-resource)
358 (est-eval-value-as-image-resource value)
360 ((eq genre 'glyph-image)
361 (est-eval-value-as-glyph-image value)
364 (setq genre-o (concord-decode-object '=id genre 'genre))
368 genre-o 'object-representative-format))
369 (est-eval-list format value nil))
370 (www-get-feature-value
373 (www-get-feature-value
374 genre-o 'object-representative-feature))
376 (www-get-feature-value value '=name)
377 (www-get-feature-value value '=title)
378 (est-eval-value-default value))
381 (est-eval-value-default value)))
383 (defun est-eval-value-as-character (value)
385 (if (and (concord-object-p value)
386 (setq ret (concord-object-get value 'character)))
387 (list 'object (list :object value)
388 (mapconcat #'char-to-string ret ""))
389 (est-eval-value-as-object value))))
391 (defun est-eval-value-as-object-with-description (value
393 &optional lang uri-object list-props)
397 (setq ret (or (get-char-attribute value 'description)
398 (get-char-attribute value 'hdic-syp-description)
399 (get-char-attribute value 'hdic-ktb-description)))
401 ((concord-object-p value)
402 (setq ret (concord-object-get value 'description))
406 (est-eval-value-as-object value)
409 lang uri-object list-props))
410 (est-eval-value-as-object value))))
412 (defun est-eval-value-as-hdic-tsj-character-with-description (value
415 lang uri-object list-props)
419 (when (setq word (get-char-attribute value 'hdic-tsj-word))
420 (if (and (= (length word) 1)
421 (setq ret (get-char-attribute value '<-HDIC-TSJ))
422 (memq (aref word 0) ret))
423 (setq desc (or (get-char-attribute value 'hdic-tsj-word-description)
424 (get-char-attribute value 'description)))
425 (setq desc (list "(" word ")"))))
427 ((concord-object-p value)
428 (setq desc (concord-object-get value 'description))
432 (est-eval-value-as-object value)
433 (est-eval-list (append desc '(" "))
435 lang uri-object list-props))
436 (est-eval-value-as-object value))))
438 (defun est-eval-value-as-location (value)
440 (if (and (concord-object-p value)
441 (setq ret (concord-object-get value '=location)))
442 (list 'object (list :object value)
444 (est-eval-value-as-object value))))
446 (defun est-eval-value-as-name (value)
448 (if (and (concord-object-p value)
449 (setq ret (concord-object-get value 'name)))
450 (list 'object (list :object value)
452 (est-eval-value-as-object value))))
454 (defun est-eval-value-as-HEX (value)
456 (list 'HEX nil (format "%X" value))
457 (est-eval-value-as-S-exp value)))
459 (defun est-eval-value-as-kuten (value)
464 (- (lsh value -8) 32)
465 (- (logand value 255) 32)))
466 (est-eval-value-as-S-exp value)))
468 (defun est-eval-value-as-kangxi-radical (value)
469 (if (and (integerp value)
472 (list 'kangxi-radical
474 (format "%c" (ideographic-radical value)))
475 (est-eval-value-as-S-exp value)))
477 (defun est-eval-value-as-shuowen-radical (value)
478 (if (and (integerp value)
481 (list 'shuowen-radical
483 (format "%c" (shuowen-radical value)))
484 (est-eval-value-as-S-exp value)))
486 (defun daijiten-page-number-to-ndl-950498 (page)
494 ((< page 516) ; 284=285
499 (defun est-eval-value-as-daijiten-page (value)
503 (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/950498/manifest.json&tify={%%22pages%%22:[%d]}"
504 (daijiten-page-number-to-ndl-950498 value)))
507 (defun est-eval-value-as-ndl-page-by-tify (value)
509 (setq value (symbol-name value)))
511 (if (string-match "/" value)
512 (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json&tify={%%22pages%%22:[%s]}"
513 (substring value 0 (match-beginning 0))
514 (substring value (match-end 0)))
515 (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json"
519 (defun est-eval-value-as-Web-yunzi-char (value)
520 (if (char-or-char-int-p value)
523 (format "http://suzukish.s252.xrea.com/search/inkyo/yunzi/%c"
525 (format "/%s/" (char-to-string value)))))
527 (defun est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number (value)
529 (setq value (symbol-name value)))
530 (if (and (stringp value)
532 "^Y\\([0-9][0-9]\\)\\([0-9][0-9][0-9]\\)\\([0-9][0-9][0-9]\\)-\\([0-9]\\)$"
534 (format "%d巻 %d紙 %d列 %d字目 (%s)"
535 (string-to-int (match-string 1 value))
536 (string-to-int (match-string 2 value))
537 (string-to-int (match-string 3 value))
538 (string-to-int (match-string 4 value))
542 (defun est-eval-value-as-object-list (value &optional separator subtype)
543 (if (and (listp value)
548 (setq props (list :separator separator)))
550 (setq props (list* :subtype subtype props)))
552 (mapcar #'est-eval-value-as-object value)))
553 (error (format "%s" value)))
554 (format "%s" value)))
556 (defun est-eval-value-as-char-list (value &optional separator subtype)
557 (if (and (listp value)
562 (setq props (list :separator separator)))
564 (setq props (list* :subtype subtype props)))
566 (mapcar #'est-eval-value-as-character value)))
567 (error (format "%s" value)))
568 (format "%s" value)))
570 (defun est-eval-value-as-location-list (value &optional separator subtype)
571 (if (and (listp value)
576 (setq props (list :separator separator)))
578 (setq props (list* :subtype subtype props)))
580 (mapcar #'est-eval-value-as-location value)))
581 (error (format "%s" value)))
582 (format "%s" value)))
584 (defun est-eval-value-as-name-list (value &optional separator subtype)
585 (if (and (listp value)
590 (setq props (list :separator separator)))
592 (setq props (list* :subtype subtype props)))
594 (mapcar #'est-eval-value-as-name value)))
595 (error (format "%s" value)))
596 (format "%s" value)))
598 (defun est-eval-value-as-image-list (value &optional separator subtype)
599 (if (and (listp value)
604 (setq props (list :separator separator)))
606 (setq props (list* :subtype subtype props)))
607 (list* 'image-list props
608 (mapcar #'est-eval-value-as-image-object value)))
609 (error (format "%s" value)))
610 (format "%s" value)))
612 (defun est-eval-value-as-composition-list (value &optional separator subtype)
613 (if (and (listp value)
618 (setq props (list :separator separator)))
620 (setq props (list* :subtype subtype props)))
626 (list 'object (list :object (car cell))
627 (format "U+%04X" (car cell)))
629 (est-eval-value-as-object (cdr cell))))
632 (< (car a)(car b)))))))
633 (error (format "%s" value)))
634 (format "%s" value)))
636 (defun est-eval-value-as-decomposition-list (value)
637 (if (and (listp value)
642 (mapconcat #'char-to-string value "")
645 (list* 'list '(:separator " + ")
648 (list 'object (list :object chr)
649 (format "U+%04X" chr)))
652 (error (format "%s" value)))
653 (format "%s" value)))
655 (defun est-eval-value-as-entry-character-list (value
657 &optional separator subtype
658 lang uri-object list-props)
659 (if (and (listp value)
664 (setq props (list :separator separator)))
666 (setq props (list* :subtype subtype props)))
668 (mapcar (lambda (cell)
669 (est-eval-value-as-object-with-description
672 lang uri-object list-props))
674 (error (format "%s" value)))
675 (format "%s" value)))
677 (defun est-eval-value-as-hdic-tsj-entry-character-list (value
679 &optional separator subtype
680 lang uri-object list-props)
681 (if (and (listp value)
686 (setq props (list :separator separator)))
688 (setq props (list* :subtype subtype props)))
690 (mapcar (lambda (cell)
691 (est-eval-value-as-hdic-tsj-character-with-description
694 lang uri-object list-props))
696 (error (format "%s" value)))
697 (format "%s" value)))
700 ;; (defun est-eval-value-as-ids (value)
702 ;; (list 'ids nil (ideographic-structure-to-ids value))
703 ;; (format "%s" value)))
704 (defun est-eval-value-as-ids (value)
708 (mapcar #'est-eval-value-as-object
709 (ideographic-structure-to-ids value))
711 (est-eval-value-default value)))
713 (defun est-eval-value-as-space-separated-ids (value)
717 ;; (mapconcat #'char-to-string
718 ;; (ideographic-structure-to-ids value)
720 (mapcar #'est-eval-value-as-object
721 (ideographic-structure-to-ids value))
723 (est-eval-value-default value)))
725 (defun est-eval-value-as-domain-list (value)
727 (let (source item source-objs source0 start end num)
737 ((string-match "=" unit)
739 (substring unit 0 (match-beginning 0)))
740 item (car (read-from-string
741 (substring unit (match-end 0)))))
746 (est-eval-value-as-object
747 (or (concord-decode-object
748 '=id item 'book@ruimoku)
749 (concord-decode-object
750 '=id item 'article@ruimoku)
753 ((memq source '(zob1959 zob1968))
754 (if (and (symbolp item)
755 (setq num (symbol-name item))
757 "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
758 (setq start (string-to-number
759 (match-string 1 num))
760 end (string-to-number
761 (match-string 2 num)))
764 (if (not (numberp start))
767 (est-eval-value-as-object (intern unit))))
768 (if (eq source source0)
773 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
776 (setq source0 source)
781 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
786 (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
787 "\u4EAC大人\u6587研甲\u9AA8")))
789 (setq num (1+ start))
795 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
800 (setq source-objs (nreverse source-objs)))
804 (list (est-eval-value-as-object (intern unit))))
808 :source source :item item)
812 (list 'res-link nil unit)
815 (est-eval-value-default value)))
817 (defun est-eval-value-as-sources (value)
820 source item source-objs source0 start end num
830 (if (string-match "=" unit-str)
832 (substring unit-str 0 (match-beginning 0)))
833 item (car (read-from-string
834 (substring unit-str (match-end 0)))))
838 ((and (setq source-cobj (concord-decode-object
839 '=chise-bib-id source 'bibliography))
840 (setq title (concord-object-get source-cobj '=title)))
843 (list (est-eval-value-as-object source-cobj)
846 (list (est-eval-value-as-object source-cobj))))
851 (est-eval-value-as-object
852 (or (concord-decode-object
853 '=id item 'book@ruimoku)
854 (concord-decode-object
855 '=id item 'article@ruimoku)
858 ((memq source '(zob1959 zob1968))
859 (if (and (symbolp item)
860 (setq num (symbol-name item))
862 "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
863 (setq start (string-to-number
864 (match-string 1 num))
865 end (string-to-number
866 (match-string 2 num)))
869 (if (not (numberp start))
872 (est-eval-value-as-object unit)))
873 (if (eq source source0)
878 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
881 (setq source0 source)
886 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
891 (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
892 "\u4EAC大人\u6587研甲\u9AA8")))
894 (setq num (1+ start))
900 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
905 (setq source-objs (nreverse source-objs)))
909 (list (est-eval-value-as-object unit)))
913 :source source :item item)
917 (est-eval-value-default value)))
919 (defun est-eval-value-as-daijiten-page-list (value &optional separator subtype)
920 (if (and (listp value)
925 (setq props (list :separator separator)))
927 (setq props (list* :subtype subtype props)))
929 (mapcar #'est-eval-value-as-daijiten-page value)))
930 (error (format "%s" value)))
931 (format "%s" value)))
933 (defun est-eval-value-as-Web-yunzi-char-list (value &optional separator subtype)
934 (if (and (listp value)
939 (setq props (list :separator separator)))
941 (setq props (list* :subtype subtype props)))
943 (mapcar #'est-eval-value-as-Web-yunzi-char value)))
944 (error (format "%s" value)))
945 (format "%s" value)))
947 (defun est-eval-value-as-creators-names (value &optional subtype)
952 '(:subtype unordered-list)
954 (mapcar (lambda (creator)
956 ((concord-object-p creator)
962 '(value (:feature ->creator/name))
964 'object (list :object creator)
967 (concord-object-get creator
974 (est-eval-value-default value)))
976 (defun est-eval-value-as-created-works (value &optional subtype)
980 '(:subtype unordered-list)
982 (mapcar (lambda (creator)
983 (if (concord-object-p creator)
985 '((value (:feature <-creator)))
987 (est-eval-value-default creator)))
989 (est-eval-value-default value)))
991 (defun est-eval-value-as-journal-volumes (value &optional subtype)
993 (list* 'journal-volumes
995 '(:subtype unordered-list)
997 (mapcar (lambda (volume)
998 (if (concord-object-p volume)
999 (est-eval-value-as-journal-volume volume 'short)
1002 (est-eval-value-default value)))
1005 ;;; @ format evaluator
1008 ;; (defun est-make-env (object feature-name)
1009 ;; (list (cons 'object object)
1010 ;; (cons 'feature-name feature-name)))
1012 ;; (defun est-env-push-item (env item value)
1013 ;; (cons (cons item value)
1016 ;; (defun est-env-get-item (env item)
1017 ;; (cdr (assq item env)))
1019 ;; (defun est-env-current-value (env)
1020 ;; (let ((obj (est-env-get-item env 'object))
1021 ;; (feature (est-env-get-item env 'feature-name)))
1022 ;; (if (characterp obj)
1023 ;; (char-feature obj feature)
1024 ;; (concord-object-get obj feature))))
1027 (defun est-eval-props-to-string (props &optional format)
1029 (setq format (plist-get props :format)))
1031 (plist-get props :flag)
1032 (if (plist-get props :len)
1034 (let ((ret (plist-get props :len)))
1039 ((eq format 'decimal) "d")
1040 ((eq format 'hex) "x")
1041 ((eq format 'HEX) "X")
1042 ((eq format 'S-exp) "S")
1045 (defun est-eval-apply-value (object feature-name format props value
1046 &optional uri-object)
1048 (list :object object
1049 :feature feature-name)
1051 ((memq format '(decimal hex HEX))
1052 (if (integerp value)
1055 (format (est-eval-props-to-string props format)
1057 (format "%s" value))
1059 ((eq format 'string)
1060 (list 'string nil (format "%s" value))
1062 ((eq format 'wiki-text)
1063 (est-eval-list value object feature-name nil uri-object)
1065 ((eq format 'unordered-link-list)
1066 (est-eval-list value object feature-name nil uri-object
1067 '(:subtype unordered-list :separator " "))
1070 (est-eval-value-as-S-exp value)
1072 ((eq format 'ku-ten)
1073 (est-eval-value-as-kuten value))
1074 ((eq format 'kangxi-radical)
1075 (est-eval-value-as-kangxi-radical value))
1076 ((eq format 'tify-url-for-ndl)
1077 (est-eval-value-as-ndl-page-by-tify value)
1079 ((eq format 'hdic-yy-readable)
1080 (est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number value)
1082 ((eq format 'shuowen-radical)
1083 (est-eval-value-as-shuowen-radical value))
1085 (est-eval-value-as-ids value))
1086 ((eq format 'decomposition)
1087 (est-eval-value-as-decomposition-list value))
1088 ((eq format 'composition)
1089 (est-eval-value-as-composition-list value))
1090 ((or (eq format 'space-separated)
1091 (eq format 'space-separated-char-list))
1092 (est-eval-value-as-object-list value " "))
1093 ((eq format 'char-list)
1094 (est-eval-value-as-char-list value nil))
1095 ((eq format 'location-list)
1096 (est-eval-value-as-location-list value nil))
1097 ((eq format 'name-list)
1098 (est-eval-value-as-name-list value nil))
1099 ((eq format 'image-list)
1100 (est-eval-value-as-image-list value nil))
1101 ((eq format 'unordered-list)
1102 (est-eval-value-as-object-list value nil 'unordered-list))
1103 ((eq format 'unordered-composition-list)
1104 (est-eval-value-as-composition-list value nil 'unordered-list))
1105 ((eq format 'entry-character-list)
1106 (est-eval-value-as-entry-character-list
1110 lang uri-object list-props))
1111 ((eq format 'unordered-entry-character-list)
1112 (est-eval-value-as-entry-character-list
1116 lang uri-object list-props))
1117 ((eq format 'hdic-tsj-entry-character-list)
1118 (est-eval-value-as-hdic-tsj-entry-character-list
1122 lang uri-object list-props))
1123 ((eq format 'space-separated-ids)
1124 (est-eval-value-as-space-separated-ids value))
1125 ((eq format 'space-separated-domain-list)
1126 ;; (est-eval-value-as-domain-list value)
1127 (est-eval-value-as-sources value))
1128 ((eq format 'space-separated-source-list)
1129 (est-eval-value-as-sources value))
1130 ((eq format 'space-separated-creator-name-list)
1131 (est-eval-value-as-creators-names value))
1132 ((eq format 'unordered-creator-name-list)
1133 (est-eval-value-as-creators-names value 'unordered-list))
1134 ((eq format 'space-separated-created-work-list)
1135 (est-eval-value-as-created-works value))
1136 ((eq format 'unordered-created-work-list)
1137 (est-eval-value-as-created-works value 'unordered-list))
1138 ((eq format 'journal-volume-list)
1139 (est-eval-value-as-journal-volumes value))
1140 ((eq format 'space-separated-daijiten-page-list)
1141 (est-eval-value-as-daijiten-page-list value " "))
1142 ((eq format 'space-separated-Web-yunzi-char-list)
1143 (est-eval-value-as-Web-yunzi-char-list value " "))
1145 (est-eval-value-default value)
1149 (defun est-eval-feature-value (object feature-name
1150 &optional format lang uri-object value)
1152 (setq value (www-get-feature-value object feature-name)))
1154 (setq format (www-feature-value-format feature-name)))
1155 (if (and (consp value)
1156 est-eval-list-feature-items-limit
1157 (not (eq feature-name 'sources)))
1158 (let ((ret (condition-case nil
1159 (nthcdr est-eval-list-feature-items-limit value)
1163 (list (list 'omitted
1164 (list :object object :feature feature-name)
1168 (est-eval-apply-value object feature-name
1174 ((null (cdr format))
1175 (setq format (car format))
1176 (est-eval-apply-value object feature-name
1177 (car format) (nth 1 format) value
1181 (est-eval-list format object feature-name lang uri-object)
1184 (defun est-eval-unit (exp object feature-name
1185 &optional lang uri-object value)
1187 (setq value (www-get-feature-value object feature-name)))
1189 (setq uri-object (www-uri-encode-object object)))
1192 ((or (characterp exp)
1193 (concord-object-p exp))
1194 (est-eval-value-as-object exp)
1199 ((memq (car exp) '(value decimal hex HEX ku-ten
1200 kangxi-radical shuowen-radical
1201 S-exp string default
1202 tify-url-for-ndl hdic-yy-readable))
1203 (let ((fn (plist-get (nth 1 exp) :feature))
1204 domain domain-fn ret)
1207 (setq fn (intern fn)))
1208 (setq domain (char-feature-name-domain feature-name))
1209 (setq domain-fn (char-feature-name-at-domain fn domain))
1210 (if (setq ret (www-get-feature-value object domain-fn))
1211 (setq feature-name domain-fn
1213 (setq feature-name fn
1214 value (www-get-feature-value object fn)))
1215 (push feature-name chise-wiki-displayed-features)
1217 (if (eq (car exp) 'value)
1218 (est-eval-feature-value object feature-name
1219 (plist-get (nth 1 exp) :format)
1220 lang uri-object value)
1221 (est-eval-apply-value
1223 (car exp) (nth 1 exp) value
1226 ((eq (car exp) 'name)
1227 (let ((fn (plist-get (nth 1 exp) :feature))
1230 (setq domain (char-feature-name-domain feature-name))
1232 (setq fn (intern fn)))
1233 (setq domain-fn (char-feature-name-at-domain fn domain))
1234 (setq feature-name domain-fn)))
1236 (list :object object
1237 :feature feature-name)
1238 (www-format-feature-name* feature-name lang))
1240 ((eq (car exp) 'name-url)
1241 (let ((fn (plist-get (nth 1 exp) :feature))
1242 (object (plist-get (nth 1 exp) :object))
1245 (setq domain (char-feature-name-domain feature-name))
1247 (setq fn (intern fn)))
1248 (setq domain-fn (char-feature-name-at-domain fn domain))
1249 (setq feature-name domain-fn)))
1250 (list 'name-url (list :feature feature-name)
1251 (www-uri-make-feature-name-url
1252 (est-object-genre object)
1253 (www-uri-encode-feature-name feature-name)
1256 ((eq (car exp) 'domain-name)
1257 (let ((domain (char-feature-name-domain feature-name)))
1259 (format "@%s" domain)
1262 ((eq (car exp) 'omitted)
1264 (list :object object :feature feature-name)
1267 ((eq (car exp) 'prev-char)
1269 (list :object object :feature feature-name)
1270 '(input (:type "submit" :value "-")))
1272 ((eq (car exp) 'next-char)
1274 (list :object object :feature feature-name)
1275 '(input (:type "submit" :value "+")))
1277 ((eq (car exp) 'link)
1280 (est-eval-list (plist-get (nth 1 exp) :ref)
1281 object feature-name lang uri-object))
1282 (est-eval-list (nthcdr 2 exp)
1283 object feature-name lang uri-object))
1288 (defun est-eval-list (format-list object feature-name
1289 &optional lang uri-object list-props)
1290 (if (consp format-list)
1294 (est-eval-unit exp object feature-name lang uri-object nil))
1297 (list* 'list list-props ret)
1299 (est-eval-unit format-list object feature-name lang uri-object nil)))
1307 ;;; est-eval.el ends here