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