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