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