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