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