X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=blobdiff_plain;f=cwiki-view.el;h=ca965f2517ac12de0edc15c7c33fdbcdfaed47fc;hp=915fccbb890811c936a2aff83d2986ed1c7a2115;hb=HEAD;hpb=eae785f6f6cdd98fce94928670576c28a97a57b4 diff --git a/cwiki-view.el b/cwiki-view.el index 915fccb..bf0dd07 100644 --- a/cwiki-view.el +++ b/cwiki-view.el @@ -1,176 +1,660 @@ ;; -*- coding: utf-8-mcs-er -*- -(require 'cwiki-common) +(require 'cwiki-format) +(require 'char-db-json) +(require 'concord-turtle-dump) (defvar chise-wiki-view-url "view.cgi") (defvar chise-wiki-edit-url "edit.cgi") (defvar chise-wiki-add-url "add.cgi") -(defun www-display-char-desc (uri-char &optional lang level simple) +(defun www-edit-display-feature-input-box (char feature-name + &optional format value) + (if (symbolp char) + (setq char (or (concord-decode-object '=id char 'feature) + (concord-make-object 'feature char)))) + (unless format + (setq format 'default)) + (unless value + (setq value (www-get-feature-value char feature-name))) + (if (and (symbolp value) + (eq format 'wiki-text)) + (setq value (list (list value)))) + (princ + (format "

" + feature-name)) + (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er)) + (princ + (format "%s +

+" + (if (or (eq format 'HEX)(eq format 'hex)) + "0x" + "") + format + (mapconcat (lambda (c) + (cond + ;; ((eq c ?<) "&lt;") + ;; ((eq c ?>) "&gt;") + ((eq c ?\u0022) """) + (t + (char-to-string c)))) + (est-format-list value format nil nil " ") + ""))) + ) + +(defun www-display-object-desc (genre uri-object &optional uri-feature-name + image-selection + lang level simple + uri-feature-name-to-edit editing-format) (unless level - (setq level 1)) - (let ((char (www-uri-decode-char uri-char)) - logical-feature displayed-features + (setq level 0)) + (let ((object (www-uri-decode-object genre uri-object)) + (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) - (when (characterp char) - (when (= (length uri-char) 1) - (setq uri-char (www-uri-encode-char char))) + GlyphWiki-id HNG-card HNG-card-id HNG-card-cobj ret object-spec + ucs + item-code page char-num glyph-image-id + width height image-cobj base-image x y w h) + (if (eq level 0) + (setq level 1 + without-header nil) + (setq without-header t)) + (when object + (when uri-feature-name-to-edit + (setq feature-name-to-edit + (www-uri-decode-feature-name uri-feature-name-to-edit)) + (setq ret (symbol-name feature-name-to-edit)) + (if (string-match "\\*" ret) + (setq base-name-to-edit (intern + (substring ret 0 (match-beginning 0))) + metadata-name-to-edit (intern + (substring ret (match-end 0)))) + (setq base-name-to-edit feature-name-to-edit)) + (when (stringp editing-format) + (setq editing-format (intern editing-format)))) + (when (and (eq genre 'character) + (= (length uri-object) 1)) + (setq uri-object (www-uri-encode-object object))) (when (= level 1) (princ (encode-coding-string (format " -CHISE-wiki character: %s + + + + +EsT %s = %s \n" - (decode-uri-string uri-char 'utf-8-mcs-er)) + genre + (decode-uri-string uri-object 'utf-8-mcs-er)) 'utf-8-mcs-er)) (princ "\n")) - (dolist (feature (char-feature-property '$object 'additional-features)) - (mount-char-attribute-table - (char-feature-name-at-domain feature '$rev=latest))) + (when (eq genre 'character) + (dolist (feature (char-feature-property '$object 'additional-features)) + (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") - uri-char)) - (when (setq parents (www-char-feature char '<-denotational)) +
\n" + rdf-uri-object + genre rdf-uri-object + (if (eq genre 'character) + (format " + + +\n%s" + genre rdf-uri-object + (if (and (or (char-feature object '->HNG@CN/manuscript) + (char-feature object '->HNG@CN/printed) + (char-feature object '->HNG@JP/manuscript) + (char-feature object '->HNG@JP/printed) + (char-feature object '->HNG@KR) + (char-feature object '->HNG@MISC)) + (setq ucs (char-ucs object)) + (setq ret (decode-char '=ucs ucs)) + (setq ret + (if (setq ucs (get-char-attribute + ret '=>ucs*)) + (decode-char '=ucs ucs) + ret))) + (format " + + +\n" + (www-uri-encode-object ret)) + "")) + ""))) + (when (setq parents (www-get-feature-value object '<-denotational)) + (if (characterp parents) + (setq parents (list parents))) (princ (format "

%s %s

\n
\n" (www-format-value-as-char-list parents) (www-format-feature-name '->denotational lang)))) - (when (setq parents (www-char-feature char '<-subsumptive)) + (when (setq parents (www-get-feature-value object '<-subsumptive)) + (if (characterp parents) + (setq parents (list parents))) (princ (format "

%s %s

\n
\n" (www-format-value-as-char-list parents) (www-format-feature-name '->subsumptive lang)))) - (setq GlyphWiki-id (char-GlyphWiki-id char)) - (princ (format "%s%s\n" - level - (www-format-encode-string (char-to-string char)) - (if GlyphWiki-id - (format - " \"%s\"" - GlyphWiki-id - GlyphWiki-id GlyphWiki-id) - "") - level)) + (when (eq genre 'character) + (setq GlyphWiki-id (char-GlyphWiki-id object))) + (cond + ((eq genre 'image-resource) + (princ + (if (setq ret (concord-object-get object '=location@iiif)) + (if (setq base-image + (car (concord-object-get object '<-image-segment))) + (format "\"%s\"" + (www-uri-encode-object base-image) + (concord-object-get object 'image-offset-x) + (concord-object-get object 'image-offset-y) + (concord-object-get object 'image-width) + (concord-object-get object 'image-height) + ret ret) + (if (and image-selection + (string-match "\\([0-9]+\\),\\([0-9]+\\),\\([0-9]+\\),\\([0-9]+\\)" image-selection)) + (progn + (setq x (string-to-int (match-string 1 image-selection)) + y (string-to-int (match-string 2 image-selection)) + w (string-to-int (match-string 3 image-selection)) + h (string-to-int (match-string 4 image-selection))) + (setq width (float + (concord-object-get object 'image-width))) + ;; (setq height (float + ;; (concord-object-get object 'image-height))) + (format "
+ + +" + ret + (/ x width) + (/ y width) + (/ w width) + (/ h width) + )) + (format "
+ + +" + ret))) + (setq ret (concord-object-get object '=location)) + (format "\"%s\"" + ret ret))) + ) + ((and (eq genre 'character) + (not GlyphWiki-id) + (setq ret (or (encode-char object '=chise-hdic-tsj) + (encode-char object '===chise-hdic-tsj))) + (setq ret (decode-char '===chise-hdic-tsj ret)) + (setq ret (get-char-attribute ret 'hdic-tsj-word-id))) + (princ + (format "%s" + ret + (www-format-encode-string + (est-format-object object 'readable)))) + ) + ((and (eq genre 'character) + (not GlyphWiki-id) + (setq ret (or (encode-char object '=chise-hdic-syp) + (encode-char object '===chise-hdic-syp))) + (setq ret (decode-char '===chise-hdic-syp ret)) + (setq ret (get-char-attribute ret '=hdic-syp-entry-id))) + (princ + (format "%s" + ret + (www-format-encode-string + (est-format-object object 'readable)))) + ) + ((or (and (eq genre 'glyph-image) + (setq image-cobj + (car (concord-object-get object '->image-resource)))) + (and (eq genre 'character) + ;; (setq ret (www-format-encode-string + ;; (est-format-object object 'readable))) + ;; (string-match + ;; "\"SW-JIGUGE\\([45]\\)-\\([0-9][0-9][0-9]\\)\\([0-9][0-9]\\)"image-resource))) + )) + (if (and (setq ret (concord-object-get image-cobj '=location@iiif)) + (setq base-image + (car (concord-object-get image-cobj '<-image-segment)))) + (princ + (format "\"%s\"" + (www-uri-encode-object base-image) + (concord-object-get image-cobj 'image-offset-x) + (concord-object-get image-cobj 'image-offset-y) + (concord-object-get image-cobj 'image-width) + (concord-object-get image-cobj 'image-height) + ret ret)) + (setq ret (concord-object-get image-cobj '=location)) + (princ (format "\"%s\"" + ret ret))) + ) + ((and (eq genre 'hng-card) + (setq ret (concord-object-get object '=hng-card)) + (setq ret (symbol-name ret)) + (string-match "\\([0-9]+\\)-\\([0-9]+\\)" ret)) + (setq ret + (format + "\"HNG-card:%s\"" + ret + (string-to-int (match-string 1 ret)) + (string-to-int (match-string 2 ret)))) + (princ + (if (setq image-cobj + (car (concord-object-get object '->image-resource))) + (format "%s" + (www-uri-encode-object image-cobj) + ret) + ret)) + ) + (t + (setq ret (www-format-encode-string + (est-format-object object 'readable))) + (when (string-match + "\"HNG\\([0-9]+\\)-\\([0-9]+\\)[a-z]?\""%s%s\n" + level + (cond + (uri-feature-name + (format "%s" + ;; (if est-hide-cgi-mode + ;; "%s" + ;; "%s") + (www-uri-make-object-url object uri-object) + ret) + ) + (HNG-card + (format + "%s" + HNG-card ret) + ) + (t ret)) + (if GlyphWiki-id + (format + " \"%s\"" + GlyphWiki-id + GlyphWiki-id + chise-wiki-glyphwiki-glyph-image-url + GlyphWiki-id) + "") + level)) + )) (if (> level 1) (princ "
\n" + "
  • \n")) + )) )) (princ (if (= level 1) "

    \n" "

  • \n")) + (when feature-name-to-edit + (princ "\n")) (unless simple (princ - (format " " chise-wiki-add-url - (www-format-encode-string uri-char)))) + genre + (www-format-encode-string uri-object)))) (princ (if (= level 1) "

    \n" "

  • \n")) - (princ - "
    \n") - (princ - (www-format-encode-string - (format "%c" char))) - (princ - (format - " \n") + (princ (www-format-encode-string object-str)) + (setq encoded-object-for-form + (with-temp-buffer + (insert (encode-coding-string object-str 'utf-8-jp-er)) + (goto-char (point-min)) + (while (search-forward ">-" nil t) + (replace-match "&GT-" t t) + ) + (buffer-string))) + (princ + (format + " " - (encode-coding-string (char-to-string char) 'utf-8-jp-er))) - ;; (princ (www-format-encode-string "と")) - ;; (princ "") - (princ - (www-format-encode-string - "を\u542Bむ\u6F22\u5B57を\u63A2す")) - (princ " \n") - (princ "
    \n") + encoded-object-for-form)) + (princ + (www-format-encode-string + "を\u542Bむ\u6F22\u5B57を\u63A2す")) + (princ " \n") + (princ "\n") + + (princ + "
    \n") + (princ (www-format-encode-string object-str)) + + (princ + (format + " " + encoded-object-for-form)) + (princ + (www-format-encode-string + "を\u542Bむ HNG の\u6F22\u5B57を\u63A2す")) + (princ " \n") + (princ "
    \n") + )) (princ (if (= level 1) "

    \n" "
  • \n")) ))) -(defun www-display-feature-desc (uri-feature-name uri-char +(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 (and uri-object + (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 (format " -CHISE-wiki feature: %s +EsT feature: %s \n" feature-name) 'utf-8-mcs-er)) (princ "\n") (princ - (format - (if simple - "
    - + (if simple + (format + (if est-hide-cgi-mode + "
    +
    \n" - "
    - - + "
    + + +
    \n") - uri-feature-name uri-char)) + uri-feature-name genre rdf-uri-object) + (format + "
    + + + +
    +
    \n" + uri-feature-name genre uri-object))) (princ (format "

    %s

    \n" (www-format-encode-string @@ -180,10 +664,11 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />") (unless simple (princ (format - " " + " " chise-wiki-edit-url uri-feature-name - uri-char)) + genre + uri-object)) (princ "\n")) (princ "

    \n") (when lang @@ -196,11 +681,12 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />") (unless simple (princ (format - " " + " " chise-wiki-edit-url uri-feature-name name@lang - uri-char)) + genre + uri-object)) (princ "\n")) (princ "

    \n")) (www-html-display-paragraph @@ -214,39 +700,64 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />") (or (www-feature-value-format feature-name) 'default) 'default - 'without-tags))) + 'without-tags) + )) + (unless simple + (princ + (format + " " + chise-wiki-edit-url + uri-feature-name + genre + uri-object)) + (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 - uri-char)) + genre + uri-object)) (princ "\n")) (princ "

    \n") (princ "

    format : ") (www-html-display-text - (www-xml-format-list - (www-feature-format feature-name) - ;; (or (char-feature-property feature-name 'format) - ;; '((name) " : " (value))) - )) + (decode-coding-string + (www-xml-format-list + (www-feature-format feature-name)) + 'utf-8-mcs-er)) (unless simple (princ (format - " " chise-wiki-edit-url uri-feature-name - uri-char)) + genre + uri-object)) (princ "\n")) (princ "

    \n") (www-html-display-paragraph (format "description : %s" - (or (char-feature-property feature-name 'description) + (or (decode-coding-string + (or (char-feature-property feature-name 'description) + "") + 'utf-8-mcs-er) ""))) (when lang (www-html-display-paragraph @@ -272,7 +783,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />") (car (split-string accept-language ",")) ";")) "-")))) - ret) + ret genre) (princ "Content-Type: text/html; charset=UTF-8 ") (setq ret (match-end 0)) (setq target (concat "char=" - (www-uri-encode-char - (www-uri-decode-char (match-string 1 target))) + (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) - (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-char-desc - (cdr ret) + (www-display-object-desc + 'character (cdr ret) (cdr (assq 'feature target)) + nil lang nil (eq mode 'simple)) ) ((eq (car ret) 'feature) (www-display-feature-desc (decode-uri-string (cdr ret) 'utf-8-mcs-er) - (cdr (assq 'char target)) + (car (nth 1 target)) + (cdr (nth 1 target)) lang (eq mode 'simple)) + ) + (t + (www-display-object-desc + (car ret) (cdr ret) (cdr (assq 'feature target)) + nil + lang nil + (eq mode 'simple)) )) )) (princ "\n
    \n") @@ -319,7 +841,7 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />") (princ (format "user=%s\n" user)) ;; (princ (format "local user=%s\n" (user-login-name))) (princ (format "lang=%S\n" lang)) - (princ (emacs-version)) + (princ (encode-coding-string (emacs-version) 'utf-8-jp-er)) ;; (princ " CHISE ") ;; (princ xemacs-chise-version) (princ " @@ -330,4 +852,184 @@ size=\;; "30\" maxlength=\"30\" value=\"\" />") (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 obj-url json turtle obj) + (cond + ((stringp target) + (cond + ((string-match "/data\\.json$" target) + (setq json t + target (substring target 0 (match-beginning 0))) + ) + ((string-match "/index\\.ttl$" target) + (setq turtle t + target (substring target 0 (match-beginning 0))) + ) + ((string-match "/index\\.\\(...*\\)\\.html$" target) + (setq lang (intern (match-string 1 target)) + 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)) + (cond + ((string-match "/feature=" ret) + (list (substring ret 0 (match-beginning 0)) + (substring ret (match-end 0))) + ) + ((string-match "...$.zoom-xywh=" ret) + (list (substring ret 0 (match-beginning 0)) + nil + (substring ret (match-end 0))) + ) + (t + (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)) + (cond (turtle + (princ "Content-Type: text/turtle; charset=UTF-8 + +") + ) + (json + (princ "Content-Type: application/json; charset=UTF-8 + +") + ) + (t + (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 (turtle + (with-temp-buffer + (setq obj (www-uri-decode-object (car ret)(nth 1 ret))) + (concord-turtle-insert-char-data obj) + (goto-char (point-min)) + (concord-turtle-insert-prefix) + (insert "\n") + (encode-coding-region + (point-min)(point-max) + char-db-file-coding-system) + (princ (buffer-string))) + ) + ((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 'printable) + (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) + nil + 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)) + ) + ;; ((eq (car ret) 'image-resource) + ;; ;; (cond + ;; ;; ((string-match "^\\.iiif=" (nth 1 ret)) + ;; ;; (setq obj-url (decode-uri-string + ;; ;; (substring (nth 1 ret) (match-end 0)) + ;; ;; 'utf-8-mcs-er)) + ;; ;; (setq obj (concord-images-add-iiif obj-url)) + ;; ;; (www-display-object-desc + ;; ;; 'image-resource + ;; ;; (www-uri-encode-object obj) + ;; ;; (nth 2 ret) + ;; ;; lang nil + ;; ;; (eq mode 'simple)) + ;; ;; ) + ;; ;; (t + ;; (princ (nth 1 ret)) + ;; (www-display-object-desc + ;; 'image-resource (nth 1 ret) (nth 2 ret) + ;; lang nil + ;; (eq mode 'simple)) + ;; ;; )) + ;; ) + (t + (www-display-object-desc + (car ret) (nth 1 ret) (nth 2 ret) + (nth 3 ret) + lang nil + (eq mode 'simple)) + )) + )) + (unless (or json turtle) + (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)