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     (www-html-display-text
 101      (format "[[[edit|%s?feature=%s&property=name&char=%s]]]"
 102              ;; (char-feature-property feature-name 'name)
 103              chise-wiki-edit-url
 104              uri-feature-name ; (www-uri-encode-feature-name feature-name)
 105              uri-char))
 106     (princ "</p>")
 107     (when lang
 108       (princ "<p>")
 109       (princ
 110        (www-format-encode-string
 111         (format "%s : %s"
 112                 name@lang
 113                 (or (char-feature-property feature-name name@lang) ""))))
 114       (www-html-display-text
 115        (format " [[[edit|%s?feature=%s&property=%s&char=%s]]]"
 116                chise-wiki-edit-url
 117                uri-feature-name
 118                name@lang
 119                uri-char))
 120       (princ "</p>"))
 121     (www-html-display-paragraph
 122      (format "type : %s"
 123              (or (www-feature-type feature-name)
 124                  ;; (char-feature-property feature-name 'type)
 125                  'generic)))
 126     (www-html-display-paragraph
 127      (format "value-format : %s"
 128              (www-xml-format-list
 129               (or (www-feature-value-format feature-name)
 130                   'default))))
 131     (www-html-display-paragraph
 132      (format "format : %s"
 133              (www-xml-format-list
 134               (or (char-feature-property feature-name 'format)
 135                   '((name) " : " (value))))))
 136     (www-html-display-paragraph
 137      (format "description : %s"
 138              (or (char-feature-property feature-name 'description)
 139                  "")))
 140     (when lang
 141       (www-html-display-paragraph
 142        (format "description@%s : %s"
 143                lang
 144                (or (char-feature-property
 145                     feature-name
 146                     (intern (format "description@%s" lang)))
 147                    ""))))
 148     ))
 149
 150 (defun www-batch-view ()
 151   (setq terminal-coding-system 'binary)
 152   (condition-case err
 153       (let* ((target (pop command-line-args-left))
 154              (user (pop command-line-args-left))
 155              (accept-language (pop command-line-args-left))
 156              (lang
 157               (intern
 158                (car (split-string
 159                      (car (split-string
 160                            (car (split-string accept-language ","))
 161                            ";"))
 162                      "-"))))
 163              ret)
 164         (princ "Content-Type: text/html; charset=UTF-8
 165
 166 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 167             \"http://www.w3.org/TR/html4/loose.dtd\">
 168 <html lang=\"ja\">
 169 ")
 170         (cond
 171          ((stringp target)
 172           (setq target
 173                 (mapcar (lambda (cell)
 174                           (if (string-match "=" cell)
 175                               (cons
 176                                (intern
 177                                 (decode-uri-string
 178                                  (substring cell 0 (match-beginning 0))
 179                                  'utf-8-mcs-er))
 180                                (substring cell (match-end 0)))
 181                             (list (decode-uri-string cell 'utf-8-mcs-er))))
 182                         (split-string target "&")))
 183           (setq ret (car target))
 184           (cond ((eq (car ret) 'char)
 185                  (www-display-char-desc
 186                   (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 187                   lang)
 188                  )
 189                 ((eq (car ret) 'feature)
 190                  (www-display-feature-desc
 191                   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 192                   (cdr (assq 'char target))
 193                   ;; (decode-uri-string (cdr (assq 'char target)))
 194                   lang)
 195                  ))
 196           ))
 197         (princ "\n<hr>\n")
 198         (princ (format "user=%s\n" user))
 199         (princ (format "local user=%s\n" (user-login-name)))
 200         (princ (format "lang=%S\n" lang))
 201         (princ emacs-version)
 202         (princ " CHISE ")
 203         (princ xemacs-chise-version)
 204         (princ "
 205 </body>
 206 </html>")
 207         )
 208     (error nil
 209            (princ (format "%S" err)))
 210     ))
 211
 212 (provide 'cwiki-view)