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