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-char-display-feature-default (char feature-name &optional value
   9                                               lang uri-char)
  10   (unless value
  11     (setq value (www-char-feature char feature-name)))
  12   (unless uri-char
  13     (setq uri-char (char-to-string char)))
  14   (www-html-display-paragraph
  15    (format "[[%s|%?feature=%s&char=%s]] : %s [[[edit|%s?char=%s&feature=%s]]]"
  16            (www-format-feature-name feature-name lang)
  17            chise-wiki-view-url
  18            (www-uri-encode-feature-name feature-name)
  19            uri-char
  20            (www-format-value value feature-name)
  21            chise-wiki-edit-url
  22            uri-char
  23            (www-uri-encode-feature-name feature-name)
  24            )))
  25
  26 (defun www-char-display-feature-as-ucs (char feature-name &optional value)
  27   (unless value
  28     (setq value (www-char-feature char feature-name)))
  29   (www-html-display-paragraph
  30    (format "= [[U+%s|http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%s]] (%d)"
  31            (www-format-value-as-HEX value)
  32            (www-format-value-as-HEX value)
  33            value)))
  34
  35 (defun www-display-char-desc (uri-char &optional lang level)
  36   (unless level
  37     (setq level 1))
  38   (let ((char (www-uri-decode-char uri-char))
  39         logical-feature displayed-features)
  40     (when (characterp char)
  41       (when (= (length uri-char) 1)
  42         (setq uri-char (www-uri-encode-char char)))
  43       (when (= level 1)
  44         (princ
  45          (encode-coding-string
  46           (format "<head>
  47 <title>CHISE-wiki character: %s</title>
  48 </head>\n"
  49                   (decode-uri-string uri-char 'utf-8-mcs-er))
  50           'utf-8-mcs-er))
  51         (princ "<body>\n"))
  52       (princ (format "<h%d>%s</h%d>\n"
  53                      level
  54                      (www-format-encode-string (char-to-string char))
  55                      level))
  56       (if (> level 1)
  57           (princ "<ul>"))
  58       (dolist (cell (sort (char-attribute-alist char)
  59                           (lambda (a b)
  60                             (char-attribute-name< (car a)(car b)))))
  61         (setq logical-feature (char-feature-name-sans-versions (car cell)))
  62         (unless (memq logical-feature displayed-features)
  63           (push logical-feature displayed-features)
  64           (princ
  65            (if (= level 1)
  66                "<p>\n"
  67              "<li>\n"))
  68           (princ
  69            (www-format-eval-list
  70             (or (char-feature-property logical-feature ; (car cell)
  71                                        'format)
  72                 '((name) " : " (value)))
  73             char
  74             logical-feature ; (car cell)
  75             lang uri-char))
  76           (princ
  77            (format " <a href=\"%s?char=%s&feature=%s&format=wiki-text\"
  78 ><input type=\"submit\" value=\"note\" /></a>"
  79                    chise-wiki-edit-url
  80                    (www-format-encode-string uri-char)
  81                    (www-format-encode-string
  82                     (www-uri-encode-feature-name
  83                      (intern (format "%s*note"
  84                                      logical-feature ; (car cell)
  85                                      ))))))
  86           (princ
  87            (if (= level 1)
  88                "</p>\n"
  89              "<li>\n"))
  90           ))
  91       (princ
  92        (if (= level 1)
  93            "<p>\n"
  94          "<li>\n"))
  95       (princ
  96        (format "<a href=\"%s?char=%s\"
  97 ><input type=\"submit\" value=\"add feature\" /></a>
  98 "
  99                chise-wiki-add-url
 100                (www-format-encode-string uri-char)))
 101       (princ
 102        (if (= level 1)
 103            "</p>\n"
 104          "<li>\n"))
 105       )))
 106
 107 (defun www-display-feature-desc (uri-feature-name uri-char &optional lang)
 108   (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
 109         (name@lang (intern (format "name@%s" lang))))
 110     (princ
 111      (encode-coding-string
 112       (format "<head>
 113 <title>CHISE-wiki feature: %s</title>
 114 </head>\n"
 115               feature-name)
 116       'utf-8-mcs-er))
 117     (princ "<body>\n")
 118     (princ
 119      (format "<h1>%s</h1>\n"
 120              (www-format-encode-string
 121               (symbol-name feature-name))))
 122     (princ (format "<p>name : %s "
 123                    (or (www-format-feature-name feature-name) "")))
 124     (www-html-display-text
 125      (format "[[[edit|%s?feature=%s&property=name&char=%s]]]"
 126              ;; (char-feature-property feature-name 'name)
 127              chise-wiki-edit-url
 128              uri-feature-name ; (www-uri-encode-feature-name feature-name)
 129              uri-char))
 130     (princ "</p>")
 131     (when lang
 132       (princ "<p>")
 133       (princ
 134        (www-format-encode-string
 135         (format "%s : %s"
 136                 name@lang
 137                 (or (char-feature-property feature-name name@lang) ""))))
 138       (www-html-display-text
 139        (format " [[[edit|%s?feature=%s&property=%s&char=%s]]]"
 140                chise-wiki-edit-url
 141                uri-feature-name
 142                name@lang
 143                uri-char))
 144       (princ "</p>"))
 145     (www-html-display-paragraph
 146      (format "type : %s"
 147              (or (www-feature-type feature-name)
 148                  ;; (char-feature-property feature-name 'type)
 149                  'generic)))
 150     (www-html-display-paragraph
 151      (format "description : %s"
 152              (or (char-feature-property feature-name 'description)
 153                  "")))
 154     (when lang
 155       (www-html-display-paragraph
 156        (format "description@%s : %s"
 157                lang
 158                (or (char-feature-property
 159                     feature-name
 160                     (intern (format "description@%s" lang)))
 161                    ""))))
 162     ))
 163
 164 (defun www-batch-view ()
 165   (setq terminal-coding-system 'binary)
 166   (condition-case err
 167       (let* ((target (pop command-line-args-left))
 168              (user (pop command-line-args-left))
 169              (accept-language (pop command-line-args-left))
 170              (lang
 171               (intern
 172                (car (split-string
 173                      (car (split-string
 174                            (car (split-string accept-language ","))
 175                            ";"))
 176                      "-"))))
 177              ret)
 178         (princ "Content-Type: text/html; charset=UTF-8
 179
 180 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 181             \"http://www.w3.org/TR/html4/loose.dtd\">
 182 <html lang=\"ja\">
 183 ")
 184         (cond
 185          ((stringp target)
 186           (setq target
 187                 (mapcar (lambda (cell)
 188                           (if (string-match "=" cell)
 189                               (cons
 190                                (intern
 191                                 (decode-uri-string
 192                                  (substring cell 0 (match-beginning 0))
 193                                  'utf-8-mcs-er))
 194                                (substring cell (match-end 0)))
 195                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 196                         (split-string target "&")))
 197           (setq ret (car target))
 198           (cond ((eq (car ret) 'char)
 199                  (www-display-char-desc
 200                   (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 201                   lang)
 202                  )
 203                 ((eq (car ret) 'feature)
 204                  (www-display-feature-desc
 205                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 206                   (cdr (assq 'char target))
 207                   ;; (decode-uri-string (cdr (assq 'char target)))
 208                   lang)
 209                  ))
 210           ))
 211         (princ "\n<hr>\n")
 212         (princ (format "user=%s\n" user))
 213         (princ (format "local user=%s\n" (user-login-name)))
 214         (princ (format "lang=%S\n" lang))
 215         (princ emacs-version)
 216         (princ " CHISE ")
 217         (princ xemacs-chise-version)
 218         (princ "
 219 </body>
 220 </html>")
 221         )
 222     (error nil
 223            (princ (format "%S" err)))
 224     ))
 225
 226 (provide 'cwiki-view)