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