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