cwiki-set.el

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