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