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