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 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 (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 (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-feature-input-box (char feature-name
  56                                                 &optional format)
  57   (unless format
  58     (setq format 'default))
  59   (princ
  60    (format "<p><input type=\"text\" name=\"feature-name\"
  61 size=\"30\" maxlength=\"30\" value=\"%s\">"
  62            feature-name))
  63   (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
  64   (princ
  65    (format "%s<input type=\"text\" name=\"%s\"
  66 size=\"30\" maxlength=\"30\" value=\"%s\">
  67 <input type=\"submit\" value=\"set\" /></p>
  68 "
  69            (if (or (eq format 'HEX)(eq format 'hex))
  70                "0x"
  71              "")
  72            format
  73            (www-format-value (www-char-feature char feature-name)
  74                              feature-name
  75                              format 'without-tags)))
  76   )
  77
  78 (defun www-edit-display-char-desc (uri-char uri-feature-name
  79                                             &optional lang format)
  80   (when (stringp format)
  81     (setq format (intern format)))
  82   (let ((char (www-uri-decode-char uri-char))
  83         (feature-name (www-uri-decode-feature-name uri-feature-name))
  84         base-name metadata-name
  85         char-spec str)
  86     (when (characterp char)
  87       (princ
  88        (format "<head>
  89 <title>CHISE-wiki character: %s</title>
  90 </head>\n"
  91                (encode-coding-string
  92                 (decode-uri-string uri-char 'utf-8-mcs-er)
  93                 'utf-8-mcs-er)))
  94       (princ "<body>\n")
  95       (princ
  96        (format "<h1>%s</h1>\n"
  97                (www-format-encode-string (char-to-string char))))
  98       (princ "<form action=\"set.cgi\" method=\"GET\">\n")
  99       (princ
 100        (encode-coding-string
 101         (format "<p>(char : <input type=\"text\" name=\"char\"
 102 size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
 103 "
 104                 (decode-uri-string uri-char 'utf-8-mcs-er))
 105         'utf-8-mcs-er))
 106       (setq char-spec (char-attribute-alist char))
 107       (if (string-match "\\*" (setq str (symbol-name feature-name)))
 108           (setq base-name (intern (substring str 0 (match-beginning 0)))
 109                 metadata-name (intern (substring str (match-end 0))))
 110         (setq base-name feature-name))
 111       (unless (assq base-name char-spec)
 112         (setq char-spec (cons (cons base-name nil)
 113                               char-spec)))
 114       (dolist (cell (sort char-spec
 115                           (lambda (a b)
 116                             (char-attribute-name< (car a)(car b)))))
 117         (cond
 118          ((eq (car cell) feature-name)
 119           (www-edit-display-feature-input-box char feature-name format)
 120           )
 121          (t
 122           (princ "<p>")
 123           (princ
 124            (www-format-eval-list
 125             (or (char-feature-property (car cell) 'format)
 126                 '((name) " : " (value)))
 127             char (car cell) lang uri-char))
 128           (princ "</p>\n")
 129           (when (and (eq base-name (car cell)) metadata-name)
 130             (princ "<ul>\n")
 131             (princ "<li>")
 132             ;; (www-edit-display-input-box feature-name
 133             ;;                             (www-char-feature char feature-name)
 134             ;;                             format)
 135             (www-edit-display-feature-input-box char feature-name format)
 136             (princ "</li>")
 137             (princ "</ul>"))
 138           ))
 139         )
 140       (princ "</form>\n")
 141       )))
 142
 143 (defun www-edit-display-feature-desc (uri-feature-name
 144                                       uri-property-name
 145                                       &optional lang uri-char)
 146   (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
 147         (property-name (www-uri-decode-feature-name uri-property-name))
 148         name@lang)
 149     (princ
 150      (encode-coding-string
 151       (format "<head>
 152 <title>CHISE-wiki feature: %s</title>
 153 </head>\n"
 154               feature-name)
 155       'utf-8-mcs-er))
 156     (princ "<body>\n")
 157     (princ "<form action=\"set.cgi\" method=\"GET\">\n")
 158     (princ
 159      (encode-coding-string
 160       (format "<h1>feature : <input type=\"text\" name=\"feature\"
 161 size=\"30\" maxlength=\"30\" value=\"%s\"></h1>\n"
 162               feature-name)
 163       'utf-8-mcs-er))
 164     (princ
 165      (encode-coding-string
 166       (format "<p>(<input type=\"text\" name=\"char\"
 167 size=\"30\" maxlength=\"30\" value=\"%s\">に限\u5B9Aしない)
 168 "
 169               (decode-uri-string uri-char 'utf-8-mcs-er))
 170       'utf-8-mcs-er))
 171     (princ "<p>")
 172     (if (eq property-name 'name)
 173         (www-edit-display-input-box
 174          property-name
 175          (or (www-format-feature-name* feature-name) ""))
 176       (www-html-display-paragraph
 177        (format "name : %s [[[edit|edit.cgi?feature=%s&property=name]]]"
 178                (or (www-format-feature-name* feature-name) "")
 179                ;; (char-feature-property feature-name 'name)
 180                uri-feature-name ; (www-uri-encode-feature-name feature-name)
 181                )))
 182     (when lang
 183       (setq name@lang (intern (format "name@%s" lang)))
 184       (if (eq property-name name@lang)
 185           (www-edit-display-input-box
 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     ))