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