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