;; -*- coding: utf-8-mcs-er -*- (defvar chise-wiki-view-url "../view.cgi") (defvar chise-wiki-edit-url "edit.cgi") (require 'cwiki-common) (require 'cwiki-view) (defun www-parse-string-default (string) (setq string (decode-uri-string string 'utf-8-mcs-er)) (condition-case nil (let ((ret (mapcar #'read (split-string string " ")))) (if (cdr ret) ret (car ret))) (error nil))) (defun www-parse-string-as-space-separated-char-list (string) (let (dest char) (dolist (unit (split-string string "\\+")) (if (setq char (www-uri-decode-char unit)) (setq dest (cons char dest)))) (nreverse dest))) (defun www-parse-string-as-space-separated-ids (string) (cdar (ids-parse-string (let (char) (mapconcat (lambda (unit) (if (setq char (www-uri-decode-char unit)) (char-to-string char) unit)) (split-string string "\\+") ""))))) (defun www-parse-string-as-ku-ten (string) (if (string-match "^\\([0-9][0-9]?\\)-\\([0-9][0-9]?\\)" string) (let ((ku (string-to-int (match-string 1 string))) (ten (string-to-int (match-string 2 string)))) (if (and (<= 1 ku)(<= ku 94) (<= 1 ten)(<= ten 94)) (+ (lsh (+ ku 32) 8) ten 32))))) (defun www-feature-parse-string (feature-name string &optional format) (unless format (setq format (www-feature-value-format feature-name))) (cond ((eq format 'space-separated-char-list) (www-parse-string-as-space-separated-char-list string)) ((eq format 'space-separated-ids) (www-parse-string-as-space-separated-ids string)) ((eq format 'ku-ten) (www-parse-string-as-ku-ten string)) ((eq format 'decimal) (string-to-number string)) ((or (eq format 'HEX)(eq format 'hex)) (string-to-number string 16)) ((eq format 'string) (decode-uri-string string 'utf-8-mcs-er) ) ((eq format 'S-exp) (if (= (length string) 0) nil (read (decode-uri-string string 'utf-8-mcs-er))) ) (t (www-parse-string-default string) ))) (defun www-set-display-char-desc (uri-char feature value format &optional lang) (when (stringp feature) (setq feature (intern feature))) (when (stringp format) (setq format (intern format))) (let ((char (www-uri-decode-char uri-char)) latest-feature feature-name logical-feature displayed-features) (when (characterp char) (princ (encode-coding-string (format " CHISE-wiki character: %s \n" (decode-uri-string uri-char 'utf-8-mcs-er)) 'utf-8-mcs-er)) (princ "\n") (www-html-display-paragraph (format "char: %S %S %S %S\n" uri-char feature value lang)) (setq value (www-feature-parse-string feature value format)) (www-html-display-paragraph (format "char = %c : %S \u2190 %S" char feature value)) (setq latest-feature (char-feature-name-at-domain feature '$rev=latest)) (if value (if (equal (www-char-feature char feature) value) (www-html-display-paragraph "Feature-value is not changed.") (www-html-display-paragraph (format "New feature-value = %S is different from old value %S" value (www-char-feature char feature))) (put-char-attribute char latest-feature value) (save-char-attribute-table latest-feature) ) (www-html-display-paragraph "New feature-value is nil, so it is ignored (may be syntax error).") ) (princ (format "

%s

\n" (www-format-encode-string (char-to-string char)))) (dolist (cell (sort (char-attribute-alist char) (lambda (a b) (char-attribute-name< (car a)(car b))))) (setq feature-name (symbol-name (car cell))) (setq logical-feature (if (string-match "[@/]\\$rev=latest$" feature-name) (intern (substring feature-name 0 (match-beginning 0))) (car cell))) (unless (memq logical-feature displayed-features) (push logical-feature displayed-features) (princ "

") (princ (www-format-eval-list (or (char-feature-property (car cell) 'format) '((name) " : " (value))) char (car cell) lang uri-char)) (princ (format " " chise-wiki-edit-url (www-format-encode-string uri-char) (www-format-encode-string (www-uri-encode-feature-name (intern (format "%s*note" (car cell))))))) (princ "

\n") )) (princ (format "

" chise-wiki-add-url (www-format-encode-string uri-char))) ))) (defun www-set-display-feature-desc (feature-name property-name value &optional lang uri-char) (www-html-display-paragraph (format "set: feature: %S, property-name: %S, value: %S, lang: %S, char: %S\n" feature-name property-name value lang uri-char)) (put-char-feature-property feature-name property-name value) (let ((name@lang (intern (format "name@%s" lang))) (uri-feature-name (www-uri-encode-feature-name feature-name))) (princ (encode-coding-string (format " CHISE-wiki feature: %s \n" feature-name) 'utf-8-mcs-er)) (princ "\n") (princ (encode-coding-string (format "

%s

\n" feature-name) 'utf-8-mcs-er)) (princ (format "

name : %s

" (or (www-format-feature-name feature-name) "") chise-wiki-edit-url ;; (char-feature-property feature-name 'name) uri-feature-name ; (www-uri-encode-feature-name feature-name) )) (when lang (princ (format "

%s : %s

" name@lang (www-format-encode-string (or (char-feature-property feature-name name@lang) "")) chise-wiki-edit-url uri-feature-name name@lang))) (www-html-display-paragraph (format "type : %s" (or (www-feature-type feature-name) ;; (char-feature-property feature-name 'type) 'generic))) (www-html-display-paragraph (format "description : %s" (or (char-feature-property feature-name 'description) ""))) (when lang (www-html-display-paragraph (format "description@%s : %s" lang (or (char-feature-property feature-name (intern (format "description@%s" lang))) "")))) (princ "
") (www-html-display-paragraph (format "「[[%c|../view.cgi?char=%s]]」に\u623Bる" (www-uri-decode-char uri-char) uri-char)) )) (defun www-batch-set () (setq terminal-coding-system 'binary) (condition-case err (let* ((target (pop command-line-args-left)) (user (pop command-line-args-left)) (accept-language (pop command-line-args-left)) (lang (intern (car (split-string (car (split-string (car (split-string accept-language ",")) ";")) "-")))) ret name val prop) (princ "Content-Type: text/html; charset=UTF-8 ") (setq target (mapcar (lambda (cell) (if (string-match "=" cell) (progn (setq name (substring cell 0 (match-beginning 0)) val (substring cell (match-end 0))) (cons (intern (decode-uri-string name 'utf-8-mcs-er)) val)) (list (decode-uri-string cell 'utf-8-mcs-er)))) (split-string target "&"))) (setq ret (car target)) (cond ((eq (car ret) 'char) (setq prop (nth 2 target)) (www-set-display-char-desc (cdr ret) ; (decode-uri-string (cdr ret) 'utf-8-mcs-er) (intern (decode-uri-string (cdr (assq 'feature-name target)) 'utf-8-mcs-er)) (cdr prop) ; (decode-uri-string (cdr prop) 'utf-8-mcs-er) (car prop) lang) ) ((eq (car ret) 'feature) (setq prop (nth 2 target)) (www-set-display-feature-desc (intern (decode-uri-string (cdr ret) 'utf-8-mcs-er)) (car prop) (decode-uri-string (cdr prop) 'utf-8-mcs-er) lang (cdr (assq 'char target)) ;; (decode-uri-string (cdr (assq 'char target))) ) )) (www-html-display-paragraph (format "%S" target)) (princ "\n
\n") (princ (format "user=%s\n" user)) (princ (format "local user=%s\n" (user-login-name))) (princ (format "lang=%S\n" lang)) (princ emacs-version) (princ " CHISE ") (princ xemacs-chise-version) (princ " ") ) (error nil (princ (format "%S" err))) ))