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