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