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-representation-format)
59 (www-format-eval-feature-value
60 unit name-f nil nil nil ret
61 'without-tags 'without-edit)
64 (www-format-encode-string
69 (www-format-encode-string (format "%s" value) without-tags)))
71 (defun www-format-value-as-domain-list (value &optional without-tags)
72 (let (name source0 source num dest rest unit start end ddest)
81 (setq unit (pop rest))
83 (setq name (symbol-name unit)))
88 ((string-match "^zob1968=" name)
89 (setq source (intern (substring name 0 (match-end 0)))
90 num (substring name (match-end 0)))
91 (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
92 (setq start (string-to-number
95 (match-string 2 num)))
96 (setq start (string-to-number num)
99 (if (eq source source0)
101 ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
103 (setq source0 source)
105 " <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>"
106 (www-format-encode-string "\u4EAC
\e$BBg?M
\e(B\u6587
\e$B8&9C
\e(B\u9AA8")
108 (setq start (1+ start))
109 (while (<= start end)
114 ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
116 (setq start (1+ start)))
120 (if (eq source source0)
122 (setq source0 source)
126 (www-format-encode-string (format "%s" value) without-tags))))
128 (defun www-format-value-as-ids (value &optional without-tags)
133 (www-format-encode-string
134 (format (if (characterp unit)
140 (if (characterp unit)
141 (format "<a href=\"%s?char=%s\">%s</a>"
143 (www-uri-encode-object unit)
144 (www-format-encode-string (char-to-string unit)))
145 (www-format-encode-string (format "%s" unit)))))
146 (ideographic-structure-to-ids value) " ")
147 (www-format-encode-string (format "%s" value) without-tags)))
149 (defun www-format-value-as-S-exp (value &optional without-tags)
150 (www-format-encode-string (format "%S" value) without-tags))
152 (defun www-format-value-as-HEX (value)
155 (www-format-value-as-S-exp value)))
157 ;; (defun www-format-value-as-CCS-default (value)
158 ;; (if (integerp value)
159 ;; (format "0x%s (%d)"
160 ;; (www-format-value-as-HEX value)
162 ;; (www-format-value-as-S-exp value)))
164 ;; (defun www-format-value-as-CCS-94x94 (value)
165 ;; (if (integerp value)
166 ;; (format "0x%s [%s] (%d)"
167 ;; (www-format-value-as-HEX value)
168 ;; (www-format-value-as-kuten value)
170 ;; (www-format-value-as-S-exp value)))
172 (defun www-format-value-as-kangxi-radical (value)
173 (if (and (integerp value)
176 (www-format-encode-string
177 (format "%c" (ideographic-radical value)))
178 (www-format-value-as-S-exp value)))
180 (defun www-format-value (object feature-name
181 &optional value format
182 without-tags without-edit)
184 (setq value (www-get-feature-value object feature-name)))
185 (www-format-apply-value object feature-name
186 format nil value nil nil
187 without-tags without-edit)
191 ;;; @ format evaluator
194 (defun www-format-props-to-string (props &optional format)
196 (setq format (plist-get props :format)))
198 (plist-get props :flag)
199 ;; (if (plist-get props :zero-padding)
201 (if (plist-get props :len)
203 (let ((ret (plist-get props :len)))
208 ((eq format 'decimal) "d")
209 ((eq format 'hex) "x")
210 ((eq format 'HEX) "X")
211 ((eq format 'S-exp) "S")
214 (defun www-format-apply-value (object feature-name
216 &optional uri-object uri-feature
217 without-tags without-edit)
221 ((memq format '(decimal hex HEX))
223 (format (www-format-props-to-string props format)
225 (www-format-encode-string
229 ((eq format 'wiki-text)
231 (www-xml-format-list value)
232 (www-format-eval-list value object feature-name nil uri-object
233 without-tags without-edit))
236 (www-format-encode-string
237 (format (www-format-props-to-string props format)
241 (www-format-value-as-kuten value))
242 ((eq format 'kangxi-radical)
243 (www-format-value-as-kangxi-radical value))
244 ((eq format 'space-separated-char-list)
245 (www-format-value-as-char-list value without-tags))
246 ((eq format 'space-separated-ids)
247 (www-format-value-as-ids value without-tags))
248 ((eq format 'space-separated-domain-list)
249 (www-format-value-as-domain-list value without-tags))
251 (www-format-encode-string (format "%s" value) without-tags)
254 (www-format-value-default value without-tags)
259 (eq (plist-get props :mode) 'peek))
261 (format "%s <a href=\"%s?%s=%s&feature=%s&format=%s\"
262 ><input type=\"submit\" value=\"edit\" /></a>"
265 (est-object-genre object)
266 uri-object uri-feature format))))
268 (defun www-format-eval-feature-value (object
270 &optional format lang uri-object value
271 without-tags without-edit)
273 (setq value (www-get-feature-value object feature-name)))
275 (setq format (www-feature-value-format feature-name)))
278 (www-format-apply-value
281 uri-object (www-uri-encode-feature-name feature-name)
282 without-tags without-edit)
285 (cond ((null (cdr format))
286 (setq format (car format))
287 (www-format-apply-value
289 (car format) (nth 1 format) value
290 uri-object (www-uri-encode-feature-name feature-name)
291 without-tags without-edit)
294 (www-format-eval-list format object feature-name lang uri-object
295 without-tags without-edit)
298 (defun www-format-eval-unit (exp object feature-name
299 &optional lang uri-object value
300 without-tags without-edit)
302 (setq value (www-get-feature-value object feature-name)))
304 (setq uri-object (www-uri-encode-object object)))
306 ((stringp exp) (www-format-encode-string exp))
310 ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
311 S-exp string default))
312 (let ((fn (plist-get (nth 1 exp) :feature))
313 domain domain-fn ret)
316 (setq fn (intern fn)))
317 (setq domain (char-feature-name-domain feature-name))
318 (setq domain-fn (char-feature-name-at-domain fn domain))
319 (if (setq ret (www-get-feature-value object domain-fn))
320 (setq feature-name domain-fn
322 (setq feature-name fn
323 value (www-get-feature-value object fn)))
324 (push feature-name chise-wiki-displayed-features)
326 (if (eq (car exp) 'value)
327 (www-format-eval-feature-value object feature-name
328 (plist-get (nth 1 exp) :format)
329 lang uri-object value
330 without-tags without-edit)
331 (www-format-apply-value
333 (car exp) (nth 1 exp) value
334 uri-object (www-uri-encode-feature-name feature-name)
335 without-tags without-edit))
337 ((eq (car exp) 'name)
338 (let ((fn (plist-get (nth 1 exp) :feature))
341 (setq domain (char-feature-name-domain feature-name))
343 (setq fn (intern fn)))
344 (setq domain-fn (char-feature-name-at-domain fn domain))
345 (setq feature-name domain-fn)))
347 (www-format-feature-name feature-name lang)
348 (format "<a href=\"%s\">%s</a>"
349 (www-uri-make-feature-name-url
350 (www-uri-encode-feature-name feature-name)
352 (www-format-feature-name feature-name lang))
355 ((eq (car exp) 'name-url)
356 (let ((fn (plist-get (nth 1 exp) :feature))
359 (setq domain (char-feature-name-domain feature-name))
361 (setq fn (intern fn)))
362 (setq domain-fn (char-feature-name-at-domain fn domain))
363 (setq feature-name domain-fn)))
364 (www-uri-make-feature-name-url
365 (www-uri-encode-feature-name feature-name)
368 ((eq (car exp) 'domain-name)
369 (let ((domain (char-feature-name-domain feature-name)))
371 (format "@%s" domain))))
372 ((eq (car exp) 'prev-char)
375 (let ((prev-char (find-previous-defined-code-point
376 feature-name value)))
378 (format "\n<a href=\"%s?char=%s\">%s</a>"
380 (www-uri-encode-object prev-char)
381 "<input type=\"submit\" value=\"-\" />"
382 ;; (www-format-encode-string
383 ;; (char-to-string prev-char))
387 ((eq (car exp) 'next-char)
390 (let ((next-char (find-next-defined-code-point
391 feature-name value)))
393 (format "<a href=\"%s?char=%s\">%s</a>"
395 (www-uri-encode-object next-char)
396 "<input type=\"submit\" value=\"+\" />"
397 ;; (www-format-encode-string
398 ;; (char-to-string next-char))
402 ((eq (car exp) 'link)
404 (www-format-eval-list (nthcdr 2 exp)
405 object feature-name lang uri-object
406 without-tags without-edit)
411 (www-format-eval-list (plist-get (nth 1 exp) :ref)
412 object feature-name lang uri-object
413 'without-tags 'without-edit)
414 (www-format-eval-list (nthcdr 2 exp)
415 object feature-name lang uri-object
416 without-tags without-edit)))
423 (www-format-eval-list (nthcdr 2 exp) object feature-name
425 without-tags without-edit)
428 (defun www-format-eval-list (format-list object feature-name
429 &optional lang uri-object
430 without-tags without-edit)
431 (if (consp format-list)
434 (www-format-eval-unit exp object feature-name lang uri-object
435 nil without-tags without-edit))
437 (www-format-eval-unit format-list object feature-name lang uri-object
438 nil without-tags without-edit)))
444 (provide 'cwiki-format)
446 ;;; cwiki-format.el ends here