X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=blobdiff_plain;f=cwiki-view.el;h=33c6957db69343ad1f4d08bae4045160e3d910fd;hp=3ce51b53887dbea8374425ac739e030178c9bbe9;hb=HEAD;hpb=94afae05add89b808ec4054afd69409c5fc7c3f6 diff --git a/cwiki-view.el b/cwiki-view.el index 3ce51b5..bf0dd07 100644 --- a/cwiki-view.el +++ b/cwiki-view.el @@ -1,6 +1,7 @@ ;; -*- coding: utf-8-mcs-er -*- (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") @@ -68,7 +69,10 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> without-header logical-feature chise-wiki-displayed-features parents - GlyphWiki-id HNG-card ret object-spec) + 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) @@ -95,6 +99,7 @@ size=\"64\" maxlength=\"256\" value=\"%s\"> (format " + src=\"https://image.chise.org/openseadragon/openseadragon.min.js\"> EsT %s = %s \n" @@ -173,24 +180,49 @@ li { margin: 0 0 0 2em; } (substring uri-object (match-end 0)))))))) (princ (format " + - + %s
\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" - genre rdf-uri-object) + (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-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)))) @@ -200,16 +232,62 @@ li { margin: 0 0 0 2em; } ((eq genre 'image-resource) (princ (if (setq ret (concord-object-get object '=location@iiif)) - (if (concord-object-get object 'image-offset-x) - (format "\"%s\"" + (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) - (format "
+ + +" + ret + (/ x width) + (/ y width) + (/ w width) + (/ h width) + )) + (format "
" - ret)) + 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)) - (princ - (format - "\"HNG-card:%s\"" - ret - (string-to-int (match-string 1 ret)) - (string-to-int (match-string 2 ret)))) + 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))) - (setq HNG-card - (if (string-match - "\"HNG\\([0-9]+\\)-\\([0-9]+\\)\""%s%s\n" level @@ -260,15 +427,17 @@ style=\"height: 480px;\" />" ) (HNG-card (format - "%s" + "%s" HNG-card ret) ) (t ret)) (if GlyphWiki-id (format - " \"%s\"" + " \"%s\"" GlyphWiki-id - GlyphWiki-id GlyphWiki-id) + GlyphWiki-id + chise-wiki-glyphwiki-glyph-image-url + GlyphWiki-id) "") level)) )) @@ -284,6 +453,24 @@ size=\"30\" maxlength=\"30\" value=\"%s\">)

genre genre (decode-uri-string uri-object 'utf-8-mcs-er)) 'utf-8-mcs-er))) + (when (and HNG-card-id + (eq genre 'character) + (setq HNG-card-cobj + (concord-decode-object + '=id HNG-card-id + 'hng-card))) + (put-char-attribute object 'sources@HNG/card (list HNG-card-cobj)) + (cond ((setq ret (concord-object-get + HNG-card-cobj + '->glyph-image@zinbun/takuhon)) + (put-char-attribute object 'sources@zinbun/takuhon ret) + ) + ((setq ret (concord-object-get + HNG-card-cobj + '->glyph-image@gallica)) + (put-char-attribute object 'sources@gallica ret) + )) + ) (setq object-spec (cond (uri-feature-name @@ -374,56 +561,45 @@ size=\"30\" maxlength=\"30\" value=\"%s\">)

"

\n" "

  • \n")) (when (eq genre 'character) - (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 - " \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 - (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む\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 - (est-format-object object) - ;; (if (eq genre 'character) - ;; (format "%c" object) - ;; (format "%s" (concord-object-id object))) - )) - (princ - (format - " \n") + (princ (www-format-encode-string object-str)) + + (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") - ) + encoded-object-for-form)) + (princ + (www-format-encode-string + "を\u542Bむ HNG の\u6F22\u5B57を\u63A2す")) + (princ " \n") + (princ "\n") + )) (princ (if (= level 1) "

    \n" @@ -433,14 +609,15 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (defun www-display-feature-desc (uri-feature-name genre uri-object &optional lang simple) (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))) + (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 @@ -578,7 +755,8 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (www-html-display-paragraph (format "description : %s" (or (decode-coding-string - (char-feature-property feature-name 'description) + (or (char-feature-property feature-name 'description) + "") 'utf-8-mcs-er) ""))) (when lang @@ -690,12 +868,22 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (car (split-string accept-language ",")) ";")) "-")))) - ret genre feature obj-url json obj) + ret genre feature obj-url json turtle obj) (cond ((stringp target) - (when (string-match "/data\\.json$" target) + (cond + ((string-match "/data\\.json$" target) (setq json t - target (substring target 0 (match-beginning 0)))) + 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 @@ -713,10 +901,18 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" 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)))) + (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 @@ -725,21 +921,40 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" ) (split-string target "&"))) (setq ret (car target)) - (if json - (princ "Content-Type: application/json; charset=UTF-8 + (cond (turtle + (princ "Content-Type: text/turtle; charset=UTF-8 + +") + ) + (json + (princ "Content-Type: application/json; charset=UTF-8 ") - (princ "Content-Type: text/html; 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 ((or (eq (car ret) 'char) + (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 @@ -794,12 +1009,12 @@ size=\"30\" maxlength=\"30\" value=\"%s\" />" (t (www-display-object-desc (car ret) (nth 1 ret) (nth 2 ret) - nil + (nth 3 ret) lang nil (eq mode 'simple)) )) )) - (unless json + (unless (or json turtle) (princ "\n
    \n") (princ (format "mode=%S\n" mode)) (princ (format "user=%s\n" user))