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         (cond ((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 ret (concord-object-get
 431                           HNG-card-cobj
 432                           '->glyph-image@gallica))
 433                (put-char-attribute object 'sources@gallica ret)
 434                ))
 435         )
 436       (setq object-spec
 437             (cond
 438              (uri-feature-name
 439               (setq feature-name-to-display
 440                     (www-uri-decode-feature-name uri-feature-name))
 441               (setq est-eval-list-feature-items-limit nil)
 442               (list
 443                (cons feature-name-to-display
 444                      (if (eq genre 'character)
 445                          (get-char-attribute object feature-name-to-display)
 446                        (concord-object-get object feature-name-to-display)))))
 447              (t
 448               (if (eq genre 'character)
 449                   (char-attribute-alist object)
 450                 (concord-object-spec object)))))
 451       (when feature-name-to-edit
 452         (unless (assq base-name-to-edit object-spec)
 453           (setq object-spec (cons (cons base-name-to-edit nil)
 454                                   object-spec))))
 455       (dolist (cell (sort object-spec
 456                           (lambda (a b)
 457                             (char-attribute-name<
 458                              (char-feature-name-sans-versions (car a))
 459                              (char-feature-name-sans-versions (car b))))))
 460         (setq logical-feature (char-feature-name-sans-versions (car cell)))
 461         (unless (memq logical-feature chise-wiki-displayed-features)
 462           (push logical-feature chise-wiki-displayed-features)
 463           (cond
 464            ((and feature-name-to-edit
 465                  (eq (car cell) feature-name-to-edit))
 466             (www-edit-display-feature-input-box
 467              object feature-name-to-edit editing-format)
 468             )
 469            (t
 470             (princ
 471              (if (= level 1)
 472                  "<div class=\"feature\" style=\"line-height:150%\">\n"
 473                "<li>\n"))
 474             (princ
 475              (www-format-eval-list
 476               (www-feature-format logical-feature)
 477               object
 478               logical-feature ; (car cell)
 479               lang uri-object
 480               nil simple))
 481             (unless simple
 482               (princ
 483                (format " <a href=\"%s?%s=%s&feature=%s&format=wiki-text\"
 484 ><input type=\"submit\" value=\"note\" /></a>"
 485                        chise-wiki-edit-url
 486                        genre
 487                        (www-format-encode-string uri-object)
 488                        (www-format-encode-string
 489                         (www-uri-encode-feature-name
 490                          (intern (format "%s*note"
 491                                          logical-feature ; (car cell)
 492                                          )))))))
 493             (when (and feature-name-to-edit
 494                        (eq base-name-to-edit (car cell)) metadata-name-to-edit)
 495               (princ "<ul>\n")
 496               (princ "<li>")
 497               (www-edit-display-feature-input-box
 498                object feature-name-to-edit editing-format)
 499               (princ "</li>")
 500               (princ "</ul>"))
 501             (princ
 502              (if (= level 1)
 503                  "</div>\n"
 504                "<li>\n"))
 505             ))
 506           ))
 507       (princ
 508        (if (= level 1)
 509            "<p>\n"
 510          "<li>\n"))
 511       (when feature-name-to-edit
 512         (princ "</form>\n"))
 513       (unless simple
 514         (princ
 515          (format "<a href=\"%s?%s=%s\"
 516 ><input type=\"submit\" value=\"add feature\" /></a>
 517 "
 518                  chise-wiki-add-url
 519                  genre
 520                  (www-format-encode-string uri-object))))
 521       (princ
 522        (if (= level 1)
 523            "<p>\n"
 524          "<li>\n"))
 525       (when (eq genre 'character)
 526         (let ((object-str (est-format-object object))
 527               encoded-object-for-form)
 528           (princ
 529            "<form action=\"http://www.chise.org/ids-find\">\n")
 530           (princ (www-format-encode-string object-str))
 531           (setq encoded-object-for-form
 532                 (with-temp-buffer
 533                   (insert (encode-coding-string object-str 'utf-8-jp-er))
 534                   (goto-char (point-min))
 535                   (while (search-forward "&GT-" nil t)
 536                     (replace-match "&amp;GT-" t t)
 537                     )
 538                   (buffer-string)))
 539           (princ
 540            (format
 541             " <input type=\"text\" name=\"components\"
 542 size=\"30\" maxlength=\"30\" value=\"%s\" />"
 543             encoded-object-for-form))
 544           (princ
 545            (www-format-encode-string
 546             "を\u542Bむ\u6F22\u5B57を\u63A2す"))
 547           (princ " <input type=\"submit\" value=\"search\" />\n")
 548           (princ "</form>\n")
 549
 550           (princ
 551            "<form action=\"http://www.chise.org/hng-ids-find\">\n")
 552           (princ (www-format-encode-string object-str))
 553
 554           (princ
 555            (format
 556             " <input type=\"text\" name=\"components\"
 557 size=\"30\" maxlength=\"30\" value=\"%s\" />"
 558             encoded-object-for-form))
 559           (princ
 560            (www-format-encode-string
 561             "を\u542Bむ HNG の\u6F22\u5B57を\u63A2す"))
 562           (princ " <input type=\"submit\" value=\"search\" />\n")
 563           (princ "</form>\n")
 564         ))
 565       (princ
 566        (if (= level 1)
 567            "</p>\n"
 568          "<li>\n"))
 569       )))
 570
 571 (defun www-display-feature-desc (uri-feature-name genre uri-object
 572                                                   &optional lang simple)
 573   (let ((rdf-uri-object (if est-hide-cgi-mode
 574                             (if (and uri-object
 575                                      (string-match "=" uri-object)
 576                                      (concat
 577                                       (est-uri-decode-feature-name-body
 578                                        (substring uri-object 0 (match-beginning 0)))
 579                                       ":"
 580                                       (est-uri-decode-feature-name-body
 581                                        (substring uri-object (match-end 0)))))
 582                                 uri-object)))
 583         (feature-name (www-uri-decode-feature-name uri-feature-name))
 584         (name@lang (intern (format "name@%s" lang))))
 585     (princ
 586      (encode-coding-string
 587       (format "<head>
 588 <title>EsT feature: %s</title>
 589 </head>\n"
 590               feature-name)
 591       'utf-8-mcs-er))
 592     (princ "<body>\n")
 593     (princ
 594      (if simple
 595          (format
 596           (if est-hide-cgi-mode
 597               "<div style=\"text-align:right;\">
 598 <a href=\"../../../edit/view.cgi?feature=%s&%s=%s\">
 599 <input type=\"submit\" value=\"Edit\" />
 600 </a>
 601 <input type=\"submit\" value=\"New Account\" />
 602 </div>
 603 <hr />\n"
 604             "<div style=\"text-align:right;\">
 605 <a href=\"edit/view.cgi?feature=%s&%s=%s\">
 606 <input type=\"submit\" value=\"Edit\" />
 607 </a>
 608 <input type=\"submit\" value=\"New Account\" />
 609 </div>
 610 <hr />\n")
 611           uri-feature-name genre rdf-uri-object)
 612        (format
 613         "<div style=\"text-align:right;\">
 614 <a href=\"../view/feature/%s&%s/%s\">
 615 <input type=\"submit\" value=\"Simple\" />
 616 </a>
 617 </div>
 618 <hr />\n"
 619         uri-feature-name genre uri-object)))
 620     (princ
 621      (format "<h1>%s</h1>\n"
 622              (www-format-encode-string
 623               (symbol-name feature-name))))
 624     (princ (format "<p>name : %s "
 625                    (or (www-format-feature-name feature-name) "")))
 626     (unless simple
 627       (princ
 628        (format
 629         " <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
 630         chise-wiki-edit-url
 631         uri-feature-name
 632         genre
 633         uri-object))
 634       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 635     (princ "</p>\n")
 636     (when lang
 637       (princ "<p>")
 638       (princ
 639        (www-format-encode-string
 640         (format "%s : %s"
 641                 name@lang
 642                 (or (char-feature-property feature-name name@lang) ""))))
 643       (unless simple
 644         (princ
 645          (format
 646           " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
 647           chise-wiki-edit-url
 648           uri-feature-name
 649           name@lang
 650           genre
 651           uri-object))
 652         (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 653       (princ "</p>\n"))
 654     (www-html-display-paragraph
 655      (format "type : %s"
 656              (or (www-feature-type feature-name)
 657                  ;; (char-feature-property feature-name 'type)
 658                  'generic)))
 659     (princ (format "<p>value-format : %s "
 660                    (www-format-value
 661                     nil 'value-format
 662                     (or (www-feature-value-format feature-name)
 663                         'default)
 664                     'default
 665                     'without-tags)
 666                    ))
 667     (unless simple
 668       (princ
 669        (format
 670         " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
 671 >"
 672         chise-wiki-edit-url
 673         uri-feature-name
 674         genre
 675         uri-object))
 676       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 677     (princ "</p>\n")
 678
 679     (princ (format "<p>value-presentation-format : %s "
 680                    (www-format-value
 681                     nil 'value-presentation-format
 682                     (or (www-feature-value-format feature-name)
 683                         'default)
 684                     'default
 685                     'without-tags)
 686                    ))
 687     (unless simple
 688       (princ
 689        (format
 690         " <a href=\"%s?feature=%s&property=value-presentation-format&format=wiki-text&%s=%s\"
 691 >"
 692         chise-wiki-edit-url
 693         uri-feature-name
 694         genre
 695         uri-object))
 696       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 697     (princ "</p>\n")
 698
 699     (princ "<p>format : ")
 700     (www-html-display-text
 701      (decode-coding-string
 702       (www-xml-format-list
 703        (www-feature-format feature-name))
 704       'utf-8-mcs-er))
 705     (unless simple
 706       (princ
 707        (format
 708         " <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
 709 >"
 710         chise-wiki-edit-url
 711         uri-feature-name
 712         genre
 713         uri-object))
 714       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 715     (princ "</p>\n")
 716
 717     (www-html-display-paragraph
 718      (format "description : %s"
 719              (or (decode-coding-string
 720                   (or (char-feature-property feature-name 'description)
 721                       "")
 722                   'utf-8-mcs-er)
 723                  "")))
 724     (when lang
 725       (www-html-display-paragraph
 726        (format "description@%s : %s"
 727                lang
 728                (or (char-feature-property
 729                     feature-name
 730                     (intern (format "description@%s" lang)))
 731                    ""))))
 732     ))
 733
 734 (defun www-batch-view ()
 735   (setq terminal-coding-system 'binary)
 736   (condition-case err
 737       (let* ((target (pop command-line-args-left))
 738              (user (pop command-line-args-left))
 739              (accept-language (pop command-line-args-left))
 740              (mode (intern (pop command-line-args-left)))
 741              (lang
 742               (intern
 743                (car (split-string
 744                      (car (split-string
 745                            (car (split-string accept-language ","))
 746                            ";"))
 747                      "-"))))
 748              ret genre)
 749         (princ "Content-Type: text/html; charset=UTF-8
 750
 751 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 752             \"http://www.w3.org/TR/html4/loose.dtd\">
 753 <html lang=\"ja\">
 754 ")
 755         (cond
 756          ((stringp target)
 757           (when (string-match "^char=\\(&[^&;]+;\\)" target)
 758             (setq ret (match-end 0))
 759             (setq target
 760                   (concat "char="
 761                           (www-uri-encode-object
 762                            (www-uri-decode-object
 763                             'character (match-string 1 target)))
 764                           (substring target ret))))
 765           (setq target
 766                 (mapcar (lambda (cell)
 767                           (if (string-match "=" cell)
 768                               (progn
 769                                 (setq genre (substring cell 0 (match-beginning 0))
 770                                       ret (substring cell (match-end 0)))
 771                                 (cons
 772                                  (intern
 773                                   (decode-uri-string genre 'utf-8-mcs-er))
 774                                  ret))
 775                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 776                         (split-string target "&")))
 777           (setq ret (car target))
 778           (cond ((eq (car ret) 'char)
 779                  (www-display-object-desc
 780                   'character (cdr ret) (cdr (assq 'feature target))
 781                   nil
 782                   lang nil
 783                   (eq mode 'simple))
 784                  )
 785                 ((eq (car ret) 'feature)
 786                  (www-display-feature-desc
 787                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 788                   (car (nth 1 target))
 789                   (cdr (nth 1 target))
 790                   lang
 791                   (eq mode 'simple))
 792                  )
 793                 (t
 794                  (www-display-object-desc
 795                   (car ret) (cdr ret) (cdr (assq 'feature target))
 796                   nil
 797                   lang nil
 798                   (eq mode 'simple))
 799                  ))
 800           ))
 801         (princ "\n<hr>\n")
 802         (princ (format "mode=%S\n" mode))
 803         (princ (format "user=%s\n" user))
 804         ;; (princ (format "local user=%s\n" (user-login-name)))
 805         (princ (format "lang=%S\n" lang))
 806         (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
 807         ;; (princ " CHISE ")
 808         ;; (princ xemacs-chise-version)
 809         (princ "
 810 </body>
 811 </html>")
 812         )
 813     (error nil
 814            (princ (format "%S" err)))
 815     ))
 816
 817 (defun www-batch-view-smart ()
 818   (setq debug-on-error t)
 819   (setq terminal-coding-system 'binary)
 820   (condition-case err
 821       (let* ((est-hide-cgi-mode t)
 822              (target (pop command-line-args-left))
 823              (user (pop command-line-args-left))
 824              (accept-language (pop command-line-args-left))
 825              (mode (intern (pop command-line-args-left)))
 826              (lang
 827               (intern
 828                (car (split-string
 829                      (car (split-string
 830                            (car (split-string accept-language ","))
 831                            ";"))
 832                      "-"))))
 833              ret genre feature obj-url json turtle obj)
 834         (cond
 835          ((stringp target)
 836           (cond
 837            ((string-match "/data\\.json$" target)
 838             (setq json t
 839                   target (substring target 0 (match-beginning 0)))
 840             )
 841            ((string-match "/index\\.ttl$" target)
 842             (setq turtle t
 843                   target (substring target 0 (match-beginning 0)))
 844             ))
 845           (when (string-match "^char/\\(&[^&;]+;\\)" target)
 846             (setq ret (match-end 0))
 847             (setq target
 848                   (concat "char/"
 849                           (www-uri-encode-object
 850                            (www-uri-decode-object
 851                             'character (match-string 1 target)))
 852                           (substring target ret))))
 853           (setq target
 854                 (mapcar
 855                  (lambda (cell)
 856                    (if (string-match "/" cell)
 857                        (progn
 858                          (setq genre (substring cell 0 (match-beginning 0))
 859                                ret (substring cell (match-end 0)))
 860                          (cons
 861                           (intern (decode-uri-string genre 'utf-8-mcs-er))
 862                           (cond
 863                            ((string-match "/feature=" ret)
 864                             (list (substring ret 0 (match-beginning 0))
 865                                   (substring ret (match-end 0)))
 866                             )
 867                            ((string-match "...$.zoom-xywh=" ret)
 868                             (list (substring ret 0 (match-beginning 0))
 869                                   nil
 870                                   (substring ret (match-end 0)))
 871                             )
 872                            (t
 873                             (list ret)))))
 874                      (list (decode-uri-string cell 'utf-8-mcs-er)))
 875                    ;; (setq ret (split-string cell "/"))
 876                    ;; (cons (intern
 877                    ;;        (decode-uri-string (car ret) 'utf-8-mcs-er))
 878                    ;;       (cdr ret))
 879                    )
 880                  (split-string target "&")))
 881           (setq ret (car target))
 882           (cond (turtle
 883                  (princ "Content-Type: text/turtle; charset=UTF-8
 884
 885 ")
 886                  )
 887                 (json
 888                  (princ "Content-Type: application/json; charset=UTF-8
 889
 890 ")
 891                  )
 892                 (t
 893                  (princ "Content-Type: text/html; charset=UTF-8
 894
 895 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 896             \"http://www.w3.org/TR/html4/loose.dtd\">
 897 <html lang=\"ja\">
 898 ")
 899                  ))
 900           ;; (princ (format "<p>%S, %S, %S</p>"
 901           ;;                (car ret)(nth 1 ret)(nth 2 ret)))
 902           ;; (princ (format "// %S %S\n" ret json))
 903           (cond (turtle
 904                  (with-temp-buffer
 905                    (setq obj (www-uri-decode-object (car ret)(nth 1 ret)))
 906                    (concord-turtle-insert-char-data obj)
 907                    (goto-char (point-min))
 908                    (concord-turtle-insert-prefix)
 909                    (insert "\n")
 910                    (encode-coding-region
 911                     (point-min)(point-max)
 912                     char-db-file-coding-system)
 913                    (princ (buffer-string)))
 914                  )
 915                 ((or (eq (car ret) 'char)
 916                      (eq (car ret) 'character))
 917                  (if (and json
 918                           (setq obj (www-uri-decode-object
 919                                      (car ret)(nth 1 ret)))
 920                           (characterp obj))
 921                      (with-temp-buffer
 922                        ;; (princ (encode-coding-string
 923                        ;;         (format "// %S\n" obj)
 924                        ;;         char-db-file-coding-system))
 925                        (char-db-json-char-data-with-variant obj 'printable)
 926                        (encode-coding-region
 927                         (point-min)(point-max)
 928                         char-db-file-coding-system)
 929                        (princ (buffer-string))
 930                        )
 931                    (www-display-object-desc
 932                     'character (nth 1 ret) (nth 2 ret)
 933                     nil
 934                     lang nil
 935                     (eq mode 'simple)))
 936                  )
 937                 ((eq (car ret) 'feature)
 938                  (www-display-feature-desc
 939                   (decode-uri-string (nth 1 ret) 'utf-8-mcs-er)
 940                   (car (nth 1 target))
 941                   (nth 1 (nth 1 target))
 942                   lang
 943                   (eq mode 'simple))
 944                  )
 945                 ;; ((eq (car ret) 'image-resource)
 946                 ;; ;;  (cond
 947                 ;; ;;   ((string-match "^\\.iiif=" (nth 1 ret))
 948                 ;; ;;    (setq obj-url (decode-uri-string
 949                 ;; ;;                   (substring (nth 1 ret) (match-end 0))
 950                 ;; ;;                   'utf-8-mcs-er))
 951                 ;; ;;    (setq obj (concord-images-add-iiif obj-url))
 952                 ;; ;;    (www-display-object-desc
 953                 ;; ;;     'image-resource
 954                 ;; ;;     (www-uri-encode-object obj)
 955                 ;; ;;     (nth 2 ret)
 956                 ;; ;;     lang nil
 957                 ;; ;;     (eq mode 'simple))
 958                 ;; ;;    )
 959                 ;; ;;   (t
 960                 ;;  (princ (nth 1 ret))
 961                 ;;  (www-display-object-desc
 962                 ;;   'image-resource (nth 1 ret) (nth 2 ret)
 963                 ;;   lang nil
 964                 ;;   (eq mode 'simple))
 965                 ;; ;;    ))
 966                 ;;  )
 967                 (t
 968                  (www-display-object-desc
 969                   (car ret) (nth 1 ret) (nth 2 ret)
 970                   (nth 3 ret)
 971                   lang nil
 972                   (eq mode 'simple))
 973                  ))
 974           ))
 975         (unless (or json turtle)
 976           (princ "\n<hr>\n")
 977           (princ (format "mode=%S\n" mode))
 978           (princ (format "user=%s\n" user))
 979           ;; (princ (format "local user=%s\n" (user-login-name)))
 980           (princ (format "lang=%S\n" lang))
 981           (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
 982           ;; (princ " CHISE ")
 983           ;; (princ xemacs-chise-version)
 984           (princ "
 985 </body>
 986 </html>")
 987           )
 988         )
 989     (error nil
 990            (princ (format "%S" err)))
 991     ))
 992
 993 (provide 'cwiki-view)