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