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     (www-html-display-paragraph
 140      (format "value-format : %s"
 141              (www-xml-format-list
 142               (or (www-feature-value-format feature-name)
 143                   'default))))
 144     (www-html-display-paragraph
 145      (format "format : %s"
 146              (www-xml-format-list
 147               (or (char-feature-property feature-name 'format)
 148                   '((name) " : " (value))))))
 149     (www-html-display-paragraph
 150      (format "description : %s"
 151              (or (char-feature-property feature-name 'description)
 152                  "")))
 153     (when lang
 154       (www-html-display-paragraph
 155        (format "description@%s : %s"
 156                lang
 157                (or (char-feature-property
 158                     feature-name
 159                     (intern (format "description@%s" lang)))
 160                    ""))))
 161     ))
 162
 163 (defun www-batch-view ()
 164   (setq terminal-coding-system 'binary)
 165   (condition-case err
 166       (let* ((target (pop command-line-args-left))
 167              (user (pop command-line-args-left))
 168              (accept-language (pop command-line-args-left))
 169              (lang
 170               (intern
 171                (car (split-string
 172                      (car (split-string
 173                            (car (split-string accept-language ","))
 174                            ";"))
 175                      "-"))))
 176              ret)
 177         (princ "Content-Type: text/html; charset=UTF-8
 178
 179 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 180             \"http://www.w3.org/TR/html4/loose.dtd\">
 181 <html lang=\"ja\">
 182 ")
 183         (cond
 184          ((stringp target)
 185           (setq target
 186                 (mapcar (lambda (cell)
 187                           (if (string-match "=" cell)
 188                               (cons
 189                                (intern
 190                                 (decode-uri-string
 191                                  (substring cell 0 (match-beginning 0))
 192                                  'utf-8-mcs-er))
 193                                (substring cell (match-end 0)))
 194                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 195                         (split-string target "&")))
 196           (setq ret (car target))
 197           (cond ((eq (car ret) 'char)
 198                  (www-display-char-desc
 199                   (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 200                   lang)
 201                  )
 202                 ((eq (car ret) 'feature)
 203                  (www-display-feature-desc
 204                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 205                   (cdr (assq 'char target))
 206                   ;; (decode-uri-string (cdr (assq 'char target)))
 207                   lang)
 208                  ))
 209           ))
 210         (princ "\n<hr>\n")
 211         (princ (format "user=%s\n" user))
 212         (princ (format "local user=%s\n" (user-login-name)))
 213         (princ (format "lang=%S\n" lang))
 214         (princ emacs-version)
 215         (princ " CHISE ")
 216         (princ xemacs-chise-version)
 217         (princ "
 218 </body>
 219 </html>")
 220         )
 221     (error nil
 222            (princ (format "%S" err)))
 223     ))
 224
 225 (provide 'cwiki-view)