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