cwiki-view.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'cwiki-format)
   3 (require 'char-db-json)
   4 (require 'concord-turtle-dump)
   5
   6 (defvar chise-wiki-view-url "view.cgi")
   7 (defvar chise-wiki-edit-url "edit.cgi")
   8 (defvar chise-wiki-add-url "add.cgi")
   9
  10 (defun www-edit-display-feature-input-box (char feature-name
  11                                                 &optional format value)
  12   (if (symbolp char)
  13       (setq char (or (concord-decode-object '=id char 'feature)
  14                      (concord-make-object 'feature char))))
  15   (unless format
  16     (setq format 'default))
  17   (unless value
  18     (setq value (www-get-feature-value char feature-name)))
  19   (if (and (symbolp value)
  20            (eq format 'wiki-text))
  21       (setq value (list (list value))))
  22   (princ
  23    (format "<p><input type=\"text\" name=\"feature-name\"
  24 size=\"32\" maxlength=\"256\" value=\"%s\">"
  25            feature-name))
  26   (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
  27   (princ
  28    (format "%s<input type=\"text\" name=\"%s\"
  29 size=\"64\" maxlength=\"256\" value=\"%s\">
  30 <input type=\"submit\" value=\"set\" /></p>
  31 "
  32            (if (or (eq format 'HEX)(eq format 'hex))
  33                "0x"
  34              "")
  35            format
  36            (mapconcat (lambda (c)
  37                         (cond
  38                          ;; ((eq c ?<) "&amp;lt;")
  39                          ;; ((eq c ?>) "&amp;gt;")
  40                          ((eq c ?\u0022) "&quot;")
  41                          (t
  42                           (char-to-string c))))
  43                       (est-format-list value format nil nil " ")
  44                       "")))
  45   )
  46
  47 (defun www-display-object-desc (genre uri-object &optional uri-feature-name
  48                                       image-selection
  49                                       lang level simple
  50                                       uri-feature-name-to-edit editing-format)
  51   (unless level
  52     (setq level 0))
  53   (let ((object (www-uri-decode-object genre uri-object))
  54         (est-eval-list-feature-items-limit est-eval-list-feature-items-limit)
  55         (est-view-url-prefix (if uri-feature-name
  56                                  "../.."
  57                                ".."))
  58         (rdf-uri-object (if est-hide-cgi-mode
  59                             (if (string-match "=" uri-object)
  60                                 (concat
  61                                  (est-uri-decode-feature-name-body
  62                                   (substring uri-object 0 (match-beginning 0)))
  63                                  ":"
  64                                  (est-uri-decode-feature-name-body
  65                                   (substring uri-object (match-end 0))))
  66                               uri-object)))
  67         feature-name-to-display feature-name-to-edit
  68         base-name-to-edit metadata-name-to-edit
  69         without-header
  70         logical-feature chise-wiki-displayed-features
  71         parents
  72         GlyphWiki-id HNG-card HNG-card-id HNG-card-cobj ret object-spec
  73         ucs
  74         item-code page char-num glyph-image-id
  75         width height image-cobj base-image x y w h)
  76     (if (eq level 0)
  77         (setq level 1
  78               without-header nil)
  79       (setq without-header t))
  80     (when object
  81       (when uri-feature-name-to-edit
  82         (setq feature-name-to-edit
  83               (www-uri-decode-feature-name uri-feature-name-to-edit))
  84         (setq ret (symbol-name feature-name-to-edit))
  85         (if (string-match "\\*" ret)
  86             (setq base-name-to-edit (intern
  87                                      (substring ret 0 (match-beginning 0)))
  88                   metadata-name-to-edit (intern
  89                                          (substring ret (match-end 0))))
  90           (setq base-name-to-edit feature-name-to-edit))
  91         (when (stringp editing-format)
  92           (setq editing-format (intern editing-format))))
  93       (when (and (eq genre 'character)
  94                  (= (length uri-object) 1))
  95         (setq uri-object (www-uri-encode-object object)))
  96       (when (= level 1)
  97         (princ
  98          (encode-coding-string
  99           (format "<head>
 100 <style type=\"text/css\">
 101 <!--
 102 hr { color: green; }
 103 .ids { vertical-align: middle; font-size: 40px; line-height: 100%%; }
 104 a { text-decoration: none; }
 105 .ids a { color: black; }
 106 ul { margin: 0 0; color: black; }
 107 li { margin: 0 0 0 2em; }
 108 .feature-name { font-family: sans-serif; font-weight: bold; }
 109 .feature-name a { color: black; }
 110
 111 .tooltip {
 112     position: relative;
 113     display: inline-block;
 114     border-bottom: 1px dotted black;
 115 }
 116
 117 .tooltip .tooltiptext {
 118     visibility: hidden;
 119     width: 120px;
 120     top: 100%%;
 121     left: 50%%;
 122     margin-left: -60px;
 123     background-color: black;
 124     color: #fff;
 125     text-align: center;
 126     padding: 5px 0;
 127     border-radius: 6px;
 128
 129     position: absolute;
 130     z-index: 1;
 131 }
 132
 133 .value .image-list img { height: 320px; vertical-align: top; }
 134
 135 .list .tooltip:hover .tooltiptext {
 136     visibility: visible;
 137 }
 138 -->
 139 </style>
 140
 141 <script
 142  src=\"http://hng.chise.org/openseadragon/openseadragon.min.js\"></script>
 143
 144 <title>EsT %s = %s</title>
 145 </head>\n"
 146                   genre
 147                   (decode-uri-string uri-object 'utf-8-mcs-er))
 148           'utf-8-mcs-er))
 149         (princ "<body>\n"))
 150       (when (eq genre 'character)
 151         (dolist (feature (char-feature-property '$object 'additional-features))
 152           (mount-char-attribute-table
 153            (char-feature-name-at-domain feature '$rev=latest))))
 154       (princ
 155        (if simple
 156            (format
 157             (if est-hide-cgi-mode
 158                 "<div style=\"text-align:right;\">
 159 <a href=\"../../edit/view.cgi?%s=%s\">
 160 <input type=\"submit\" value=\"Edit\" />
 161 </a>\n"
 162               "<div style=\"text-align:right;\">
 163 <a href=\"edit/view.cgi?%s=%s\">
 164 <input type=\"submit\" value=\"Edit\" />
 165 </a>\n")
 166             genre rdf-uri-object)
 167          (format
 168           "<div style=\"text-align:right;\">
 169 <a href=\"../view/%s/%s\">
 170 <input type=\"submit\" value=\"Simple\" />
 171 </a>\n"
 172           genre
 173           (if (string-match ":" uri-object)
 174               (concat
 175                (est-uri-encode-feature-name-body
 176                 (substring uri-object 0 (match-beginning 0)))
 177                "="
 178                (est-uri-encode-feature-name-body
 179                 (substring uri-object (match-end 0))))))))
 180       (princ
 181        (format "<input type=\"submit\" value=\"New Account\" />
 182 <a href=\"./%s/index.ttl\"><input type=\"submit\" value=\"RDF (Turtle)\" /></a>
 183 <a href=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
 184 <input type=\"submit\" value=\"XML (old RDF)\" />
 185 </a>%s
 186 </div>
 187 <hr />\n"
 188                rdf-uri-object
 189                genre rdf-uri-object
 190                (if (eq genre 'character)
 191                    (format "
 192 <a href=\"/est/view/%s/%s/data.json\">
 193 <input type=\"submit\" value=\"JSON\" />
 194 </a>\n%s"
 195                            genre rdf-uri-object
 196                            (if (and (or (char-feature object '->HNG@CN/manuscript)
 197                                         (char-feature object '->HNG@CN/printed)
 198                                         (char-feature object '->HNG@JP/manuscript)
 199                                         (char-feature object '->HNG@JP/printed)
 200                                         (char-feature object '->HNG@KR)
 201                                         (char-feature object '->HNG@MISC))
 202                                     (setq ucs (char-ucs object))
 203                                     (setq ret (decode-char '=ucs ucs))
 204                                     (setq ret
 205                                           (if (setq ucs (get-char-attribute
 206                                                          ret '=>ucs*))
 207                                               (decode-char '=ucs ucs)
 208                                             ret)))
 209                                (format "
 210 <a href=\"https://search.hng-data.org/search/%s\">
 211 <input type=\"submit\" value=\"HNG-data\" />
 212 </a>\n"
 213                                        (www-uri-encode-object ret))
 214                              ""))
 215                  "")))
 216       (when (setq parents (www-get-feature-value object '<-denotational))
 217         (if (characterp parents)
 218             (setq parents (list parents)))
 219         (princ (format "<p>%s %s</p>\n<hr>\n"
 220                        (www-format-value-as-char-list parents)
 221                        (www-format-feature-name '->denotational lang))))
 222       (when (setq parents (www-get-feature-value object '<-subsumptive))
 223         (if (characterp parents)
 224             (setq parents (list parents)))
 225         (princ (format "<p>%s %s</p>\n<hr>\n"
 226                        (www-format-value-as-char-list parents)
 227                        (www-format-feature-name '->subsumptive lang))))
 228       (when (eq genre 'character)
 229         (setq GlyphWiki-id (char-GlyphWiki-id object)))
 230       (cond
 231        ((eq genre 'image-resource)
 232         (princ
 233          (if (setq ret (concord-object-get object '=location@iiif))
 234              (if (setq base-image
 235                        (car (concord-object-get object '<-image-segment)))
 236                  (format "<a href=\"%s...$.zoom-xywh=%d,%d,%d,%d\"
 237 ><img alt=\"%s\" src=\"%s\" /></a>"
 238                          (www-uri-encode-object base-image)
 239                          (concord-object-get object 'image-offset-x)
 240                          (concord-object-get object 'image-offset-y)
 241                          (concord-object-get object 'image-width)
 242                          (concord-object-get object 'image-height)
 243                          ret ret)
 244                (if (and image-selection
 245                         (string-match "\\([0-9]+\\),\\([0-9]+\\),\\([0-9]+\\),\\([0-9]+\\)" image-selection))
 246                    (progn
 247                      (setq x (string-to-int (match-string 1 image-selection))
 248                            y (string-to-int (match-string 2 image-selection))
 249                            w (string-to-int (match-string 3 image-selection))
 250                            h (string-to-int (match-string 4 image-selection)))
 251                      (setq width (float
 252                                   (concord-object-get object 'image-width)))
 253                      ;; (setq height (float
 254                      ;;               (concord-object-get object 'image-height)))
 255                      (format "<div id=\"openseadragon1\"
 256  style=\"width: 800px; height: 600px;\"></div>
 257
 258 <script type=\"text/javascript\">
 259     var viewer;
 260     viewer = OpenSeadragon({
 261         id: \"openseadragon1\",
 262         prefixUrl: \"http://hng.chise.org/openseadragon/images/\",
 263         preserveViewport:   true,
 264         visibilityRatio:    1,
 265         minZoomLevel:       1,
 266         defaultZoomLevel:   1,
 267         sequenceMode:       true,
 268         tileSources:   [ \"%s/info.json\" ]
 269     });
 270     viewer.addHandler('open', function () {
 271       var newBounds = new OpenSeadragon.Rect( %f, %f, %f, %f, 0 );
 272       viewer.viewport.fitBounds(newBounds, true);
 273       viewer.viewport.applyConstraints();
 274     });
 275 </script>
 276 "
 277                            ret
 278                            (/ x width)
 279                            (/ y width)
 280                            (/ w width)
 281                            (/ h width)
 282                            ))
 283                  (format "<div id=\"openseadragon1\"
 284  style=\"width: 800px; height: 600px;\"></div>
 285
 286 <script type=\"text/javascript\">
 287     OpenSeadragon({
 288         id: \"openseadragon1\",
 289         prefixUrl: \"http://hng.chise.org/openseadragon/images/\",
 290         preserveViewport:   true,
 291         visibilityRatio:    1,
 292         minZoomLevel:       1,
 293         defaultZoomLevel:   1,
 294         sequenceMode:       true,
 295         tileSources:   [ \"%s/info.json\" ]
 296     });
 297 </script>
 298 "
 299                          ret)))
 300            (setq ret (concord-object-get object '=location))
 301            (format "<img alt=\"%s\" src=\"%s\" />"
 302                    ret ret)))
 303         )
 304        ((or (and (eq genre 'glyph-image)
 305                  (setq image-cobj
 306                        (car (concord-object-get object '->image-resource))))
 307             (and (eq genre 'character)
 308                  (setq ret (www-format-encode-string
 309                             (est-format-object object 'readable)))
 310                  (string-match
 311                   "<img alt=\"SW-JIGUGE\\([45]\\)-\\([0-9][0-9][0-9]\\)\\([0-9][0-9]\\)"
 312                   ret)
 313                  (setq item-code (string-to-int (match-string 1 ret))
 314                        page (string-to-int (match-string 2 ret))
 315                        char-num (string-to-int (match-string 3 ret)))
 316                  (setq glyph-image-id
 317                        (cond ((eq item-code 4)
 318                               (intern
 319                                (format "zinbun/toho/A024/A024%04d/char=%d"
 320                                        (+ page 18) char-num))
 321                               )
 322                              ((eq item-code 5)
 323                               (intern
 324                                (format "zinbun/toho/A020/A020%04d/char=%d"
 325                                        (+ page 16) char-num))
 326                               )))
 327                  (setq image-cobj
 328                        (concord-decode-object '=id glyph-image-id 'glyph-image))
 329                  (setq image-cobj
 330                        (car (concord-object-get image-cobj '->image-resource)))
 331                  ))
 332         (if (and (setq ret (concord-object-get image-cobj '=location@iiif))
 333                  (setq base-image
 334                        (car (concord-object-get image-cobj '<-image-segment))))
 335             (princ
 336              (format "<a href=\"../image-resource/%s...$.zoom-xywh=%d,%d,%d,%d\"
 337 ><img alt=\"%s\" src=\"%s\" /></a>"
 338                      (www-uri-encode-object base-image)
 339                      (concord-object-get image-cobj 'image-offset-x)
 340                      (concord-object-get image-cobj 'image-offset-y)
 341                      (concord-object-get image-cobj 'image-width)
 342                      (concord-object-get image-cobj 'image-height)
 343                      ret ret))
 344           (setq ret (concord-object-get image-cobj '=location))
 345           (princ (format "<img alt=\"%s\" src=\"%s\" />"
 346                          ret ret)))
 347         )
 348        ((and (eq genre 'hng-card)
 349              (setq ret (concord-object-get object '=hng-card))
 350              (setq ret (symbol-name ret))
 351              (string-match "\\([0-9]+\\)-\\([0-9]+\\)" ret))
 352         (setq ret
 353               (format
 354                "<img alt=\"HNG-card:%s\"
 355 src=\"http://hng.chise.org/images/HNG/%03d/card/%04d.jpg\"
 356 style=\"height: 480px;\" />"
 357                ret
 358                (string-to-int (match-string 1 ret))
 359                (string-to-int (match-string 2 ret))))
 360         (princ
 361          (if (setq image-cobj
 362                    (car (concord-object-get object '->image-resource)))
 363              (format "<a href=\"../image-resource/%s\">%s</a>"
 364                      (www-uri-encode-object image-cobj)
 365                      ret)
 366            ret))
 367         )
 368        (t
 369         (setq ret (www-format-encode-string
 370                    (est-format-object object 'readable)))
 371         (when (string-match
 372                "<img alt=\"HNG\\([0-9]+\\)-\\([0-9]+\\)[a-z]?\"" ret)
 373           (setq HNG-card-id
 374                 (intern
 375                  (format "%d-%d"
 376                          (string-to-int (match-string 1 ret))
 377                          (string-to-int (match-string 2 ret)))))
 378           (setq HNG-card
 379                 (format "hng-card/rep.id=%s" HNG-card-id)))
 380         (princ
 381          (format "<h%d>%s%s</h%d>\n"
 382                  level
 383                  (cond
 384                   (uri-feature-name
 385                    (format "<a href=\"%s\">%s</a>"
 386                            ;; (if est-hide-cgi-mode
 387                            ;;     "<a href=\"../%s\">%s</a>"
 388                            ;;   "<a href=\"%s\">%s</a>")
 389                            (www-uri-make-object-url object uri-object)
 390                            ret)
 391                    )
 392                   (HNG-card
 393                    (format
 394                     "<a href=\"../%s\">%s</a>"
 395                     HNG-card ret)
 396                    )
 397                   (t ret))
 398                  (if GlyphWiki-id
 399                      (format
 400                       " <a href=\"http://glyphwiki.org/wiki/%s\"><img alt=\"%s\" src=\"http://glyphwiki.org/glyph/%s.50px.png\" /></a>"
 401                       GlyphWiki-id
 402                       GlyphWiki-id GlyphWiki-id)
 403                    "")
 404                  level))
 405         ))
 406       (if (> level 1)
 407           (princ "<ul>"))
 408       (when feature-name-to-edit
 409         (princ "<form action=\"set.cgi\" method=\"GET\">\n")
 410         (princ
 411          (encode-coding-string
 412           (format "<p>(%s : <input type=\"text\" name=\"%s\"
 413 size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
 414 "
 415                   genre genre
 416                   (decode-uri-string uri-object 'utf-8-mcs-er))
 417           'utf-8-mcs-er)))
 418       (when (and HNG-card-id
 419                  (eq genre 'character)
 420                  (setq HNG-card-cobj
 421                        (concord-decode-object
 422                         '=id HNG-card-id
 423                         'hng-card)))
 424         (put-char-attribute object 'sources@HNG/card (list HNG-card-cobj))
 425         (if (setq ret (concord-object-get
 426                        HNG-card-cobj
 427                        '->glyph-image@zinbun/takuhon))
 428             (put-char-attribute object 'sources@zinbun/takuhon ret))
 429         )
 430       (setq object-spec
 431             (cond
 432              (uri-feature-name
 433               (setq feature-name-to-display
 434                     (www-uri-decode-feature-name uri-feature-name))
 435               (setq est-eval-list-feature-items-limit nil)
 436               (list
 437                (cons feature-name-to-display
 438                      (if (eq genre 'character)
 439                          (get-char-attribute object feature-name-to-display)
 440                        (concord-object-get object feature-name-to-display)))))
 441              (t
 442               (if (eq genre 'character)
 443                   (char-attribute-alist object)
 444                 (concord-object-spec object)))))
 445       (when feature-name-to-edit
 446         (unless (assq base-name-to-edit object-spec)
 447           (setq object-spec (cons (cons base-name-to-edit nil)
 448                                   object-spec))))
 449       (dolist (cell (sort object-spec
 450                           (lambda (a b)
 451                             (char-attribute-name<
 452                              (char-feature-name-sans-versions (car a))
 453                              (char-feature-name-sans-versions (car b))))))
 454         (setq logical-feature (char-feature-name-sans-versions (car cell)))
 455         (unless (memq logical-feature chise-wiki-displayed-features)
 456           (push logical-feature chise-wiki-displayed-features)
 457           (cond
 458            ((and feature-name-to-edit
 459                  (eq (car cell) feature-name-to-edit))
 460             (www-edit-display-feature-input-box
 461              object feature-name-to-edit editing-format)
 462             )
 463            (t
 464             (princ
 465              (if (= level 1)
 466                  "<div class=\"feature\" style=\"line-height:150%\">\n"
 467                "<li>\n"))
 468             (princ
 469              (www-format-eval-list
 470               (www-feature-format logical-feature)
 471               object
 472               logical-feature ; (car cell)
 473               lang uri-object
 474               nil simple))
 475             (unless simple
 476               (princ
 477                (format " <a href=\"%s?%s=%s&feature=%s&format=wiki-text\"
 478 ><input type=\"submit\" value=\"note\" /></a>"
 479                        chise-wiki-edit-url
 480                        genre
 481                        (www-format-encode-string uri-object)
 482                        (www-format-encode-string
 483                         (www-uri-encode-feature-name
 484                          (intern (format "%s*note"
 485                                          logical-feature ; (car cell)
 486                                          )))))))
 487             (when (and feature-name-to-edit
 488                        (eq base-name-to-edit (car cell)) metadata-name-to-edit)
 489               (princ "<ul>\n")
 490               (princ "<li>")
 491               (www-edit-display-feature-input-box
 492                object feature-name-to-edit editing-format)
 493               (princ "</li>")
 494               (princ "</ul>"))
 495             (princ
 496              (if (= level 1)
 497                  "</div>\n"
 498                "<li>\n"))
 499             ))
 500           ))
 501       (princ
 502        (if (= level 1)
 503            "<p>\n"
 504          "<li>\n"))
 505       (when feature-name-to-edit
 506         (princ "</form>\n"))
 507       (unless simple
 508         (princ
 509          (format "<a href=\"%s?%s=%s\"
 510 ><input type=\"submit\" value=\"add feature\" /></a>
 511 "
 512                  chise-wiki-add-url
 513                  genre
 514                  (www-format-encode-string uri-object))))
 515       (princ
 516        (if (= level 1)
 517            "<p>\n"
 518          "<li>\n"))
 519       (when (eq genre 'character)
 520         (let ((object-str (est-format-object object))
 521               encoded-object-for-form)
 522           (princ
 523            "<form action=\"http://www.chise.org/ids-find\">\n")
 524           (princ (www-format-encode-string object-str))
 525           (setq encoded-object-for-form
 526                 (with-temp-buffer
 527                   (insert (encode-coding-string object-str 'utf-8-jp-er))
 528                   (goto-char (point-min))
 529                   (while (search-forward "&GT-" nil t)
 530                     (replace-match "&amp;GT-" t t)
 531                     )
 532                   (buffer-string)))
 533           (princ
 534            (format
 535             " <input type=\"text\" name=\"components\"
 536 size=\"30\" maxlength=\"30\" value=\"%s\" />"
 537             encoded-object-for-form))
 538           (princ
 539            (www-format-encode-string
 540             "を\u542Bむ\u6F22\u5B57を\u63A2す"))
 541           (princ " <input type=\"submit\" value=\"search\" />\n")
 542           (princ "</form>\n")
 543
 544           (princ
 545            "<form action=\"http://www.chise.org/hng-ids-find\">\n")
 546           (princ (www-format-encode-string object-str))
 547
 548           (princ
 549            (format
 550             " <input type=\"text\" name=\"components\"
 551 size=\"30\" maxlength=\"30\" value=\"%s\" />"
 552             encoded-object-for-form))
 553           (princ
 554            (www-format-encode-string
 555             "を\u542Bむ HNG の\u6F22\u5B57を\u63A2す"))
 556           (princ " <input type=\"submit\" value=\"search\" />\n")
 557           (princ "</form>\n")
 558         ))
 559       (princ
 560        (if (= level 1)
 561            "</p>\n"
 562          "<li>\n"))
 563       )))
 564
 565 (defun www-display-feature-desc (uri-feature-name genre uri-object
 566                                                   &optional lang simple)
 567   (let ((rdf-uri-object (if est-hide-cgi-mode
 568                             (if (and uri-object
 569                                      (string-match "=" uri-object)
 570                                      (concat
 571                                       (est-uri-decode-feature-name-body
 572                                        (substring uri-object 0 (match-beginning 0)))
 573                                       ":"
 574                                       (est-uri-decode-feature-name-body
 575                                        (substring uri-object (match-end 0)))))
 576                                 uri-object)))
 577         (feature-name (www-uri-decode-feature-name uri-feature-name))
 578         (name@lang (intern (format "name@%s" lang))))
 579     (princ
 580      (encode-coding-string
 581       (format "<head>
 582 <title>EsT feature: %s</title>
 583 </head>\n"
 584               feature-name)
 585       'utf-8-mcs-er))
 586     (princ "<body>\n")
 587     (princ
 588      (if simple
 589          (format
 590           (if est-hide-cgi-mode
 591               "<div style=\"text-align:right;\">
 592 <a href=\"../../../edit/view.cgi?feature=%s&%s=%s\">
 593 <input type=\"submit\" value=\"Edit\" />
 594 </a>
 595 <input type=\"submit\" value=\"New Account\" />
 596 </div>
 597 <hr />\n"
 598             "<div style=\"text-align:right;\">
 599 <a href=\"edit/view.cgi?feature=%s&%s=%s\">
 600 <input type=\"submit\" value=\"Edit\" />
 601 </a>
 602 <input type=\"submit\" value=\"New Account\" />
 603 </div>
 604 <hr />\n")
 605           uri-feature-name genre rdf-uri-object)
 606        (format
 607         "<div style=\"text-align:right;\">
 608 <a href=\"../view/feature/%s&%s/%s\">
 609 <input type=\"submit\" value=\"Simple\" />
 610 </a>
 611 </div>
 612 <hr />\n"
 613         uri-feature-name genre uri-object)))
 614     (princ
 615      (format "<h1>%s</h1>\n"
 616              (www-format-encode-string
 617               (symbol-name feature-name))))
 618     (princ (format "<p>name : %s "
 619                    (or (www-format-feature-name feature-name) "")))
 620     (unless simple
 621       (princ
 622        (format
 623         " <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
 624         chise-wiki-edit-url
 625         uri-feature-name
 626         genre
 627         uri-object))
 628       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 629     (princ "</p>\n")
 630     (when lang
 631       (princ "<p>")
 632       (princ
 633        (www-format-encode-string
 634         (format "%s : %s"
 635                 name@lang
 636                 (or (char-feature-property feature-name name@lang) ""))))
 637       (unless simple
 638         (princ
 639          (format
 640           " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
 641           chise-wiki-edit-url
 642           uri-feature-name
 643           name@lang
 644           genre
 645           uri-object))
 646         (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 647       (princ "</p>\n"))
 648     (www-html-display-paragraph
 649      (format "type : %s"
 650              (or (www-feature-type feature-name)
 651                  ;; (char-feature-property feature-name 'type)
 652                  'generic)))
 653     (princ (format "<p>value-format : %s "
 654                    (www-format-value
 655                     nil 'value-format
 656                     (or (www-feature-value-format feature-name)
 657                         'default)
 658                     'default
 659                     'without-tags)
 660                    ))
 661     (unless simple
 662       (princ
 663        (format
 664         " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
 665 >"
 666         chise-wiki-edit-url
 667         uri-feature-name
 668         genre
 669         uri-object))
 670       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 671     (princ "</p>\n")
 672
 673     (princ (format "<p>value-presentation-format : %s "
 674                    (www-format-value
 675                     nil 'value-presentation-format
 676                     (or (www-feature-value-format feature-name)
 677                         'default)
 678                     'default
 679                     'without-tags)
 680                    ))
 681     (unless simple
 682       (princ
 683        (format
 684         " <a href=\"%s?feature=%s&property=value-presentation-format&format=wiki-text&%s=%s\"
 685 >"
 686         chise-wiki-edit-url
 687         uri-feature-name
 688         genre
 689         uri-object))
 690       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 691     (princ "</p>\n")
 692
 693     (princ "<p>format : ")
 694     (www-html-display-text
 695      (decode-coding-string
 696       (www-xml-format-list
 697        (www-feature-format feature-name))
 698       'utf-8-mcs-er))
 699     (unless simple
 700       (princ
 701        (format
 702         " <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
 703 >"
 704         chise-wiki-edit-url
 705         uri-feature-name
 706         genre
 707         uri-object))
 708       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 709     (princ "</p>\n")
 710
 711     (www-html-display-paragraph
 712      (format "description : %s"
 713              (or (decode-coding-string
 714                   (or (char-feature-property feature-name 'description)
 715                       "")
 716                   'utf-8-mcs-er)
 717                  "")))
 718     (when lang
 719       (www-html-display-paragraph
 720        (format "description@%s : %s"
 721                lang
 722                (or (char-feature-property
 723                     feature-name
 724                     (intern (format "description@%s" lang)))
 725                    ""))))
 726     ))
 727
 728 (defun www-batch-view ()
 729   (setq terminal-coding-system 'binary)
 730   (condition-case err
 731       (let* ((target (pop command-line-args-left))
 732              (user (pop command-line-args-left))
 733              (accept-language (pop command-line-args-left))
 734              (mode (intern (pop command-line-args-left)))
 735              (lang
 736               (intern
 737                (car (split-string
 738                      (car (split-string
 739                            (car (split-string accept-language ","))
 740                            ";"))
 741                      "-"))))
 742              ret genre)
 743         (princ "Content-Type: text/html; charset=UTF-8
 744
 745 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 746             \"http://www.w3.org/TR/html4/loose.dtd\">
 747 <html lang=\"ja\">
 748 ")
 749         (cond
 750          ((stringp target)
 751           (when (string-match "^char=\\(&[^&;]+;\\)" target)
 752             (setq ret (match-end 0))
 753             (setq target
 754                   (concat "char="
 755                           (www-uri-encode-object
 756                            (www-uri-decode-object
 757                             'character (match-string 1 target)))
 758                           (substring target ret))))
 759           (setq target
 760                 (mapcar (lambda (cell)
 761                           (if (string-match "=" cell)
 762                               (progn
 763                                 (setq genre (substring cell 0 (match-beginning 0))
 764                                       ret (substring cell (match-end 0)))
 765                                 (cons
 766                                  (intern
 767                                   (decode-uri-string genre 'utf-8-mcs-er))
 768                                  ret))
 769                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 770                         (split-string target "&")))
 771           (setq ret (car target))
 772           (cond ((eq (car ret) 'char)
 773                  (www-display-object-desc
 774                   'character (cdr ret) (cdr (assq 'feature target))
 775                   nil
 776                   lang nil
 777                   (eq mode 'simple))
 778                  )
 779                 ((eq (car ret) 'feature)
 780                  (www-display-feature-desc
 781                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 782                   (car (nth 1 target))
 783                   (cdr (nth 1 target))
 784                   lang
 785                   (eq mode 'simple))
 786                  )
 787                 (t
 788                  (www-display-object-desc
 789                   (car ret) (cdr ret) (cdr (assq 'feature target))
 790                   nil
 791                   lang nil
 792                   (eq mode 'simple))
 793                  ))
 794           ))
 795         (princ "\n<hr>\n")
 796         (princ (format "mode=%S\n" mode))
 797         (princ (format "user=%s\n" user))
 798         ;; (princ (format "local user=%s\n" (user-login-name)))
 799         (princ (format "lang=%S\n" lang))
 800         (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
 801         ;; (princ " CHISE ")
 802         ;; (princ xemacs-chise-version)
 803         (princ "
 804 </body>
 805 </html>")
 806         )
 807     (error nil
 808            (princ (format "%S" err)))
 809     ))
 810
 811 (defun www-batch-view-smart ()
 812   (setq debug-on-error t)
 813   (setq terminal-coding-system 'binary)
 814   (condition-case err
 815       (let* ((est-hide-cgi-mode t)
 816              (target (pop command-line-args-left))
 817              (user (pop command-line-args-left))
 818              (accept-language (pop command-line-args-left))
 819              (mode (intern (pop command-line-args-left)))
 820              (lang
 821               (intern
 822                (car (split-string
 823                      (car (split-string
 824                            (car (split-string accept-language ","))
 825                            ";"))
 826                      "-"))))
 827              ret genre feature obj-url json turtle obj)
 828         (cond
 829          ((stringp target)
 830           (cond
 831            ((string-match "/data\\.json$" target)
 832             (setq json t
 833                   target (substring target 0 (match-beginning 0)))
 834             )
 835            ((string-match "/index\\.ttl$" target)
 836             (setq turtle t
 837                   target (substring target 0 (match-beginning 0)))
 838             ))
 839           (when (string-match "^char/\\(&[^&;]+;\\)" target)
 840             (setq ret (match-end 0))
 841             (setq target
 842                   (concat "char/"
 843                           (www-uri-encode-object
 844                            (www-uri-decode-object
 845                             'character (match-string 1 target)))
 846                           (substring target ret))))
 847           (setq target
 848                 (mapcar
 849                  (lambda (cell)
 850                    (if (string-match "/" cell)
 851                        (progn
 852                          (setq genre (substring cell 0 (match-beginning 0))
 853                                ret (substring cell (match-end 0)))
 854                          (cons
 855                           (intern (decode-uri-string genre 'utf-8-mcs-er))
 856                           (cond
 857                            ((string-match "/feature=" ret)
 858                             (list (substring ret 0 (match-beginning 0))
 859                                   (substring ret (match-end 0)))
 860                             )
 861                            ((string-match "...$.zoom-xywh=" ret)
 862                             (list (substring ret 0 (match-beginning 0))
 863                                   nil
 864                                   (substring ret (match-end 0)))
 865                             )
 866                            (t
 867                             (list ret)))))
 868                      (list (decode-uri-string cell 'utf-8-mcs-er)))
 869                    ;; (setq ret (split-string cell "/"))
 870                    ;; (cons (intern
 871                    ;;        (decode-uri-string (car ret) 'utf-8-mcs-er))
 872                    ;;       (cdr ret))
 873                    )
 874                  (split-string target "&")))
 875           (setq ret (car target))
 876           (cond (turtle
 877                  (princ "Content-Type: text/turtle; charset=UTF-8
 878
 879 ")
 880                  )
 881                 (json
 882                  (princ "Content-Type: application/json; charset=UTF-8
 883
 884 ")
 885                  )
 886                 (t
 887                  (princ "Content-Type: text/html; charset=UTF-8
 888
 889 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 890             \"http://www.w3.org/TR/html4/loose.dtd\">
 891 <html lang=\"ja\">
 892 ")
 893                  ))
 894           ;; (princ (format "<p>%S, %S, %S</p>"
 895           ;;                (car ret)(nth 1 ret)(nth 2 ret)))
 896           ;; (princ (format "// %S %S\n" ret json))
 897           (cond (turtle
 898                  (with-temp-buffer
 899                    (setq obj (www-uri-decode-object (car ret)(nth 1 ret)))
 900                    (concord-turtle-insert-char-data obj)
 901                    (goto-char (point-min))
 902                    (concord-turtle-insert-prefix)
 903                    (insert "\n")
 904                    (encode-coding-region
 905                     (point-min)(point-max)
 906                     char-db-file-coding-system)
 907                    (princ (buffer-string)))
 908                  )
 909                 ((or (eq (car ret) 'char)
 910                      (eq (car ret) 'character))
 911                  (if (and json
 912                           (setq obj (www-uri-decode-object
 913                                      (car ret)(nth 1 ret)))
 914                           (characterp obj))
 915                      (with-temp-buffer
 916                        ;; (princ (encode-coding-string
 917                        ;;         (format "// %S\n" obj)
 918                        ;;         char-db-file-coding-system))
 919                        (char-db-json-char-data-with-variant obj 'printable)
 920                        (encode-coding-region
 921                         (point-min)(point-max)
 922                         char-db-file-coding-system)
 923                        (princ (buffer-string))
 924                        )
 925                    (www-display-object-desc
 926                     'character (nth 1 ret) (nth 2 ret)
 927                     nil
 928                     lang nil
 929                     (eq mode 'simple)))
 930                  )
 931                 ((eq (car ret) 'feature)
 932                  (www-display-feature-desc
 933                   (decode-uri-string (nth 1 ret) 'utf-8-mcs-er)
 934                   (car (nth 1 target))
 935                   (nth 1 (nth 1 target))
 936                   lang
 937                   (eq mode 'simple))
 938                  )
 939                 ;; ((eq (car ret) 'image-resource)
 940                 ;; ;;  (cond
 941                 ;; ;;   ((string-match "^\\.iiif=" (nth 1 ret))
 942                 ;; ;;    (setq obj-url (decode-uri-string
 943                 ;; ;;                   (substring (nth 1 ret) (match-end 0))
 944                 ;; ;;                   'utf-8-mcs-er))
 945                 ;; ;;    (setq obj (concord-images-add-iiif obj-url))
 946                 ;; ;;    (www-display-object-desc
 947                 ;; ;;     'image-resource
 948                 ;; ;;     (www-uri-encode-object obj)
 949                 ;; ;;     (nth 2 ret)
 950                 ;; ;;     lang nil
 951                 ;; ;;     (eq mode 'simple))
 952                 ;; ;;    )
 953                 ;; ;;   (t
 954                 ;;  (princ (nth 1 ret))
 955                 ;;  (www-display-object-desc
 956                 ;;   'image-resource (nth 1 ret) (nth 2 ret)
 957                 ;;   lang nil
 958                 ;;   (eq mode 'simple))
 959                 ;; ;;    ))
 960                 ;;  )
 961                 (t
 962                  (www-display-object-desc
 963                   (car ret) (nth 1 ret) (nth 2 ret)
 964                   (nth 3 ret)
 965                   lang nil
 966                   (eq mode 'simple))
 967                  ))
 968           ))
 969         (unless (or json turtle)
 970           (princ "\n<hr>\n")
 971           (princ (format "mode=%S\n" mode))
 972           (princ (format "user=%s\n" user))
 973           ;; (princ (format "local user=%s\n" (user-login-name)))
 974           (princ (format "lang=%S\n" lang))
 975           (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
 976           ;; (princ " CHISE ")
 977           ;; (princ xemacs-chise-version)
 978           (princ "
 979 </body>
 980 </html>")
 981           )
 982         )
 983     (error nil
 984            (princ (format "%S" err)))
 985     ))
 986
 987 (provide 'cwiki-view)