cwiki-add.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-add-display-feature-input-box (char &optional format)
   8   (unless format
   9     (setq format 'default))
  10   (princ
  11    "<p><input type=\"text\" name=\"feature-name\"
  12 size=\"32\" maxlength=\"256\" value=\"\">")
  13   (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
  14   (princ
  15    (format "%s<input type=\"text\" name=\"%s\"
  16 size=\"64\" maxlength=\"256\" value=\"\">
  17 <input type=\"submit\" value=\"set\" /></p>
  18 "
  19            (if (or (eq format 'HEX)(eq format 'hex))
  20                "0x"
  21              "")
  22            format))
  23   )
  24
  25 (defun www-add-display-char-desc (uri-char &optional lang format)
  26   (when (stringp format)
  27     (setq format (intern format)))
  28   (let ((char (www-uri-decode-object 'character uri-char))
  29         char-spec)
  30     (when (characterp char)
  31       (princ
  32        (format "<head>
  33 <title>CHISE-wiki character: %s</title>
  34 </head>\n"
  35                (encode-coding-string
  36                 (decode-uri-string uri-char 'utf-8-mcs-er)
  37                 'utf-8-mcs-er)))
  38       (princ "<body>\n")
  39       (princ
  40        (format "<h1>%s</h1>\n"
  41                (www-format-encode-string (char-to-string char))))
  42       (princ "<form action=\"set.cgi\" method=\"GET\">\n")
  43       (princ
  44        (encode-coding-string
  45         (format "<p>(char : <input type=\"text\" name=\"char\"
  46 size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
  47 "
  48                 (decode-uri-string uri-char 'utf-8-mcs-er))
  49         'utf-8-mcs-er))
  50       (www-add-display-feature-input-box char format)
  51       (setq char-spec (char-attribute-alist char))
  52       (dolist (cell (sort char-spec
  53                           (lambda (a b)
  54                             (char-attribute-name< (car a)(car b)))))
  55         (princ "<p>")
  56         (princ
  57          (www-format-eval-list
  58           (or (char-feature-property (car cell) 'format)
  59               '((name) " : " (value)))
  60           char (car cell) lang uri-char))
  61         (princ "</p>\n"))
  62       (princ "</form>\n")
  63       )))
  64
  65 (defun www-batch-add ()
  66   (setq terminal-coding-system 'binary)
  67   (condition-case err
  68       (let* ((target (pop command-line-args-left))
  69              (user (pop command-line-args-left))
  70              (accept-language (pop command-line-args-left))
  71              (lang
  72               (intern (car (split-string
  73                             (car (split-string
  74                                   (car (split-string accept-language ","))
  75                                   ";"))
  76                             "-"))))
  77              ret)
  78         (princ "Content-Type: text/html; charset=UTF-8
  79
  80 <!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
  81             \"http://www.w3.org/TR/html4/loose.dtd\">
  82 <html lang=\"ja\">
  83 ")
  84         (setq target
  85               (mapcar (lambda (cell)
  86                         (if (string-match "=" cell)
  87                             (cons
  88                              (intern
  89                               (decode-uri-string
  90                                (substring cell 0 (match-beginning 0))
  91                                'utf-8-mcs-er))
  92                              (substring cell (match-end 0)))
  93                           (list (decode-uri-string cell 'utf-8-mcs-er))))
  94                       (split-string target "&")))
  95         (setq ret (car target))
  96         (cond ((eq (car ret) 'char)
  97                (www-add-display-char-desc
  98                 (cdr ret)
  99                 lang
 100                 (decode-uri-string (cdr (assq 'format target))
 101                                    'utf-8-mcs-er))
 102                )
 103               ;; ((eq (car ret) 'feature)
 104               ;;  (www-add-display-feature-desc
 105               ;;   (decode-uri-string (cdr ret) 'utf-8-mcs-er)
 106               ;;   (decode-uri-string (cdr (assq 'property target))
 107               ;;                      'utf-8-mcs-er)
 108               ;;   lang
 109               ;;   (cdr (assq 'char target))
 110               ;;   ;; (decode-uri-string (cdr (assq 'char target))
 111               ;;   ;;                    'utf-8-mcs-er)
 112               ;;   ))
 113               )
 114         (www-html-display-paragraph
 115          (format "%S" target))
 116         (princ "\n<hr>\n")
 117         (princ (format "user=%s\n" user))
 118         (princ (format "local user=%s\n" (user-login-name)))
 119         (princ (format "lang=%S\n" lang))
 120         (princ emacs-version)
 121         (princ " CHISE ")
 122         (princ (encode-coding-string xemacs-chise-version 'utf-8-jp-er))
 123         (princ "
 124 </body>
 125 </html>")
 126         )
 127     (error nil
 128            (princ (format "%S" err)))
 129     ))