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