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