1 ;; -*- coding: utf-8-mcs-er -*-
2 (require 'cwiki-format)
3 (require 'char-db-json)
5 (defvar chise-wiki-view-url "view.cgi")
6 (defvar chise-wiki-edit-url "edit.cgi")
7 (defvar chise-wiki-add-url "add.cgi")
9 (defun www-edit-display-feature-input-box (char feature-name
10 &optional format value)
12 (setq char (or (concord-decode-object '=id char 'feature)
13 (concord-make-object 'feature char))))
15 (setq format 'default))
17 (setq value (www-get-feature-value char feature-name)))
18 (if (and (symbolp value)
19 (eq format 'wiki-text))
20 (setq value (list (list value))))
22 (format "<p><input type=\"text\" name=\"feature-name\"
23 size=\"32\" maxlength=\"256\" value=\"%s\">"
25 (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
27 (format "%s<input type=\"text\" name=\"%s\"
28 size=\"64\" maxlength=\"256\" value=\"%s\">
29 <input type=\"submit\" value=\"set\" /></p>
31 (if (or (eq format 'HEX)(eq format 'hex))
35 (mapconcat (lambda (c)
37 ;; ((eq c ?<) "&lt;")
38 ;; ((eq c ?>) "&gt;")
39 ((eq c ?\u0022) """)
42 (est-format-list value format nil nil " ")
46 (defun www-display-object-desc (genre uri-object &optional uri-feature-name
48 uri-feature-name-to-edit editing-format)
51 (let ((object (www-uri-decode-object genre uri-object))
52 (est-eval-list-feature-items-limit est-eval-list-feature-items-limit)
53 (est-view-url-prefix (if uri-feature-name
56 (rdf-uri-object (if est-hide-cgi-mode
57 (if (string-match "=" uri-object)
59 (est-uri-decode-feature-name-body
60 (substring uri-object 0 (match-beginning 0)))
62 (est-uri-decode-feature-name-body
63 (substring uri-object (match-end 0))))
65 feature-name-to-display feature-name-to-edit
66 base-name-to-edit metadata-name-to-edit
68 logical-feature chise-wiki-displayed-features
70 GlyphWiki-id HNG-card ret object-spec)
74 (setq without-header t))
76 (when uri-feature-name-to-edit
77 (setq feature-name-to-edit
78 (www-uri-decode-feature-name uri-feature-name-to-edit))
79 (setq ret (symbol-name feature-name-to-edit))
80 (if (string-match "\\*" ret)
81 (setq base-name-to-edit (intern
82 (substring ret 0 (match-beginning 0)))
83 metadata-name-to-edit (intern
84 (substring ret (match-end 0))))
85 (setq base-name-to-edit feature-name-to-edit))
86 (when (stringp editing-format)
87 (setq editing-format (intern editing-format))))
88 (when (and (eq genre 'character)
89 (= (length uri-object) 1))
90 (setq uri-object (www-uri-encode-object object)))
95 <style type=\"text/css\">
98 .ids { vertical-align: middle; font-size: 40px; line-height: 100%%; }
99 a { text-decoration: none; }
100 .ids a { color: black; }
101 ul { margin: 0 0; color: black; }
102 li { margin: 0 0 0 2em; }
103 .feature-name { font-family: sans-serif; font-weight: bold; }
104 .feature-name a { color: black; }
108 display: inline-block;
109 border-bottom: 1px dotted black;
112 .tooltip .tooltiptext {
118 background-color: black;
128 .list .tooltip:hover .tooltiptext {
134 <title>EsT %s = %s</title>
137 (decode-uri-string uri-object 'utf-8-mcs-er))
140 (when (eq genre 'character)
141 (dolist (feature (char-feature-property '$object 'additional-features))
142 (mount-char-attribute-table
143 (char-feature-name-at-domain feature '$rev=latest))))
147 (if est-hide-cgi-mode
148 "<div style=\"text-align:right;\">
149 <a href=\"../../edit/view.cgi?%s=%s\">
150 <input type=\"submit\" value=\"Edit\" />
152 "<div style=\"text-align:right;\">
153 <a href=\"edit/view.cgi?%s=%s\">
154 <input type=\"submit\" value=\"Edit\" />
156 genre rdf-uri-object)
158 "<div style=\"text-align:right;\">
159 <a href=\"../view/%s/%s\">
160 <input type=\"submit\" value=\"Simple\" />
163 (if (string-match ":" uri-object)
165 (est-uri-encode-feature-name-body
166 (substring uri-object 0 (match-beginning 0)))
168 (est-uri-encode-feature-name-body
169 (substring uri-object (match-end 0))))))))
171 (format "<input type=\"submit\" value=\"New Account\" />
172 <a href=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
173 <input type=\"submit\" value=\"RDF\" />
178 (if (eq genre 'character)
180 <a href=\"/est/view/%s/%s/data.json\">
181 <input type=\"submit\" value=\"JSON\" />
183 genre rdf-uri-object)
185 (when (setq parents (www-get-feature-value object '<-denotational))
186 (princ (format "<p>%s %s</p>\n<hr>\n"
187 (www-format-value-as-char-list parents)
188 (www-format-feature-name '->denotational lang))))
189 (when (setq parents (www-get-feature-value object '<-subsumptive))
190 (princ (format "<p>%s %s</p>\n<hr>\n"
191 (www-format-value-as-char-list parents)
192 (www-format-feature-name '->subsumptive lang))))
193 (when (eq genre 'character)
194 (setq GlyphWiki-id (char-GlyphWiki-id object)))
195 (setq ret (www-format-encode-string
196 (est-format-object object 'readable)))
198 (if (string-match "<img alt=\"HNG\\([0-9]+\\)-\\([0-9]+\\)\"" ret)
199 (format "HNG/%s/cards/%s.jpg"
201 (match-string 2 ret))))
202 (princ (format "<h%d>%s%s</h%d>\n"
205 (format "<a href=\"%s\">%s</a>"
206 ;; (if est-hide-cgi-mode
207 ;; "<a href=\"../%s\">%s</a>"
208 ;; "<a href=\"%s\">%s</a>")
209 (www-uri-make-object-url object uri-object)
213 "<a href=\"http://hng.chise.org/images/%s\">%s</a>"
218 " <a href=\"http://glyphwiki.org/wiki/%s\"><img alt=\"%s\" src=\"http://glyphwiki.org/glyph/%s.50px.png\" /></a>"
220 GlyphWiki-id GlyphWiki-id)
225 (when feature-name-to-edit
226 (princ "<form action=\"set.cgi\" method=\"GET\">\n")
228 (encode-coding-string
229 (format "<p>(%s : <input type=\"text\" name=\"%s\"
230 size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
233 (decode-uri-string uri-object 'utf-8-mcs-er))
238 (setq feature-name-to-display
239 (www-uri-decode-feature-name uri-feature-name))
240 (setq est-eval-list-feature-items-limit nil)
242 (cons feature-name-to-display
243 (if (eq genre 'character)
244 (get-char-attribute object feature-name-to-display)
245 (concord-object-get object feature-name-to-display)))))
247 (if (eq genre 'character)
248 (char-attribute-alist object)
249 (concord-object-spec object)))))
250 (when feature-name-to-edit
251 (unless (assq base-name-to-edit object-spec)
252 (setq object-spec (cons (cons base-name-to-edit nil)
254 (dolist (cell (sort object-spec
256 (char-attribute-name<
257 (char-feature-name-sans-versions (car a))
258 (char-feature-name-sans-versions (car b))))))
259 (setq logical-feature (char-feature-name-sans-versions (car cell)))
260 (unless (memq logical-feature chise-wiki-displayed-features)
261 (push logical-feature chise-wiki-displayed-features)
263 ((and feature-name-to-edit
264 (eq (car cell) feature-name-to-edit))
265 (www-edit-display-feature-input-box
266 object feature-name-to-edit editing-format)
271 "<div class=\"feature\" style=\"line-height:150%\">\n"
274 (www-format-eval-list
275 (www-feature-format logical-feature)
277 logical-feature ; (car cell)
282 (format " <a href=\"%s?%s=%s&feature=%s&format=wiki-text\"
283 ><input type=\"submit\" value=\"note\" /></a>"
286 (www-format-encode-string uri-object)
287 (www-format-encode-string
288 (www-uri-encode-feature-name
289 (intern (format "%s*note"
290 logical-feature ; (car cell)
292 (when (and feature-name-to-edit
293 (eq base-name-to-edit (car cell)) metadata-name-to-edit)
296 (www-edit-display-feature-input-box
297 object feature-name-to-edit editing-format)
310 (when feature-name-to-edit
314 (format "<a href=\"%s?%s=%s\"
315 ><input type=\"submit\" value=\"add feature\" /></a>
319 (www-format-encode-string uri-object))))
324 (when (eq genre 'character)
326 "<form action=\"http://www.chise.org/ids-find\">\n")
328 (www-format-encode-string
329 (est-format-object object)
330 ;; (if (eq genre 'character)
331 ;; (format "%c" object)
332 ;; (format "%s" (concord-object-id object)))
336 " <input type=\"text\" name=\"components\"
337 size=\"30\" maxlength=\"30\" value=\"%s\" />"
338 (encode-coding-string
339 (est-format-object object)
340 ;; (if (eq genre 'character)
341 ;; (char-to-string object)
342 ;; (format "%s" (concord-object-id object)))
345 (www-format-encode-string
346 "を\u542Bむ\u6F22\u5B57を\u63A2す"))
347 (princ " <input type=\"submit\" value=\"search\" />\n")
351 "<form action=\"http://www.chise.org/hng-ids-find\">\n")
353 (www-format-encode-string
354 (est-format-object object)
355 ;; (if (eq genre 'character)
356 ;; (format "%c" object)
357 ;; (format "%s" (concord-object-id object)))
361 " <input type=\"text\" name=\"components\"
362 size=\"30\" maxlength=\"30\" value=\"%s\" />"
363 (encode-coding-string
364 (est-format-object object)
365 ;; (if (eq genre 'character)
366 ;; (char-to-string object)
367 ;; (format "%s" (concord-object-id object)))
370 (www-format-encode-string
371 "を\u542Bむ HNG の\u6F22\u5B57を\u63A2す"))
372 (princ " <input type=\"submit\" value=\"search\" />\n")
381 (defun www-display-feature-desc (uri-feature-name genre uri-object
382 &optional lang simple)
383 (let ((rdf-uri-object (if est-hide-cgi-mode
384 (if (string-match "=" uri-object)
386 (est-uri-decode-feature-name-body
387 (substring uri-object 0 (match-beginning 0)))
389 (est-uri-decode-feature-name-body
390 (substring uri-object (match-end 0))))
392 (feature-name (www-uri-decode-feature-name uri-feature-name))
393 (name@lang (intern (format "name@%s" lang))))
395 (encode-coding-string
397 <title>EsT feature: %s</title>
405 (if est-hide-cgi-mode
406 "<div style=\"text-align:right;\">
407 <a href=\"../../../edit/view.cgi?feature=%s&%s=%s\">
408 <input type=\"submit\" value=\"Edit\" />
410 <input type=\"submit\" value=\"New Account\" />
413 "<div style=\"text-align:right;\">
414 <a href=\"edit/view.cgi?feature=%s&%s=%s\">
415 <input type=\"submit\" value=\"Edit\" />
417 <input type=\"submit\" value=\"New Account\" />
420 uri-feature-name genre rdf-uri-object)
422 "<div style=\"text-align:right;\">
423 <a href=\"../view/feature/%s&%s/%s\">
424 <input type=\"submit\" value=\"Simple\" />
428 uri-feature-name genre uri-object)))
430 (format "<h1>%s</h1>\n"
431 (www-format-encode-string
432 (symbol-name feature-name))))
433 (princ (format "<p>name : %s "
434 (or (www-format-feature-name feature-name) "")))
438 " <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
443 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
448 (www-format-encode-string
451 (or (char-feature-property feature-name name@lang) ""))))
455 " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
461 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
463 (www-html-display-paragraph
465 (or (www-feature-type feature-name)
466 ;; (char-feature-property feature-name 'type)
468 (princ (format "<p>value-format : %s "
471 (or (www-feature-value-format feature-name)
479 " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
485 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
488 (princ (format "<p>value-presentation-format : %s "
490 nil 'value-presentation-format
491 (or (www-feature-value-format feature-name)
499 " <a href=\"%s?feature=%s&property=value-presentation-format&format=wiki-text&%s=%s\"
505 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
508 (princ "<p>format : ")
509 (www-html-display-text
510 (decode-coding-string
512 (www-feature-format feature-name))
517 " <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
523 (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
526 (www-html-display-paragraph
527 (format "description : %s"
528 (or (decode-coding-string
529 (char-feature-property feature-name 'description)
533 (www-html-display-paragraph
534 (format "description@%s : %s"
536 (or (char-feature-property
538 (intern (format "description@%s" lang)))
542 (defun www-batch-view ()
543 (setq terminal-coding-system 'binary)
545 (let* ((target (pop command-line-args-left))
546 (user (pop command-line-args-left))
547 (accept-language (pop command-line-args-left))
548 (mode (intern (pop command-line-args-left)))
553 (car (split-string accept-language ","))
557 (princ "Content-Type: text/html; charset=UTF-8
559 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
560 \"http://www.w3.org/TR/html4/loose.dtd\">
565 (when (string-match "^char=\\(&[^&;]+;\\)" target)
566 (setq ret (match-end 0))
569 (www-uri-encode-object
570 (www-uri-decode-object
571 'character (match-string 1 target)))
572 (substring target ret))))
574 (mapcar (lambda (cell)
575 (if (string-match "=" cell)
577 (setq genre (substring cell 0 (match-beginning 0))
578 ret (substring cell (match-end 0)))
581 (decode-uri-string genre 'utf-8-mcs-er))
583 (list (decode-uri-string cell 'utf-8-mcs-er))))
584 (split-string target "&")))
585 (setq ret (car target))
586 (cond ((eq (car ret) 'char)
587 (www-display-object-desc
588 'character (cdr ret) (cdr (assq 'feature target))
592 ((eq (car ret) 'feature)
593 (www-display-feature-desc
594 (decode-uri-string (cdr ret) 'utf-8-mcs-er)
601 (www-display-object-desc
602 (car ret) (cdr ret) (cdr (assq 'feature target))
608 (princ (format "mode=%S\n" mode))
609 (princ (format "user=%s\n" user))
610 ;; (princ (format "local user=%s\n" (user-login-name)))
611 (princ (format "lang=%S\n" lang))
612 (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
614 ;; (princ xemacs-chise-version)
620 (princ (format "%S" err)))
623 (defun www-batch-view-smart ()
624 (setq debug-on-error t)
625 (setq terminal-coding-system 'binary)
627 (let* ((est-hide-cgi-mode t)
628 (target (pop command-line-args-left))
629 (user (pop command-line-args-left))
630 (accept-language (pop command-line-args-left))
631 (mode (intern (pop command-line-args-left)))
636 (car (split-string accept-language ","))
639 ret genre feature json obj)
642 (when (string-match "/data\\.json$" target)
644 target (substring target 0 (match-beginning 0))))
645 (when (string-match "^char/\\(&[^&;]+;\\)" target)
646 (setq ret (match-end 0))
649 (www-uri-encode-object
650 (www-uri-decode-object
651 'character (match-string 1 target)))
652 (substring target ret))))
656 (if (string-match "/" cell)
658 (setq genre (substring cell 0 (match-beginning 0))
659 ret (substring cell (match-end 0)))
661 (intern (decode-uri-string genre 'utf-8-mcs-er))
662 (if (string-match "/feature=" ret)
663 (list (substring ret 0 (match-beginning 0))
664 (substring ret (match-end 0)))
666 (list (decode-uri-string cell 'utf-8-mcs-er)))
667 ;; (setq ret (split-string cell "/"))
669 ;; (decode-uri-string (car ret) 'utf-8-mcs-er))
672 (split-string target "&")))
673 (setq ret (car target))
675 (princ "Content-Type: application/json; charset=UTF-8
678 (princ "Content-Type: text/html; charset=UTF-8
680 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
681 \"http://www.w3.org/TR/html4/loose.dtd\">
685 ;; (princ (format "<p>%S, %S, %S</p>"
686 ;; (car ret)(nth 1 ret)(nth 2 ret)))
687 ;; (princ (format "// %S %S\n" ret json))
688 (cond ((or (eq (car ret) 'char)
689 (eq (car ret) 'character))
691 (setq obj (www-uri-decode-object
692 (car ret)(nth 1 ret)))
695 ;; (princ (encode-coding-string
696 ;; (format "// %S\n" obj)
697 ;; char-db-file-coding-system))
698 (char-db-json-char-data-with-variant obj 'printable)
699 (encode-coding-region
700 (point-min)(point-max)
701 char-db-file-coding-system)
702 (princ (buffer-string))
704 (www-display-object-desc
705 'character (nth 1 ret) (nth 2 ret)
709 ((eq (car ret) 'feature)
710 (www-display-feature-desc
711 (decode-uri-string (nth 1 ret) 'utf-8-mcs-er)
713 (nth 1 (nth 1 target))
718 (www-display-object-desc
719 (car ret) (nth 1 ret) (nth 2 ret)
726 (princ (format "mode=%S\n" mode))
727 (princ (format "user=%s\n" user))
728 ;; (princ (format "local user=%s\n" (user-login-name)))
729 (princ (format "lang=%S\n" lang))
730 (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
732 ;; (princ xemacs-chise-version)
739 (princ (format "%S" err)))
742 (provide 'cwiki-view)