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