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