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