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