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