cwiki-view.el

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