cwiki-view.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'cwiki-format)
   3
   4 (defvar chise-wiki-view-url "view.cgi")
   5 (defvar chise-wiki-edit-url "edit.cgi")
   6 (defvar chise-wiki-add-url "add.cgi")
   7
   8 (defun www-edit-display-feature-input-box (char feature-name
   9                                                 &optional format value)
  10   (if (symbolp char)
  11       (setq char (or (concord-decode-object '=id char 'feature)
  12                      (concord-make-object 'feature char))))
  13   (unless format
  14     (setq format 'default))
  15   (unless value
  16     (setq value (www-get-feature-value char feature-name)))
  17   (if (and (symbolp value)
  18            (eq format 'wiki-text))
  19       (setq value (list (list value))))
  20   (princ
  21    (format "<p><input type=\"text\" name=\"feature-name\"
  22 size=\"32\" maxlength=\"256\" value=\"%s\">"
  23            feature-name))
  24   (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
  25   (princ
  26    (format "%s<input type=\"text\" name=\"%s\"
  27 size=\"64\" maxlength=\"256\" value=\"%s\">
  28 <input type=\"submit\" value=\"set\" /></p>
  29 "
  30            (if (or (eq format 'HEX)(eq format 'hex))
  31                "0x"
  32              "")
  33            format
  34            (mapconcat (lambda (c)
  35                         (cond
  36                          ;; ((eq c ?<) "&amp;lt;")
  37                          ;; ((eq c ?>) "&amp;gt;")
  38                          ((eq c ?\u0022) "&quot;")
  39                          (t
  40                           (char-to-string c))))
  41                       (est-format-list value format nil nil " ")
  42                       "")))
  43   )
  44
  45 (defun www-display-object-desc (genre uri-object &optional uri-feature-name
  46                                       lang level simple
  47                                       uri-feature-name-to-edit editing-format)
  48   (unless level
  49     (setq level 0))
  50   (let ((object (www-uri-decode-object genre uri-object))
  51         (est-eval-list-feature-items-limit est-eval-list-feature-items-limit)
  52         feature-name-to-display feature-name-to-edit
  53         base-name-to-edit metadata-name-to-edit
  54         without-header
  55         logical-feature chise-wiki-displayed-features
  56         parents
  57         GlyphWiki-id ret object-spec)
  58     (if (eq level 0)
  59         (setq level 1
  60               without-header nil)
  61       (setq without-header t))
  62     (when object
  63       (when uri-feature-name-to-edit
  64         (setq feature-name-to-edit
  65               (www-uri-decode-feature-name uri-feature-name-to-edit))
  66         (setq ret (symbol-name feature-name-to-edit))
  67         (if (string-match "\\*" ret)
  68             (setq base-name-to-edit (intern
  69                                      (substring ret 0 (match-beginning 0)))
  70                   metadata-name-to-edit (intern
  71                                          (substring ret (match-end 0))))
  72           (setq base-name-to-edit feature-name-to-edit))
  73         (when (stringp editing-format)
  74           (setq editing-format (intern editing-format))))
  75       (when (and (eq genre 'character)
  76                  (= (length uri-object) 1))
  77         (setq uri-object (www-uri-encode-object object)))
  78       (when (= level 1)
  79         (princ
  80          (encode-coding-string
  81           (format "<head>
  82 <title>EsT %s = %s</title>
  83 </head>\n"
  84                   genre
  85                   (decode-uri-string uri-object 'utf-8-mcs-er))
  86           'utf-8-mcs-er))
  87         (princ "<body>\n"))
  88       (when (eq genre 'character)
  89         (dolist (feature (char-feature-property '$object 'additional-features))
  90           (mount-char-attribute-table
  91            (char-feature-name-at-domain feature '$rev=latest))))
  92       (princ
  93        (format
  94         (if simple
  95             "<div style=\"text-align:right;\">
  96 <a href=\"edit/view.cgi?%s=%s\">
  97 <input type=\"submit\" value=\"Edit\" />
  98 </a>
  99 <input type=\"submit\" value=\"New Account\" />
 100 <a href=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
 101 <input type=\"submit\" value=\"RDF\" />
 102 </a>
 103 </div>
 104 <hr />\n"
 105           "<div style=\"text-align:right;\">
 106 <a href=\"../view.cgi?%s=%s\">
 107 <input type=\"submit\" value=\"Simple\" />
 108 </a>
 109 <input type=\"submit\" value=\"New Account\" />
 110 <a href=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
 111 <input type=\"submit\" value=\"RDF\" />
 112 </a>
 113 </div>
 114 <hr />\n")
 115         genre uri-object
 116         genre uri-object))
 117       (when (setq parents (www-get-feature-value object '<-denotational))
 118         (princ (format "<p>%s %s</p>\n<hr>\n"
 119                        (www-format-value-as-char-list parents)
 120                        (www-format-feature-name '->denotational lang))))
 121       (when (setq parents (www-get-feature-value object '<-subsumptive))
 122         (princ (format "<p>%s %s</p>\n<hr>\n"
 123                        (www-format-value-as-char-list parents)
 124                        (www-format-feature-name '->subsumptive lang))))
 125       (when (eq genre 'character)
 126         (setq GlyphWiki-id (char-GlyphWiki-id object)))
 127       (setq ret (www-format-encode-string
 128                  (est-format-object object 'readable)))
 129       (princ (format "<h%d>%s%s</h%d>\n"
 130                      level
 131                      (if uri-feature-name
 132                          (format "<a href=\"%s\">%s</a>"
 133                                  (www-uri-make-object-url object uri-object)
 134                                  ret)
 135                        ret)
 136                      (if GlyphWiki-id
 137                          (format
 138                           " <a href=\"http://glyphwiki.org/wiki/%s\"><img alt=\"%s\" src=\"http://glyphwiki.org/glyph/%s.50px.png\" /></a>"
 139                           GlyphWiki-id
 140                           GlyphWiki-id GlyphWiki-id)
 141                        "")
 142                      level))
 143       (if (> level 1)
 144           (princ "<ul>"))
 145       (when feature-name-to-edit
 146         (princ "<form action=\"set.cgi\" method=\"GET\">\n")
 147         (princ
 148          (encode-coding-string
 149           (format "<p>(%s : <input type=\"text\" name=\"%s\"
 150 size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
 151 "
 152                   genre genre
 153                   (decode-uri-string uri-object 'utf-8-mcs-er))
 154           'utf-8-mcs-er)))
 155       (setq object-spec
 156             (cond
 157              (uri-feature-name
 158               (setq feature-name-to-display
 159                     (www-uri-decode-feature-name uri-feature-name))
 160               (setq est-eval-list-feature-items-limit nil)
 161               (list
 162                (cons feature-name-to-display
 163                      (if (eq genre 'character)
 164                          (get-char-attribute object feature-name-to-display)
 165                        (concord-object-get object feature-name-to-display)))))
 166              (t
 167               (if (eq genre 'character)
 168                   (char-attribute-alist object)
 169                 (concord-object-spec object)))))
 170       (when feature-name-to-edit
 171         (unless (assq base-name-to-edit object-spec)
 172           (setq object-spec (cons (cons base-name-to-edit nil)
 173                                   object-spec))))
 174       (dolist (cell (sort object-spec
 175                           (lambda (a b)
 176                             (char-attribute-name<
 177                              (char-feature-name-sans-versions (car a))
 178                              (char-feature-name-sans-versions (car b))))))
 179         (setq logical-feature (char-feature-name-sans-versions (car cell)))
 180         (unless (memq logical-feature chise-wiki-displayed-features)
 181           (push logical-feature chise-wiki-displayed-features)
 182           (cond
 183            ((and feature-name-to-edit
 184                  (eq (car cell) feature-name-to-edit))
 185             (www-edit-display-feature-input-box
 186              object feature-name-to-edit editing-format)
 187             )
 188            (t
 189             (princ
 190              (if (= level 1)
 191                  "<div class=\"feature\" style=\"line-height:150%\">\n"
 192                "<li>\n"))
 193             (princ
 194              (www-format-eval-list
 195               (www-feature-format logical-feature)
 196               object
 197               logical-feature ; (car cell)
 198               lang uri-object
 199               nil simple))
 200             (unless simple
 201               (princ
 202                (format " <a href=\"%s?%s=%s&feature=%s&format=wiki-text\"
 203 ><input type=\"submit\" value=\"note\" /></a>"
 204                        chise-wiki-edit-url
 205                        genre
 206                        (www-format-encode-string uri-object)
 207                        (www-format-encode-string
 208                         (www-uri-encode-feature-name
 209                          (intern (format "%s*note"
 210                                          logical-feature ; (car cell)
 211                                          )))))))
 212             (when (and feature-name-to-edit
 213                        (eq base-name-to-edit (car cell)) metadata-name-to-edit)
 214               (princ "<ul>\n")
 215               (princ "<li>")
 216               (www-edit-display-feature-input-box
 217                object feature-name-to-edit editing-format)
 218               (princ "</li>")
 219               (princ "</ul>"))
 220             (princ
 221              (if (= level 1)
 222                  "</div>\n"
 223                "<li>\n"))
 224             ))
 225           ))
 226       (princ
 227        (if (= level 1)
 228            "<p>\n"
 229          "<li>\n"))
 230       (when feature-name-to-edit
 231         (princ "</form>\n"))
 232       (unless simple
 233         (princ
 234          (format "<a href=\"%s?%s=%s\"
 235 ><input type=\"submit\" value=\"add feature\" /></a>
 236 "
 237                  chise-wiki-add-url
 238                  genre
 239                  (www-format-encode-string uri-object))))
 240       (princ
 241        (if (= level 1)
 242            "<p>\n"
 243          "<li>\n"))
 244       (when (eq genre 'character)
 245         (princ
 246          "<form action=\"http://www.chise.org/ids-find\">\n")
 247         (princ
 248          (www-format-encode-string
 249           (est-format-object object)
 250           ;; (if (eq genre 'character)
 251           ;;     (format "%c" object)
 252           ;;   (format "%s" (concord-object-id object)))
 253           ))
 254         (princ
 255          (format
 256           " <input type=\"text\" name=\"components\"
 257 size=\"30\" maxlength=\"30\" value=\"%s\" />"
 258           (encode-coding-string
 259            (est-format-object object)
 260            ;; (if (eq genre 'character)
 261            ;;     (char-to-string object)
 262            ;;   (format "%s" (concord-object-id object)))
 263            'utf-8-jp-er)))
 264         (princ
 265          (www-format-encode-string
 266           "を\u542Bむ\u6F22\u5B57を\u63A2す"))
 267         (princ " <input type=\"submit\" value=\"search\" />\n")
 268         (princ "</form>\n"))
 269       (princ
 270        (if (= level 1)
 271            "</p>\n"
 272          "<li>\n"))
 273       )))
 274
 275 (defun www-display-feature-desc (uri-feature-name genre uri-object
 276                                                   &optional lang simple)
 277   (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
 278         (name@lang (intern (format "name@%s" lang))))
 279     (princ
 280      (encode-coding-string
 281       (format "<head>
 282 <title>EsT feature: %s</title>
 283 </head>\n"
 284               feature-name)
 285       'utf-8-mcs-er))
 286     (princ "<body>\n")
 287     (princ
 288      (format
 289       (if simple
 290           "<div style=\"text-align:right;\">
 291 <a href=\"edit/view.cgi?feature=%s&%s=%s\">
 292 <input type=\"submit\" value=\"Edit\" />
 293 </a>
 294 <input type=\"submit\" value=\"New Account\" />
 295 </div>
 296 <hr />\n"
 297           "<div style=\"text-align:right;\">
 298 <a href=\"../view.cgi?feature=%s&%s=%s\">
 299 <input type=\"submit\" value=\"Simple\" />
 300 </a>
 301 </div>
 302 <hr />\n")
 303       uri-feature-name genre uri-object))
 304     (princ
 305      (format "<h1>%s</h1>\n"
 306              (www-format-encode-string
 307               (symbol-name feature-name))))
 308     (princ (format "<p>name : %s "
 309                    (or (www-format-feature-name feature-name) "")))
 310     (unless simple
 311       (princ
 312        (format
 313         " <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
 314         chise-wiki-edit-url
 315         uri-feature-name
 316         genre
 317         uri-object))
 318       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 319     (princ "</p>\n")
 320     (when lang
 321       (princ "<p>")
 322       (princ
 323        (www-format-encode-string
 324         (format "%s : %s"
 325                 name@lang
 326                 (or (char-feature-property feature-name name@lang) ""))))
 327       (unless simple
 328         (princ
 329          (format
 330           " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
 331           chise-wiki-edit-url
 332           uri-feature-name
 333           name@lang
 334           genre
 335           uri-object))
 336         (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 337       (princ "</p>\n"))
 338     (www-html-display-paragraph
 339      (format "type : %s"
 340              (or (www-feature-type feature-name)
 341                  ;; (char-feature-property feature-name 'type)
 342                  'generic)))
 343     (princ (format "<p>value-format : %s "
 344                    (www-format-value
 345                     nil 'value-format
 346                     (or (www-feature-value-format feature-name)
 347                         'default)
 348                     'default
 349                     'without-tags)
 350                    ))
 351     (unless simple
 352       (princ
 353        (format
 354         " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
 355 >"
 356         chise-wiki-edit-url
 357         uri-feature-name
 358         genre
 359         uri-object))
 360       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 361     (princ "</p>\n")
 362
 363     (princ (format "<p>value-presentation-format : %s "
 364                    (www-format-value
 365                     nil 'value-presentation-format
 366                     (or (www-feature-value-format feature-name)
 367                         'default)
 368                     'default
 369                     'without-tags)
 370                    ))
 371     (unless simple
 372       (princ
 373        (format
 374         " <a href=\"%s?feature=%s&property=value-presentation-format&format=wiki-text&%s=%s\"
 375 >"
 376         chise-wiki-edit-url
 377         uri-feature-name
 378         genre
 379         uri-object))
 380       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 381     (princ "</p>\n")
 382
 383     (princ "<p>format : ")
 384     (www-html-display-text
 385      (decode-coding-string
 386       (www-xml-format-list
 387        (www-feature-format feature-name))
 388       'utf-8-mcs-er))
 389     (unless simple
 390       (princ
 391        (format
 392         " <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
 393 >"
 394         chise-wiki-edit-url
 395         uri-feature-name
 396         genre
 397         uri-object))
 398       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 399     (princ "</p>\n")
 400
 401     (www-html-display-paragraph
 402      (format "description : %s"
 403              (or (char-feature-property feature-name 'description)
 404                  "")))
 405     (when lang
 406       (www-html-display-paragraph
 407        (format "description@%s : %s"
 408                lang
 409                (or (char-feature-property
 410                     feature-name
 411                     (intern (format "description@%s" lang)))
 412                    ""))))
 413     ))
 414
 415 (defun www-batch-view ()
 416   (setq terminal-coding-system 'binary)
 417   (condition-case err
 418       (let* ((target (pop command-line-args-left))
 419              (user (pop command-line-args-left))
 420              (accept-language (pop command-line-args-left))
 421              (mode (intern (pop command-line-args-left)))
 422              (lang
 423               (intern
 424                (car (split-string
 425                      (car (split-string
 426                            (car (split-string accept-language ","))
 427                            ";"))
 428                      "-"))))
 429              ret genre)
 430         (princ "Content-Type: text/html; charset=UTF-8
 431
 432 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 433             \"http://www.w3.org/TR/html4/loose.dtd\">
 434 <html lang=\"ja\">
 435 ")
 436         (cond
 437          ((stringp target)
 438           (when (string-match "^char=\\(&[^&;]+;\\)" target)
 439             (setq ret (match-end 0))
 440             (setq target
 441                   (concat "char="
 442                           (www-uri-encode-object
 443                            (www-uri-decode-object
 444                             'character (match-string 1 target)))
 445                           (substring target ret))))
 446           (setq target
 447                 (mapcar (lambda (cell)
 448                           (if (string-match "=" cell)
 449                               (progn
 450                                 (setq genre (substring cell 0 (match-beginning 0))
 451                                       ret (substring cell (match-end 0)))
 452                                 (cons
 453                                  (intern
 454                                   (decode-uri-string genre 'utf-8-mcs-er))
 455                                  ret))
 456                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 457                         (split-string target "&")))
 458           (setq ret (car target))
 459           (cond ((eq (car ret) 'char)
 460                  (www-display-object-desc
 461                   'character (cdr ret) (cdr (assq 'feature target))
 462                   lang nil
 463                   (eq mode 'simple))
 464                  )
 465                 ((eq (car ret) 'feature)
 466                  (www-display-feature-desc
 467                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 468                   (car (nth 1 target))
 469                   (cdr (nth 1 target))
 470                   lang
 471                   (eq mode 'simple))
 472                  )
 473                 (t
 474                  (www-display-object-desc
 475                   (car ret) (cdr ret) (cdr (assq 'feature target))
 476                   lang nil
 477                   (eq mode 'simple))
 478                  ))
 479           ))
 480         (princ "\n<hr>\n")
 481         (princ (format "mode=%S\n" mode))
 482         (princ (format "user=%s\n" user))
 483         ;; (princ (format "local user=%s\n" (user-login-name)))
 484         (princ (format "lang=%S\n" lang))
 485         (princ (encode-coding-string (emacs-version) 'utf-8-jp-er))
 486         ;; (princ " CHISE ")
 487         ;; (princ xemacs-chise-version)
 488         (princ "
 489 </body>
 490 </html>")
 491         )
 492     (error nil
 493            (princ (format "%S" err)))
 494     ))
 495
 496 (provide 'cwiki-view)