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