1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'cwiki-common)
5 ;;; @ Feature value presentation
8 (defun www-format-value-as-kuten (value)
11 (- (logand value 255) 32)))
13 (defun www-format-value-default (value &optional without-tags)
17 (www-format-encode-string
21 (www-format-encode-string (format "%S" value) without-tags)))
23 (defun www-format-value-as-char-list (value &optional without-tags)
28 (www-format-encode-string
29 (format (if (characterp unit)
34 (let (genre-o name-f ret)
37 (format "<a href=\"%s?char=%s\">%s</a>"
39 (www-uri-encode-object unit)
40 (www-format-encode-string (char-to-string unit)))
41 (format "<a href=\"%s?%s=%s\">%s</a>"
43 (concord-object-genre unit)
44 (concord-object-id unit)
47 (www-get-feature-value
51 (concord-decode-object
53 (concord-object-genre unit)
55 (www-get-feature-value
57 'object-representative-feature)
59 (www-format-eval-feature-value
60 unit name-f nil nil nil ret
61 'without-tags 'without-edit)
64 (setq ret (concord-object-get
66 'object-representative-format)))
68 ret unit nil nil nil 'without-tags 'without-edit)
71 (www-format-encode-string
76 (www-format-encode-string (format "%s" value) without-tags)))
78 (defun www-format-value-as-domain-list (value &optional without-tags)
79 (let (name source0 source num dest rest unit start end ddest)
88 (setq unit (pop rest))
90 (setq name (symbol-name unit)))
95 ((string-match "^zob1968=" name)
96 (setq source (intern (substring name 0 (match-end 0)))
97 num (substring name (match-end 0)))
98 (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
99 (setq start (string-to-number
100 (match-string 1 num))
101 end (string-to-number
102 (match-string 2 num)))
103 (setq start (string-to-number num)
106 (if (eq source source0)
108 ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
110 (setq source0 source)
112 " <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/\">%s</a>=<a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
113 (www-format-encode-string "\u4EAC
\e$BBg?M
\e(B\u6587
\e$B8&9C
\e(B\u9AA8")
115 (setq start (1+ start))
116 (while (<= start end)
121 ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
123 (setq start (1+ start)))
127 (if (eq source source0)
129 (setq source0 source)
133 (www-format-encode-string (format "%s" value) without-tags))))
135 (defun www-format-value-as-ids (value &optional without-tags)
140 (www-format-encode-string
141 (format (if (characterp unit)
147 (if (characterp unit)
148 (format "<a href=\"%s?char=%s\">%s</a>"
150 (www-uri-encode-object unit)
151 (www-format-encode-string (char-to-string unit)))
152 (www-format-encode-string (format "%s" unit)))))
153 (ideographic-structure-to-ids value) " ")
154 (www-format-encode-string (format "%s" value) without-tags)))
156 (defun www-format-value-as-S-exp (value &optional without-tags)
157 (www-format-encode-string (format "%S" value) without-tags))
159 (defun www-format-value-as-HEX (value)
162 (www-format-value-as-S-exp value)))
164 ;; (defun www-format-value-as-CCS-default (value)
165 ;; (if (integerp value)
166 ;; (format "0x%s (%d)"
167 ;; (www-format-value-as-HEX value)
169 ;; (www-format-value-as-S-exp value)))
171 ;; (defun www-format-value-as-CCS-94x94 (value)
172 ;; (if (integerp value)
173 ;; (format "0x%s [%s] (%d)"
174 ;; (www-format-value-as-HEX value)
175 ;; (www-format-value-as-kuten value)
177 ;; (www-format-value-as-S-exp value)))
179 (defun www-format-value-as-kangxi-radical (value)
180 (if (and (integerp value)
183 (www-format-encode-string
184 (format "%c" (ideographic-radical value)))
185 (www-format-value-as-S-exp value)))
187 (defun www-format-value (object feature-name
188 &optional value format
189 without-tags without-edit)
191 (setq value (www-get-feature-value object feature-name)))
192 (www-format-apply-value object feature-name
193 format nil value nil nil
194 without-tags without-edit)
198 ;;; @ format evaluator
201 (defun www-format-props-to-string (props &optional format)
203 (setq format (plist-get props :format)))
205 (plist-get props :flag)
206 ;; (if (plist-get props :zero-padding)
208 (if (plist-get props :len)
210 (let ((ret (plist-get props :len)))
215 ((eq format 'decimal) "d")
216 ((eq format 'hex) "x")
217 ((eq format 'HEX) "X")
218 ((eq format 'S-exp) "S")
221 (defun www-format-apply-value (object feature-name
223 &optional uri-object uri-feature
224 without-tags without-edit)
228 ((memq format '(decimal hex HEX))
230 (format (www-format-props-to-string props format)
232 (www-format-encode-string
236 ((eq format 'wiki-text)
238 (www-xml-format-list value)
239 (www-format-eval-list value object feature-name nil uri-object
240 without-tags without-edit))
243 (www-format-encode-string
244 (format (www-format-props-to-string props format)
248 (www-format-value-as-kuten value))
249 ((eq format 'kangxi-radical)
250 (www-format-value-as-kangxi-radical value))
251 ((eq format 'space-separated-char-list)
252 (www-format-value-as-char-list value without-tags))
253 ((eq format 'space-separated-ids)
254 (www-format-value-as-ids value without-tags))
255 ((eq format 'space-separated-domain-list)
256 (www-format-value-as-domain-list value without-tags))
258 (www-format-encode-string (format "%s" value) without-tags)
261 (www-format-value-default value without-tags)
266 (eq (plist-get props :mode) 'peek))
268 (format "%s <a href=\"%s?%s=%s&feature=%s&format=%s\"
269 ><input type=\"submit\" value=\"edit\" /></a>"
272 (est-object-genre object)
273 uri-object uri-feature format))))
275 (defun www-format-eval-feature-value (object
277 &optional format lang uri-object value
278 without-tags without-edit)
280 (setq value (www-get-feature-value object feature-name)))
282 (setq format (www-feature-value-format feature-name)))
285 (www-format-apply-value
288 uri-object (www-uri-encode-feature-name feature-name)
289 without-tags without-edit)
292 (cond ((null (cdr format))
293 (setq format (car format))
294 (www-format-apply-value
296 (car format) (nth 1 format) value
297 uri-object (www-uri-encode-feature-name feature-name)
298 without-tags without-edit)
301 (www-format-eval-list format object feature-name lang uri-object
302 without-tags without-edit)
305 (defun www-format-eval-unit (exp object feature-name
306 &optional lang uri-object value
307 without-tags without-edit)
309 (setq value (www-get-feature-value object feature-name)))
311 (setq uri-object (www-uri-encode-object object)))
313 ((stringp exp) (www-format-encode-string exp))
317 ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
318 S-exp string default))
319 (let ((fn (plist-get (nth 1 exp) :feature))
320 domain domain-fn ret)
323 (setq fn (intern fn)))
324 (setq domain (char-feature-name-domain feature-name))
325 (setq domain-fn (char-feature-name-at-domain fn domain))
326 (if (setq ret (www-get-feature-value object domain-fn))
327 (setq feature-name domain-fn
329 (setq feature-name fn
330 value (www-get-feature-value object fn)))
331 (push feature-name chise-wiki-displayed-features)
333 (if (eq (car exp) 'value)
334 (www-format-eval-feature-value object feature-name
335 (plist-get (nth 1 exp) :format)
336 lang uri-object value
337 without-tags without-edit)
338 (www-format-apply-value
340 (car exp) (nth 1 exp) value
341 uri-object (www-uri-encode-feature-name feature-name)
342 without-tags without-edit))
344 ((eq (car exp) 'name)
345 (let ((fn (plist-get (nth 1 exp) :feature))
348 (setq domain (char-feature-name-domain feature-name))
350 (setq fn (intern fn)))
351 (setq domain-fn (char-feature-name-at-domain fn domain))
352 (setq feature-name domain-fn)))
354 (www-format-feature-name feature-name lang)
355 (format "<a href=\"%s\">%s</a>"
356 (www-uri-make-feature-name-url
357 (www-uri-encode-feature-name feature-name)
359 (www-format-feature-name feature-name lang))
362 ((eq (car exp) 'name-url)
363 (let ((fn (plist-get (nth 1 exp) :feature))
366 (setq domain (char-feature-name-domain feature-name))
368 (setq fn (intern fn)))
369 (setq domain-fn (char-feature-name-at-domain fn domain))
370 (setq feature-name domain-fn)))
371 (www-uri-make-feature-name-url
372 (www-uri-encode-feature-name feature-name)
375 ((eq (car exp) 'domain-name)
376 (let ((domain (char-feature-name-domain feature-name)))
378 (format "@%s" domain))))
379 ((eq (car exp) 'prev-char)
382 (let ((prev-char (find-previous-defined-code-point
383 feature-name value)))
385 (format "\n<a href=\"%s?char=%s\">%s</a>"
387 (www-uri-encode-object prev-char)
388 "<input type=\"submit\" value=\"-\" />"
389 ;; (www-format-encode-string
390 ;; (char-to-string prev-char))
394 ((eq (car exp) 'next-char)
397 (let ((next-char (find-next-defined-code-point
398 feature-name value)))
400 (format "<a href=\"%s?char=%s\">%s</a>"
402 (www-uri-encode-object next-char)
403 "<input type=\"submit\" value=\"+\" />"
404 ;; (www-format-encode-string
405 ;; (char-to-string next-char))
409 ((eq (car exp) 'link)
411 (www-format-eval-list (nthcdr 2 exp)
412 object feature-name lang uri-object
413 without-tags without-edit)
418 (www-format-eval-list (plist-get (nth 1 exp) :ref)
419 object feature-name lang uri-object
420 'without-tags 'without-edit)
421 (www-format-eval-list (nthcdr 2 exp)
422 object feature-name lang uri-object
423 without-tags without-edit)))
430 (www-format-eval-list (nthcdr 2 exp) object feature-name
432 without-tags without-edit)
435 (defun www-format-eval-list (format-list object feature-name
436 &optional lang uri-object
437 without-tags without-edit)
438 (if (consp format-list)
441 (www-format-eval-unit exp object feature-name lang uri-object
442 nil without-tags without-edit))
444 (www-format-eval-unit format-list object feature-name lang uri-object
445 nil without-tags without-edit)))
451 (provide 'cwiki-format)
453 ;;; cwiki-format.el ends here