X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-view.el;h=3c4e0aa752c8ceb5b76547adca05929fb61b2305;hb=534806df1aa633ceac38159f69e0348673e1fc12;hp=85dc28403d3c097b38b64e3b4947d12b23d35531;hpb=3bc214127e92f6056612a6e54e19b789dbd1c422;p=chise%2Fest.git diff --git a/cwiki-view.el b/cwiki-view.el index 85dc284..3c4e0aa 100644 --- a/cwiki-view.el +++ b/cwiki-view.el @@ -1,5 +1,6 @@ ;; -*- coding: utf-8-mcs-er -*- (require 'cwiki-format) +(require 'char-db-json) (defvar chise-wiki-view-url "view.cgi") (defvar chise-wiki-edit-url "edit.cgi") @@ -42,17 +43,31 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> ""))) ) -(defun www-display-object-desc (genre uri-object &optional lang level simple +(defun www-display-object-desc (genre uri-object &optional uri-feature-name + lang level simple uri-feature-name-to-edit editing-format) (unless level (setq level 0)) (let ((object (www-uri-decode-object genre uri-object)) - feature-name-to-edit + (est-eval-list-feature-items-limit est-eval-list-feature-items-limit) + (est-view-url-prefix (if uri-feature-name + "../.." + "..")) + (rdf-uri-object (if est-hide-cgi-mode + (if (string-match "=" uri-object) + (concat + (est-uri-decode-feature-name-body + (substring uri-object 0 (match-beginning 0))) + ":" + (est-uri-decode-feature-name-body + (substring uri-object (match-end 0)))) + uri-object))) + feature-name-to-display feature-name-to-edit base-name-to-edit metadata-name-to-edit without-header logical-feature chise-wiki-displayed-features parents - GlyphWiki-id ret object-spec) + GlyphWiki-id HNG-card ret object-spec) (if (eq level 0) (setq level 1 without-header nil) @@ -77,6 +92,19 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> (princ (encode-coding-string (format " + + EsT %s = %s \n" genre @@ -88,23 +116,46 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> (mount-char-attribute-table (char-feature-name-at-domain feature '$rev=latest)))) (princ - (format - (if simple - "
+ (if simple + (format + (if est-hide-cgi-mode + "
+ + +\n" + "
- - -
-
\n" +\n") + genre rdf-uri-object) + (format "
- + - +\n" + genre + (if (string-match ":" uri-object) + (concat + (est-uri-encode-feature-name-body + (substring uri-object 0 (match-beginning 0))) + "=" + (est-uri-encode-feature-name-body + (substring uri-object (match-end 0)))))))) + (princ + (format " + + +%s
-
\n") - genre - uri-object)) +
\n" + genre rdf-uri-object + (if (eq genre 'character) + (format " + + +\n" + genre rdf-uri-object) + ""))) (when (setq parents (www-get-feature-value object '<-denotational)) (princ (format "

%s %s

\n
\n" (www-format-value-as-char-list parents) @@ -115,10 +166,27 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> (www-format-feature-name '->subsumptive lang)))) (when (eq genre 'character) (setq GlyphWiki-id (char-GlyphWiki-id object))) + (setq ret (www-format-encode-string + (est-format-object object 'readable))) + (setq HNG-card + (if (string-match "\"HNG\\([0-9]+\\)-\\([0-9]+\\)\""%s%s\n" level - (www-format-encode-string - (est-format-object object 'readable)) + (if uri-feature-name + (format "%s" + ;; (if est-hide-cgi-mode + ;; "%s" + ;; "%s") + (www-uri-make-object-url object uri-object) + ret) + (if HNG-card + (format + "%s" + HNG-card ret) + ret)) (if GlyphWiki-id (format " \"%s\"" @@ -139,9 +207,20 @@ size=\"30\" maxlength=\"30\" value=\"%s\">)

(decode-uri-string uri-object 'utf-8-mcs-er)) 'utf-8-mcs-er))) (setq object-spec - (if (eq genre 'character) - (char-attribute-alist object) - (concord-object-spec object))) + (cond + (uri-feature-name + (setq feature-name-to-display + (www-uri-decode-feature-name uri-feature-name)) + (setq est-eval-list-feature-items-limit nil) + (list + (cons feature-name-to-display + (if (eq genre 'character) + (get-char-attribute object feature-name-to-display) + (concord-object-get object feature-name-to-display))))) + (t + (if (eq genre 'character) + (char-attribute-alist object) + (concord-object-spec object))))) (when feature-name-to-edit (unless (assq base-name-to-edit object-spec) (setq object-spec (cons (cons base-name-to-edit nil) @@ -240,7 +319,33 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (www-format-encode-string "を\u542Bむ\u6F22\u5B57を\u63A2す")) (princ " \n") - (princ "\n")) + (princ "\n") + + (princ + "
\n") + (princ + (www-format-encode-string + (est-format-object object) + ;; (if (eq genre 'character) + ;; (format "%c" object) + ;; (format "%s" (concord-object-id object))) + )) + (princ + (format + " " + (encode-coding-string + (est-format-object object) + ;; (if (eq genre 'character) + ;; (char-to-string object) + ;; (format "%s" (concord-object-id object))) + 'utf-8-jp-er))) + (princ + (www-format-encode-string + "を\u542Bむ HNG の\u6F22\u5B57を\u63A2す")) + (princ " \n") + (princ "
\n") + ) (princ (if (= level 1) "

\n" @@ -249,7 +354,16 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (defun www-display-feature-desc (uri-feature-name genre uri-object &optional lang simple) - (let ((feature-name (www-uri-decode-feature-name uri-feature-name)) + (let ((rdf-uri-object (if est-hide-cgi-mode + (if (string-match "=" uri-object) + (concat + (est-uri-decode-feature-name-body + (substring uri-object 0 (match-beginning 0))) + ":" + (est-uri-decode-feature-name-body + (substring uri-object (match-end 0)))) + uri-object))) + (feature-name (www-uri-decode-feature-name uri-feature-name)) (name@lang (intern (format "name@%s" lang)))) (princ (encode-coding-string @@ -260,22 +374,32 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" 'utf-8-mcs-er)) (princ "\n") (princ - (format - (if simple - "
- + (if simple + (format + (if est-hide-cgi-mode + "
+
\n" - "
- - + "
+ + +
\n") - uri-feature-name genre uri-object)) + uri-feature-name genre rdf-uri-object) + (format + "
+ + + +
+
\n" + uri-feature-name genre uri-object))) (princ (format "

%s

\n" (www-format-encode-string @@ -335,6 +459,26 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (princ "\n")) (princ "

\n") + (princ (format "

value-presentation-format : %s " + (www-format-value + nil 'value-presentation-format + (or (www-feature-value-format feature-name) + 'default) + 'default + 'without-tags) + )) + (unless simple + (princ + (format + " " + chise-wiki-edit-url + uri-feature-name + genre + uri-object)) + (princ "\n")) + (princ "

\n") + (princ "

format : ") (www-html-display-text (decode-coding-string @@ -355,7 +499,9 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (www-html-display-paragraph (format "description : %s" - (or (char-feature-property feature-name 'description) + (or (decode-coding-string + (char-feature-property feature-name 'description) + 'utf-8-mcs-er) ""))) (when lang (www-html-display-paragraph @@ -381,7 +527,7 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (car (split-string accept-language ",")) ";")) "-")))) - ret) + ret genre) (princ "Content-Type: text/html; charset=UTF-8 " (setq target (mapcar (lambda (cell) (if (string-match "=" cell) - (cons - (intern - (decode-uri-string - (substring cell 0 (match-beginning 0)) - 'utf-8-mcs-er)) - (substring cell (match-end 0))) + (progn + (setq genre (substring cell 0 (match-beginning 0)) + ret (substring cell (match-end 0))) + (cons + (intern + (decode-uri-string genre 'utf-8-mcs-er)) + ret)) (list (decode-uri-string cell 'utf-8-mcs-er)))) (split-string target "&"))) (setq ret (car target)) (cond ((eq (car ret) 'char) (www-display-object-desc - 'character - (cdr ret) + 'character (cdr ret) (cdr (assq 'feature target)) lang nil (eq mode 'simple)) ) @@ -427,8 +573,7 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" ) (t (www-display-object-desc - (car ret) - (cdr ret) + (car ret) (cdr ret) (cdr (assq 'feature target)) lang nil (eq mode 'simple)) )) @@ -449,4 +594,123 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (princ (format "%S" err))) )) +(defun www-batch-view-smart () + (setq debug-on-error t) + (setq terminal-coding-system 'binary) + (condition-case err + (let* ((est-hide-cgi-mode t) + (target (pop command-line-args-left)) + (user (pop command-line-args-left)) + (accept-language (pop command-line-args-left)) + (mode (intern (pop command-line-args-left))) + (lang + (intern + (car (split-string + (car (split-string + (car (split-string accept-language ",")) + ";")) + "-")))) + ret genre feature json obj) + (cond + ((stringp target) + (when (string-match "/data\\.json$" target) + (setq json t + target (substring target 0 (match-beginning 0)))) + (when (string-match "^char/\\(&[^&;]+;\\)" target) + (setq ret (match-end 0)) + (setq target + (concat "char/" + (www-uri-encode-object + (www-uri-decode-object + 'character (match-string 1 target))) + (substring target ret)))) + (setq target + (mapcar + (lambda (cell) + (if (string-match "/" cell) + (progn + (setq genre (substring cell 0 (match-beginning 0)) + ret (substring cell (match-end 0))) + (cons + (intern (decode-uri-string genre 'utf-8-mcs-er)) + (if (string-match "/feature=" ret) + (list (substring ret 0 (match-beginning 0)) + (substring ret (match-end 0))) + (list ret)))) + (list (decode-uri-string cell 'utf-8-mcs-er))) + ;; (setq ret (split-string cell "/")) + ;; (cons (intern + ;; (decode-uri-string (car ret) 'utf-8-mcs-er)) + ;; (cdr ret)) + ) + (split-string target "&"))) + (setq ret (car target)) + (if json + (princ "Content-Type: application/json; charset=UTF-8 + +") + (princ "Content-Type: text/html; charset=UTF-8 + + + +") + ) + ;; (princ (format "

%S, %S, %S

" + ;; (car ret)(nth 1 ret)(nth 2 ret))) + ;; (princ (format "// %S %S\n" ret json)) + (cond ((or (eq (car ret) 'char) + (eq (car ret) 'character)) + (if (and json + (setq obj (www-uri-decode-object + (car ret)(nth 1 ret))) + (characterp obj)) + (with-temp-buffer + ;; (princ (encode-coding-string + ;; (format "// %S\n" obj) + ;; char-db-file-coding-system)) + (char-db-json-char-data-with-variant obj) + (encode-coding-region + (point-min)(point-max) + char-db-file-coding-system) + (princ (buffer-string)) + ) + (www-display-object-desc + 'character (nth 1 ret) (nth 2 ret) + lang nil + (eq mode 'simple))) + ) + ((eq (car ret) 'feature) + (www-display-feature-desc + (decode-uri-string (nth 1 ret) 'utf-8-mcs-er) + (car (nth 1 target)) + (nth 1 (nth 1 target)) + lang + (eq mode 'simple)) + ) + (t + (www-display-object-desc + (car ret) (nth 1 ret) (nth 2 ret) + lang nil + (eq mode 'simple)) + )) + )) + (unless json + (princ "\n
\n") + (princ (format "mode=%S\n" mode)) + (princ (format "user=%s\n" user)) + ;; (princ (format "local user=%s\n" (user-login-name))) + (princ (format "lang=%S\n" lang)) + (princ (encode-coding-string (emacs-version) 'utf-8-jp-er)) + ;; (princ " CHISE ") + ;; (princ xemacs-chise-version) + (princ " + +") + ) + ) + (error nil + (princ (format "%S" err))) + )) + (provide 'cwiki-view)