cwiki-view.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'cwiki-common)
   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-display-char-desc (uri-char &optional lang level simple)
   9   (unless level
  10     (setq level 1))
  11   (let ((char (www-uri-decode-char uri-char))
  12         logical-feature displayed-features
  13         parents
  14         GlyphWiki-id)
  15     (when (characterp char)
  16       (when (= (length uri-char) 1)
  17         (setq uri-char (www-uri-encode-char char)))
  18       (when (= level 1)
  19         (princ
  20          (encode-coding-string
  21           (format "<head>
  22 <title>CHISE-wiki character: %s</title>
  23 </head>\n"
  24                   (decode-uri-string uri-char 'utf-8-mcs-er))
  25           'utf-8-mcs-er))
  26         (princ "<body>\n"))
  27       (dolist (feature (char-feature-property '$object 'additional-features))
  28         (mount-char-attribute-table
  29          (char-feature-name-at-domain feature '$rev=latest)))
  30       (princ
  31        (format
  32         (if simple
  33             "<div style=\"text-align:right;\">
  34 <a href=\"edit/view.cgi?char=%s\">
  35 <input type=\"submit\" value=\"Edit\" />
  36 </a>
  37 <input type=\"submit\" value=\"New Account\" />
  38 </div>
  39 <hr />\n"
  40           "<div style=\"text-align:right;\">
  41 <a href=\"../view.cgi?char=%s\">
  42 <input type=\"submit\" value=\"Simple\" />
  43 </a>
  44 </div>
  45 <hr />\n")
  46         uri-char))
  47       (when (setq parents (www-char-feature char '<-denotational))
  48         (princ (format "<p>%s %s</p>\n<hr>\n"
  49                        (www-format-value-as-char-list parents)
  50                        (www-format-feature-name '->denotational lang))))
  51       (when (setq parents (www-char-feature char '<-subsumptive))
  52         (princ (format "<p>%s %s</p>\n<hr>\n"
  53                        (www-format-value-as-char-list parents)
  54                        (www-format-feature-name '->subsumptive lang))))
  55       (setq GlyphWiki-id (char-GlyphWiki-id char))
  56       (princ (format "<h%d>%s%s</h%d>\n"
  57                      level
  58                      (www-format-encode-string (char-to-string char))
  59                      (if GlyphWiki-id
  60                          (format
  61                           " <a href=\"http://glyphwiki.org/wiki/%s\"><img alt=\"%s\" src=\"http://glyphwiki.org/glyph/%s.50px.png\" /></a>"
  62                           GlyphWiki-id
  63                           GlyphWiki-id GlyphWiki-id)
  64                        "")
  65                      level))
  66       (if (> level 1)
  67           (princ "<ul>"))
  68       (dolist (cell (sort (char-attribute-alist char)
  69                           (lambda (a b)
  70                             (char-attribute-name<
  71                              (char-feature-name-sans-versions (car a))
  72                              (char-feature-name-sans-versions (car b))))))
  73         (setq logical-feature (char-feature-name-sans-versions (car cell)))
  74         (unless (memq logical-feature displayed-features)
  75           (push logical-feature displayed-features)
  76           (princ
  77            (if (= level 1)
  78                "<div class=\"feature\" style=\"line-height:150%\">\n"
  79              "<li>\n"))
  80           (princ
  81            (www-format-eval-list
  82             (www-feature-format logical-feature)
  83             ;; (or (char-feature-property logical-feature ; (car cell)
  84             ;;                            'format)
  85             ;;     '((name) " : " (value)))
  86             char
  87             logical-feature ; (car cell)
  88             lang uri-char
  89             nil simple))
  90           (unless simple
  91             (princ
  92              (format " <a href=\"%s?char=%s&feature=%s&format=wiki-text\"
  93 ><input type=\"submit\" value=\"note\" /></a>"
  94                      chise-wiki-edit-url
  95                      (www-format-encode-string uri-char)
  96                      (www-format-encode-string
  97                       (www-uri-encode-feature-name
  98                        (intern (format "%s*note"
  99                                        logical-feature ; (car cell)
 100                                        )))))))
 101           (princ
 102            (if (= level 1)
 103                "</div>\n"
 104              "<li>\n"))
 105           ))
 106       (princ
 107        (if (= level 1)
 108            "<p>\n"
 109          "<li>\n"))
 110       (unless simple
 111         (princ
 112          (format "<a href=\"%s?char=%s\"
 113 ><input type=\"submit\" value=\"add feature\" /></a>
 114 "
 115                  chise-wiki-add-url
 116                  (www-format-encode-string uri-char))))
 117       (princ
 118        (if (= level 1)
 119            "<p>\n"
 120          "<li>\n"))
 121       (princ
 122        "<form action=\"http://chise.zinbun.kyoto-u.ac.jp/ids-find\">\n")
 123       (princ
 124        (www-format-encode-string
 125         (format "%c" char)))
 126       (princ
 127        (format
 128         " <input type=\"text\" name=\"components\"
 129 size=\"30\" maxlength=\"30\" value=\"%s\" />"
 130         (encode-coding-string (char-to-string char) 'utf-8-jp-er)))
 131       ;; (princ (www-format-encode-string "と"))
 132       ;; (princ "<input type=\"text\" name=\"additional-components\"
 133 size=\;; "30\" maxlength=\"30\" value=\"\" />")
 134       (princ
 135        (www-format-encode-string
 136         "を\u542Bむ\u6F22\u5B57を\u63A2す"))
 137       (princ " <input type=\"submit\" value=\"search\" />\n")
 138       (princ "</form>\n")
 139       (princ
 140        (if (= level 1)
 141            "</p>\n"
 142          "<li>\n"))
 143       )))
 144
 145 (defun www-display-feature-desc (uri-feature-name uri-char
 146                                                   &optional lang simple)
 147   (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
 148         (name@lang (intern (format "name@%s" lang))))
 149     (princ
 150      (encode-coding-string
 151       (format "<head>
 152 <title>CHISE-wiki feature: %s</title>
 153 </head>\n"
 154               feature-name)
 155       'utf-8-mcs-er))
 156     (princ "<body>\n")
 157     (princ
 158      (format
 159       (if simple
 160           "<div style=\"text-align:right;\">
 161 <a href=\"edit/view.cgi?feature=%s&char=%s\">
 162 <input type=\"submit\" value=\"Edit\" />
 163 </a>
 164 <input type=\"submit\" value=\"New Account\" />
 165 </div>
 166 <hr />\n"
 167           "<div style=\"text-align:right;\">
 168 <a href=\"../view.cgi?feature=%s&char=%s\">
 169 <input type=\"submit\" value=\"Simple\" />
 170 </a>
 171 </div>
 172 <hr />\n")
 173       uri-feature-name uri-char))
 174     (princ
 175      (format "<h1>%s</h1>\n"
 176              (www-format-encode-string
 177               (symbol-name feature-name))))
 178     (princ (format "<p>name : %s "
 179                    (or (www-format-feature-name feature-name) "")))
 180     (unless simple
 181       (princ
 182        (format
 183         " <a href=\"%s?feature=%s&property=name&format=string&char=%s\">"
 184         chise-wiki-edit-url
 185         uri-feature-name
 186         uri-char))
 187       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 188     (princ "</p>\n")
 189     (when lang
 190       (princ "<p>")
 191       (princ
 192        (www-format-encode-string
 193         (format "%s : %s"
 194                 name@lang
 195                 (or (char-feature-property feature-name name@lang) ""))))
 196       (unless simple
 197         (princ
 198          (format
 199           " <a href=\"%s?feature=%s&property=%s&format=string&char=%s\">"
 200           chise-wiki-edit-url
 201           uri-feature-name
 202           name@lang
 203           uri-char))
 204         (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 205       (princ "</p>\n"))
 206     (www-html-display-paragraph
 207      (format "type : %s"
 208              (or (www-feature-type feature-name)
 209                  ;; (char-feature-property feature-name 'type)
 210                  'generic)))
 211     (princ (format "<p>value-format : %s "
 212                    (www-format-value
 213                     nil 'value-format
 214                     (or (www-feature-value-format feature-name)
 215                         'default)
 216                     'default
 217                     'without-tags)))
 218     (unless simple
 219       (princ
 220        (format
 221         " <a href=\"%s?feature=%s&property=value-format&format=wiki-text&char=%s\"
 222 >"
 223         chise-wiki-edit-url
 224         uri-feature-name
 225         uri-char))
 226       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 227     (princ "</p>\n")
 228
 229     (princ "<p>format : ")
 230     (www-html-display-text
 231      (decode-coding-string
 232       (www-xml-format-list
 233        (www-feature-format feature-name))
 234       'utf-8-mcs-er))
 235     (unless simple
 236       (princ
 237        (format
 238         " <a href=\"%s?feature=%s&property=format&format=wiki-text&char=%s\"
 239 >"
 240         chise-wiki-edit-url
 241         uri-feature-name
 242         uri-char))
 243       (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
 244     (princ "</p>\n")
 245
 246     (www-html-display-paragraph
 247      (format "description : %s"
 248              (or (char-feature-property feature-name 'description)
 249                  "")))
 250     (when lang
 251       (www-html-display-paragraph
 252        (format "description@%s : %s"
 253                lang
 254                (or (char-feature-property
 255                     feature-name
 256                     (intern (format "description@%s" lang)))
 257                    ""))))
 258     ))
 259
 260 (defun www-batch-view ()
 261   (setq terminal-coding-system 'binary)
 262   (condition-case err
 263       (let* ((target (pop command-line-args-left))
 264              (user (pop command-line-args-left))
 265              (accept-language (pop command-line-args-left))
 266              (mode (intern (pop command-line-args-left)))
 267              (lang
 268               (intern
 269                (car (split-string
 270                      (car (split-string
 271                            (car (split-string accept-language ","))
 272                            ";"))
 273                      "-"))))
 274              ret)
 275         (princ "Content-Type: text/html; charset=UTF-8
 276
 277 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 278             \"http://www.w3.org/TR/html4/loose.dtd\">
 279 <html lang=\"ja\">
 280 ")
 281         (cond
 282          ((stringp target)
 283           (when (string-match "^char=\\(&[^&;]+;\\)" target)
 284             (setq ret (match-end 0))
 285             (setq target
 286                   (concat "char="
 287                           (www-uri-encode-char
 288                            (www-uri-decode-char (match-string 1 target)))
 289                           (substring target ret))))
 290           (setq target
 291                 (mapcar (lambda (cell)
 292                           (if (string-match "=" cell)
 293                               (cons
 294                                (intern
 295                                 (decode-uri-string
 296                                  (substring cell 0 (match-beginning 0))
 297                                  'utf-8-mcs-er))
 298                                (substring cell (match-end 0)))
 299                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 300                         (split-string target "&")))
 301           (setq ret (car target))
 302           (cond ((eq (car ret) 'char)
 303                  (www-display-char-desc
 304                   (cdr ret)
 305                   lang nil
 306                   (eq mode 'simple))
 307                  )
 308                 ((eq (car ret) 'feature)
 309                  (www-display-feature-desc
 310                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 311                   (cdr (assq 'char target))
 312                   lang
 313                   (eq mode 'simple))
 314                  ))
 315           ))
 316         (princ "\n<hr>\n")
 317         (princ (format "mode=%S\n" mode))
 318         (princ (format "user=%s\n" user))
 319         ;; (princ (format "local user=%s\n" (user-login-name)))
 320         (princ (format "lang=%S\n" lang))
 321         (princ (emacs-version))
 322         ;; (princ " CHISE ")
 323         ;; (princ xemacs-chise-version)
 324         (princ "
 325 </body>
 326 </html>")
 327         )
 328     (error nil
 329            (princ (format "%S" err)))
 330     ))
 331
 332 (provide 'cwiki-view)