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