1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'cwiki-common)
4 (defun ruimoku-format-volume (spec value year lang)
6 (setq spec (car (read-from-string spec))))
7 (cond ((eq spec 'YY) (if (eq lang 'cjk)
11 ((eq spec 01) (concat value "期"))
12 ((eq spec 02) (concat value "巻"))
13 ((eq spec 03) (concat value "号"))
14 ((eq spec 04) (concat value ">-35694;"))
15 ((eq spec 05) (concat value ">-33870;"))
16 ((eq spec 06) (concat value ">-56392;"))
17 ((eq spec 07) (concat value "輯"))
18 ((eq spec 08) (concat value ">-53119;"))
19 ((eq spec 09) (concat value ">-53119;&AJ1-03580;"))
20 ((eq spec 10) (concat value "冊"))
21 ((eq spec 11) (concat value "&AJ1-03580;冊"))
22 ((eq spec 12) (concat value "&J90-3C21;"))
23 ((eq spec 13) (concat value ">-18140;号"))
24 ((eq spec 14) (concat value "特>-56392;号"))
25 ((eq spec 15) (concat value "本"))
26 ((eq spec 16) (concat value "&AJ1-03580;"))
27 ((eq spec 51) (concat "Vol." value))
28 ((eq spec 52) (concat "No." value))
29 ((eq spec 53) (concat "Part " value))
30 ((eq spec 54) (concat "Issue " value))
31 ((eq spec 55) (concat "Tome " value))
32 ((eq spec 56) (concat "Tomo " value))
33 ((eq spec 57) (concat "Tomus " value))
34 ((eq spec 58) (concat "Fasc." value))
35 ((eq spec 59) (concat "Livre " value))
36 ((eq spec 60) (concat "Année " value))
37 ((eq spec 61) (concat "Bd." value))
38 ((eq spec 62) (concat "Heft " value))
39 ((eq spec 63) (concat "Nr." value))
40 ((eq spec 64) (concat "Jahrg." value))
41 ((eq spec 65) (concat "Jaarg." value))
42 ((eq spec 66) (concat "Trimestre" value))
47 ;;; @ Feature value presentation
50 (defun est-eval-value-as-S-exp (value)
51 (list 'S-exp nil (format "%S" value)))
53 (defun est-eval-value-default (value)
55 (if (eq (car value) 'omitted)
63 (est-eval-value-as-S-exp value)))
65 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
66 ;; (when (integerp spec)
67 ;; (setq spec (format "%02d" spec)))
68 ;; (cond ((string= spec "YY") `((decimal (:feature
69 ;; ->published/date*year)) "年"))
70 ;; ((string= spec "00") `((decimal (:feature ,feature))))
71 ;; ((string= spec "01") `((decimal (:feature ,feature)) "期"))
72 ;; ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
73 ;; ((string= spec "03") `((decimal (:feature ,feature)) "号"))
74 ;; ((string= spec "04") `((decimal (:feature ,feature)) ">-35694;"))
75 ;; ((string= spec "05") `((decimal (:feature ,feature)) ">-33870;"))
76 ;; ((string= spec "06") `((decimal (:feature ,feature)) ">-56392;"))
77 ;; ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
78 ;; ((string= spec "08") `((decimal (:feature ,feature)) ">-53119;"))
79 ;; ((string= spec "09") `((decimal (:feature ,feature)) ">-53119;&AJ1-03580;"))
80 ;; ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
81 ;; ((string= spec "11") `((decimal (:feature ,feature)) "&AJ1-03580;冊"))
82 ;; ((string= spec "12") `((decimal (:feature ,feature)) "&J90-3C21;"))
83 ;; ((string= spec "13") `((decimal (:feature ,feature)) ">-18140;号"))
84 ;; ((string= spec "14") `((decimal (:feature ,feature)) "特>-56392;号"))
85 ;; ((string= spec "15") `((decimal (:feature ,feature)) "本"))
86 ;; ((string= spec "16") `((decimal (:feature ,feature)) "&AJ1-03580;"))
87 ;; ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
88 ;; ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
89 ;; ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
90 ;; ((string= spec "54") `("Issue " ((decimal (:feature ,feature)))))
91 ;; ((string= spec "55") `("Tome " ((decimal (:feature ,feature)))))
92 ;; ((string= spec "56") `("Tomo " ((decimal (:feature ,feature)))))
93 ;; ((string= spec "57") `("Tomus " ((decimal (:feature ,feature)))))
94 ;; ((string= spec "58") `("Fasc." ((decimal (:feature ,feature)))))
95 ;; ((string= spec "59") `("Livre " ((decimal (:feature ,feature)))))
96 ;; ((string= spec "60") `("Année " ((decimal (:feature ,feature)))))
97 ;; ((string= spec "61") `("Bd." ((decimal (:feature ,feature)))))
98 ;; ((string= spec "62") `("Heft " ((decimal (:feature ,feature)))))
99 ;; ((string= spec "63") `("Nr." ((decimal (:feature ,feature)))))
100 ;; ((string= spec "64") `("Jahrg." ((decimal (:feature ,feature)))))
101 ;; ((string= spec "65") `("Jaarg." ((decimal (:feature ,feature)))))
102 ;; ((string= spec "66") `("Trimestre" ((decimal (:feature ,feature)))))
106 (defun est-eval-journal-volume (value)
107 (let ((journal (car (concord-object-get value '<-volume)))
108 volume-type number-type
110 (setq volume-type (concord-object-get journal 'volume/type/code)
111 number-type (concord-object-get journal 'number/type/code))
112 (setq year (or (concord-object-get value '->published/date*year)
114 (car (concord-object-get value 'date)) 'year)))
115 ;; (append (list (concord-object-get journal 'name))
116 ;; (est-journal-volume-object-get-volume-format
117 ;; volume-type '<-volume*volume)
118 ;; (est-journal-volume-object-get-volume-format
119 ;; number-type '<-volume*number)
121 (concat (concord-object-get journal 'name)
123 (ruimoku-format-volume
125 (concord-object-get value '<-volume*volume)
127 (ruimoku-format-volume
129 (concord-object-get value '<-volume*number)
133 ;; (defun est-eval-creator (value)
135 ;; '((value (:feature ->name))
136 ;; (string (:feature role*name)))
139 (defun est-eval-value-as-object (value)
140 (if (or (characterp value)
141 (concord-object-p value))
142 (list 'object (list :object value)
143 (if (characterp value)
144 (char-to-string value)
145 (let ((genre (concord-object-genre value))
149 ((eq genre 'journal-volume@ruimoku)
151 ;; (est-journal-volume-get-object-format value)
153 (est-eval-journal-volume value)
155 ;; ((eq genre 'creator@ruimoku)
156 ;; (est-eval-creator value)
159 (setq genre-o (concord-decode-object '=id genre 'genre))
163 genre-o 'object-representative-format))
164 (est-eval-list format value nil))
165 (www-get-feature-value
168 (www-get-feature-value
169 genre-o 'object-representative-feature))
171 (www-get-feature-value value '=name)
172 (est-eval-value-default value))
175 (est-eval-value-default value)))
177 (defun est-eval-value-as-HEX (value)
179 (list 'HEX nil (format "%X" value))
180 (est-eval-value-as-S-exp value)))
182 (defun est-eval-value-as-kuten (value)
187 (- (lsh value -8) 32)
188 (- (logand value 255) 32)))
189 (est-eval-value-as-S-exp value)))
191 (defun est-eval-value-as-kangxi-radical (value)
192 (if (and (integerp value)
195 (list 'kangxi-radical
197 (format "%c" (ideographic-radical value)))
198 (est-eval-value-as-S-exp value)))
200 (defun est-eval-value-as-object-list (value &optional separator)
204 (list :separator separator))
207 ;; (if (characterp unit)
208 ;; (list 'char-link nil (format "%c" unit))
209 ;; (format "%s" unit)))
211 (mapcar #'est-eval-value-as-object value)
213 (format "%s" value)))
215 (defun est-eval-value-as-ids (value)
217 (list 'ids nil (ideographic-structure-to-ids value))
218 (format "%s" value)))
220 (defun est-eval-value-as-space-separated-ids (value)
224 ;; (mapconcat #'char-to-string
225 ;; (ideographic-structure-to-ids value)
227 (mapcar #'est-eval-value-as-object
228 (ideographic-structure-to-ids value))
230 (est-eval-value-default value)))
232 (defun est-eval-value-as-domain-list (value)
234 (let (source item source-objs source0 start end num)
244 ((string-match "=" unit)
246 (substring unit 0 (match-beginning 0)))
247 item (car (read-from-string
248 (substring unit (match-end 0)))))
253 (est-eval-value-as-object
254 (or (concord-decode-object
255 '=id item 'book@ruimoku)
256 (concord-decode-object
257 '=id item 'article@ruimoku)
260 ((eq source 'zob1968)
261 (if (and (symbolp item)
262 (setq num (symbol-name item))
264 "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
265 (setq start (string-to-number
266 (match-string 1 num))
267 end (string-to-number
268 (match-string 2 num)))
271 (if (not (numberp start))
274 (est-eval-value-as-object (intern unit))))
275 (if (eq source source0)
280 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
283 (setq source0 source)
288 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
293 (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
294 "\u4EAC大人\u6587研甲\u9AA8")))
296 (setq num (1+ start))
302 (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
307 (setq source-objs (nreverse source-objs)))
311 (list (est-eval-value-as-object (intern unit))))
314 (list :source source :item item)
318 (list 'res-link nil unit)
321 (est-eval-value-default value)))
323 (defun est-eval-value-as-creators-names (value)
328 (mapcar (lambda (creator)
330 (concord-object-get creator
334 '(value (:feature ->creator/name))
336 'object (list :object creator)
339 (concord-object-get creator
345 (est-eval-value-default value)))
347 (defun est-eval-value-as-created-works (value)
351 (mapcar (lambda (creator)
353 '((value (:feature <-creator)))
356 (est-eval-value-default value)))
359 ;;; @ format evaluator
362 ;; (defun est-make-env (object feature-name)
363 ;; (list (cons 'object object)
364 ;; (cons 'feature-name feature-name)))
366 ;; (defun est-env-push-item (env item value)
367 ;; (cons (cons item value)
370 ;; (defun est-env-get-item (env item)
371 ;; (cdr (assq item env)))
373 ;; (defun est-env-current-value (env)
374 ;; (let ((obj (est-env-get-item env 'object))
375 ;; (feature (est-env-get-item env 'feature-name)))
376 ;; (if (characterp obj)
377 ;; (char-feature obj feature)
378 ;; (concord-object-get obj feature))))
381 (defun est-eval-props-to-string (props &optional format)
383 (setq format (plist-get props :format)))
385 (plist-get props :flag)
386 (if (plist-get props :len)
388 (let ((ret (plist-get props :len)))
393 ((eq format 'decimal) "d")
394 ((eq format 'hex) "x")
395 ((eq format 'HEX) "X")
396 ((eq format 'S-exp) "S")
399 (defun est-eval-apply-value (object feature-name format props value
400 &optional uri-object)
403 :feature feature-name)
405 ((memq format '(decimal hex HEX))
409 (format (est-eval-props-to-string props format)
414 (list 'string nil (format "%s" value))
416 ((eq format 'wiki-text)
417 (est-eval-list value object feature-name nil uri-object)
420 (est-eval-value-as-S-exp value)
423 (est-eval-value-as-kuten value))
424 ((eq format 'kangxi-radical)
425 (est-eval-value-as-kangxi-radical value))
427 (est-eval-value-as-ids value))
428 ((or (eq format 'space-separated)
429 (eq format 'space-separated-char-list))
430 (est-eval-value-as-object-list value " "))
431 ((eq format 'space-separated-ids)
432 (est-eval-value-as-space-separated-ids value))
433 ((eq format 'space-separated-domain-list)
434 (est-eval-value-as-domain-list value))
435 ((eq format 'space-separated-creator-name-list)
436 (est-eval-value-as-creators-names value))
437 ((eq format 'space-separated-created-work-list)
438 (est-eval-value-as-created-works value))
440 (est-eval-value-default value)
444 (defun est-eval-feature-value (object feature-name
445 &optional format lang uri-object value)
447 (setq value (www-get-feature-value object feature-name)))
449 (setq format (www-feature-value-format feature-name)))
451 (let ((ret (condition-case nil
457 (list :object object :feature feature-name)
461 (est-eval-apply-value object feature-name
468 (setq format (car format))
469 (est-eval-apply-value object feature-name
470 (car format) (nth 1 format) value
474 (est-eval-list format object feature-name lang uri-object)
477 (defun est-eval-unit (exp object feature-name
478 &optional lang uri-object value)
480 (setq value (www-get-feature-value object feature-name)))
482 (setq uri-object (www-uri-encode-object object)))
485 ((or (characterp exp)
486 (concord-object-p exp))
487 (est-eval-value-as-object exp)
492 ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
493 S-exp string default))
494 (let ((fn (plist-get (nth 1 exp) :feature))
495 domain domain-fn ret)
498 (setq fn (intern fn)))
499 (setq domain (char-feature-name-domain feature-name))
500 (setq domain-fn (char-feature-name-at-domain fn domain))
501 (if (setq ret (www-get-feature-value object domain-fn))
502 (setq feature-name domain-fn
504 (setq feature-name fn
505 value (www-get-feature-value object fn)))
506 (push feature-name chise-wiki-displayed-features)
508 (if (eq (car exp) 'value)
509 (est-eval-feature-value object feature-name
510 (plist-get (nth 1 exp) :format)
511 lang uri-object value)
512 (est-eval-apply-value
514 (car exp) (nth 1 exp) value
517 ((eq (car exp) 'name)
518 (let ((fn (plist-get (nth 1 exp) :feature))
521 (setq domain (char-feature-name-domain feature-name))
523 (setq fn (intern fn)))
524 (setq domain-fn (char-feature-name-at-domain fn domain))
525 (setq feature-name domain-fn)))
528 :feature feature-name)
529 (www-format-feature-name* feature-name lang))
531 ((eq (car exp) 'name-url)
532 (let ((fn (plist-get (nth 1 exp) :feature))
533 (object (plist-get (nth 1 exp) :object))
536 (setq domain (char-feature-name-domain feature-name))
538 (setq fn (intern fn)))
539 (setq domain-fn (char-feature-name-at-domain fn domain))
540 (setq feature-name domain-fn)))
541 (list 'name-url (list :feature feature-name)
542 (www-uri-make-feature-name-url
543 (est-object-genre object)
544 (www-uri-encode-feature-name feature-name)
547 ((eq (car exp) 'domain-name)
548 (let ((domain (char-feature-name-domain feature-name)))
550 (format "@%s" domain)
553 ((eq (car exp) 'omitted)
555 (list :object object :feature feature-name)
558 ((eq (car exp) 'prev-char)
560 (list :object object :feature feature-name)
561 '(input (:type "submit" :value "-")))
563 ((eq (car exp) 'next-char)
565 (list :object object :feature feature-name)
566 '(input (:type "submit" :value "+")))
568 ((eq (car exp) 'link)
571 (est-eval-list (plist-get (nth 1 exp) :ref)
572 object feature-name lang uri-object))
573 (est-eval-list (nthcdr 2 exp)
574 object feature-name lang uri-object))
579 (defun est-eval-list (format-list object feature-name
580 &optional lang uri-object)
581 (if (consp format-list)
585 (est-eval-unit exp object feature-name lang uri-object nil))
588 (list* 'list nil ret)
590 (est-eval-unit format-list object feature-name lang uri-object nil)))
598 ;;; est-eval.el ends here