From e766809cb9630d7b323d63ca82808b8b03fa3510 Mon Sep 17 00:00:00 2001 From: MORIOKA Tomohiko Date: Mon, 15 Mar 2010 23:51:50 +0900 Subject: [PATCH 1/1] New files. --- cwiki-common.el | 568 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ cwiki-edit.el | 268 ++++++++++++++++++++++++++ cwiki-set.el | 214 +++++++++++++++++++++ cwiki-view.el | 214 +++++++++++++++++++++ 4 files changed, 1264 insertions(+) create mode 100644 cwiki-common.el create mode 100644 cwiki-edit.el create mode 100644 cwiki-set.el create mode 100644 cwiki-view.el diff --git a/cwiki-common.el b/cwiki-common.el new file mode 100644 index 0000000..7089c36 --- /dev/null +++ b/cwiki-common.el @@ -0,0 +1,568 @@ +;; -*- coding: utf-8-mcs-er -*- +(require 'char-db-util) + +(defvar chise-wiki-view-url "view.cgi") +(defvar chise-wiki-edit-url "edit/edit.cgi") + +(defvar chise-wiki-glyphs-url + "http://chise.zinbun.kyoto-u.ac.jp/glyphs/") + +(defun decode-uri-string (string &optional coding-system) + (if (> (length string) 0) + (let ((i 0) + dest) + (setq string + (mapconcat (lambda (char) + (if (eq char ?+) + " " + (char-to-string char))) + string "")) + (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i) + (setq dest (concat dest + (substring string i (match-beginning 0)) + (char-to-string + (int-char + (string-to-int (match-string 1 string) 16)))) + i (match-end 0))) + (decode-coding-string + (concat dest (substring string i)) + coding-system)))) + +(defun www-feature-type (feature-name) + (or (char-feature-property feature-name 'type) + (let ((str (symbol-name feature-name))) + (cond + ((string-match "^\\(->\\|<-\\)" str) + 'relation) + ((string-match "^ideographic-structure\\(@\\|$\\)" str) + 'structure) + )))) + +(defun www-feature-value-format (feature-name) + (or (char-feature-property feature-name 'value-format) + (if (memq (www-feature-type feature-name) + '(relation structure)) + 'space-separated-char-list) + (if (find-charset feature-name) + (if (and (= (charset-dimension feature-name) 2) + (= (charset-chars feature-name) 94)) + '("0x" (HEX) + " (" (decimal) ") <" (ku-ten) ">") + '("0x" (HEX) " (" (decimal) ")"))))) + + +;;; @ URI representation +;;; + +(defun www-uri-decode-feature-name (uri-feature) + (let (feature) + (cond + ((string-match "^from\\." uri-feature) + (intern (format "<-%s" (substring uri-feature (match-end 0)))) + ) + ((string-match "^to\\." uri-feature) + (intern (format "->%s" (substring uri-feature (match-end 0)))) + ) + ((string-match "^rep\\." uri-feature) + (intern (format "=%s" (substring uri-feature (match-end 0)))) + ) + ((string-match "^g\\." uri-feature) + (intern (format "=>>%s" (substring uri-feature (match-end 0)))) + ) + ((string-match "^gi\\." uri-feature) + (intern (format "=>>>%s" (substring uri-feature (match-end 0)))) + ) + ((string-match "^gi\\([0-9]+\\)\\." uri-feature) + (intern (format "=>>%s%s" + (make-string (string-to-int + (match-string 1 uri-feature)) + ?>) + (substring uri-feature (match-end 0)))) + ) + ((string-match "^a\\." uri-feature) + (intern (format "=>%s" (substring uri-feature (match-end 0)))) + ) + ((string-match "^a\\([0-9]+\\)\\." uri-feature) + (intern (format "%s>%s" + (make-string (string-to-int + (match-string 1 uri-feature)) + ?=) + (substring uri-feature (match-end 0)))) + ) + ((and (setq feature (intern (format "=>%s" uri-feature))) + (find-charset feature)) + feature) + ((and (setq feature (intern (format "=>>%s" uri-feature))) + (find-charset feature)) + feature) + ((and (setq feature (intern (format "=>>>%s" uri-feature))) + (find-charset feature)) + feature) + ((and (setq feature (intern (format "=%s" uri-feature))) + (find-charset feature)) + feature) + (t (intern uri-feature))))) + +(defun www-uri-encode-feature-name (feature-name) + (setq feature-name (symbol-name feature-name)) + (cond + ((string-match "^=\\([^=>]+\\)" feature-name) + (concat "rep." (substring feature-name (match-beginning 1))) + ) + ((string-match "^=>>\\([^=>]+\\)" feature-name) + (concat "g." (substring feature-name (match-beginning 1))) + ) + ((string-match "^=>>>\\([^=>]+\\)" feature-name) + (concat "gi." (substring feature-name (match-beginning 1))) + ) + ((string-match "^=>>\\(>+\\)" feature-name) + (format "gi%d.%s" + (length (match-string 1 feature-name)) + (substring feature-name (match-end 1))) + ) + ((string-match "^=>\\([^=>]+\\)" feature-name) + (concat "a." (substring feature-name (match-beginning 1))) + ) + ((string-match "^\\(=+\\)>" feature-name) + (format "a%d.%s" + (length (match-string 1 feature-name)) + (substring feature-name (match-end 0))) + ) + ((string-match "^->" feature-name) + (concat "to." (substring feature-name (match-end 0))) + ) + ((string-match "^<-" feature-name) + (concat "from." (substring feature-name (match-end 0))) + ) + (t feature-name))) + +(defun www-uri-decode-char (char-rep) + (let (ccs cpos) + (cond + ((string-match ":" char-rep) + (setq ccs (substring char-rep 0 (match-beginning 0)) + cpos (substring char-rep (match-end 0))) + (setq ccs (www-uri-decode-feature-name ccs)) + (cond + ((string-match "^0x" cpos) + (setq cpos + (string-to-number (substring cpos (match-end 0)) 16)) + ) + (t + (setq cpos (string-to-number cpos)) + )) + (if (numberp cpos) + (decode-char ccs cpos)) + ) + ((= (length char-rep) 1) + (aref char-rep 0) + )))) + +(defun www-uri-encode-char (char) + (let ((ccs-list '(=ucs + =cns11643-1 =cns11643-2 =cns11643-3 + =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7 + =gb2312 =gb12345 + =jis-x0208 =jis-x0208@1990 + =jis-x0212 + =cbeta =jef-china3 + =jis-x0213-1@2000 =jis-x0213-1@2004 + =jis-x0208@1983 =jis-x0208@1978 + =zinbun-oracle + =daikanwa + =gt =gt-k + =big5 + =big5-cdp + =>>jis-x0208 =>>jis-x0213-1 + =>jis-x0208 =>jis-x0213-1)) + ccs ret) + (while (and ccs-list + (setq ccs (pop ccs-list)) + (not (setq ret (encode-char char ccs 'defined-only))))) + (cond (ret + (format "%s:0x%X" + (www-uri-encode-feature-name ccs) + ret)) + ((setq ccs (car (split-char char))) + (format "%s:0x%X" + (www-uri-encode-feature-name ccs) + (encode-char char ccs)))))) + + +;;; @ Feature name presentation +;;; + +(defun www-format-feature-name-default (feature-name) + (mapconcat + #'capitalize + (split-string + (symbol-name feature-name) + "-") + " ")) + +(defun www-format-feature-name-as-rel-to (feature-name) + (concat "\u2192" (substring (symbol-name feature-name) 2))) + +(defun www-format-feature-name-as-rel-from (feature-name) + (concat "\u2190" (substring (symbol-name feature-name) 2))) + +(defun www-format-feature-name-as-CCS (feature-name) + (let* ((rest + (split-string + (symbol-name feature-name) + "-")) + (dest (upcase (pop rest)))) + (cond + (rest + (while (cdr rest) + (setq dest (concat dest " " (upcase (pop rest))))) + (if (string-match "^[0-9]+$" (car rest)) + (concat dest "-" (car rest)) + (concat dest " " (upcase (car rest)))) + ) + (t dest)))) + +(defun www-format-feature-name (feature-name &optional lang) + (let (name) + (www-format-encode-string + (cond + ((or (and lang + (char-feature-property + feature-name + (intern (format "name@%s" lang)))) + (char-feature-property + feature-name 'name))) + ((find-charset feature-name) + (www-format-feature-name-as-CCS feature-name)) + ((and (setq name (symbol-name feature-name)) + (string-match "^\\(->\\)" name)) + (www-format-feature-name-as-rel-to feature-name)) + ((string-match "^\\(<-\\)" name) + (www-format-feature-name-as-rel-from feature-name)) + (t + (www-format-feature-name-default feature-name)))))) + + +;;; @ Feature value presentation +;;; + +(defun www-format-value-as-kuten (value) + (format "%02d-%02d" + (- (lsh value -8) 32) + (- (logand value 255) 32))) + +(defun www-format-value-as-char-list (value &optional without-tags) + (if (listp value) + (mapconcat + (if without-tags + (lambda (unit) + (www-format-encode-string + (format (if (characterp unit) + "%c" + "%s") + unit) + 'without-tags)) + (lambda (unit) + (if (characterp unit) + (format "%s" + chise-wiki-view-url + (www-uri-encode-char unit) + (www-format-encode-string (char-to-string unit))) + (www-format-encode-string (format "%s" unit))))) + value " ") + (www-format-encode-string (format "%s" value) without-tags))) + +(defun www-format-value-as-S-exp (value &optional without-tags) + (www-format-encode-string (format "%S" value) without-tags)) + +(defun www-format-value-as-HEX (value) + (if (integerp value) + (format "%X" value) + (www-format-value-as-S-exp value))) + +(defun www-format-value-as-CCS-default (value) + (if (integerp value) + (format "0x%s (%d)" + (www-format-value-as-HEX value) + value) + (www-format-value-as-S-exp value))) + +(defun www-format-value-as-CCS-94x94 (value) + (if (integerp value) + (format "0x%s [%s] (%d)" + (www-format-value-as-HEX value) + (www-format-value-as-kuten value) + value) + (www-format-value-as-S-exp value))) + +(defun www-format-value (value &optional feature-name format without-tags) + ;; (cond + ;; ((find-charset feature-name) + ;; (cond + ;; ((and (= (charset-chars feature-name) 94) + ;; (= (charset-dimension feature-name) 2)) + ;; (www-format-value-as-CCS-94x94 value)) + ;; (t + ;; (www-format-value-as-CCS-default value))) + ;; ) + ;; (t + ;; (www-format-value-as-S-exp value))) + (www-format-apply-value format nil value nil nil without-tags) + ) + + +;;; @ format evaluator +;;; + +(defun www-format-encode-string (string &optional without-tags) + (with-temp-buffer + (insert string) + (let (plane code) + (goto-char (point-min)) + (while (search-forward "<" nil t) + (replace-match "<" nil t)) + (goto-char (point-min)) + (while (search-forward ">" nil t) + (replace-match ">" nil t)) + (if without-tags + (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er) + (let ((coded-charset-entity-reference-alist + (list* + '(=cns11643-1 "C1-" 4 X) + '(=cns11643-2 "C2-" 4 X) + '(=cns11643-3 "C3-" 4 X) + '(=cns11643-4 "C4-" 4 X) + '(=cns11643-5 "C5-" 4 X) + '(=cns11643-6 "C6-" 4 X) + '(=cns11643-7 "C7-" 4 X) + '(=gb2312 "G0-" 4 X) + '(=gb12345 "G1-" 4 X) + '(=jis-x0208@1990 "J90-" 4 X) + '(=jis-x0212 "JSP-" 4 X) + '(=cbeta "CB" 5 d) + '(=jef-china3 "JC3-" 4 X) + '(=jis-x0208@1997 "J97-" 4 X) + '(=jis-x0208@1978 "J78-" 4 X) + '(=jis-x0208@1983 "J83-" 4 X) + '(=zinbun-oracle "ZOB-" 4 d) + '(=daikanwa "M-" 5 d) + coded-charset-entity-reference-alist))) + (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er) + + (goto-char (point-min)) + (while (re-search-forward "&CB\\([0-9]+\\);" nil t) + (setq code (string-to-int (match-string 1))) + (replace-match + (format "\"CB%05d\"" + code + chise-wiki-glyphs-url + (/ code 1000) code) + t 'literal)) + + (goto-char (point-min)) + (while (re-search-forward "&J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) + (setq plane (match-string 1) + code (string-to-int (match-string 2) 16)) + (replace-match + (format "\"J%s-%04X\"" + plane code + chise-wiki-glyphs-url + plane + (- (lsh code -8) 32) + (- (logand code 255) 32)) + t 'literal)) + + (goto-char (point-min)) + (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) + (setq plane (string-to-int (match-string 1)) + code (string-to-int (match-string 2) 16)) + (replace-match + (format "\"GB%d-%04X\"" + plane code + chise-wiki-glyphs-url + plane + (- (lsh code -8) 32) + (- (logand code 255) 32)) + t 'literal)) + + (goto-char (point-min)) + (while (re-search-forward "&C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t) + (setq plane (string-to-int (match-string 1)) + code (string-to-int (match-string 2) 16)) + (replace-match + (format "\"CNS%d-%04X\"" + plane code + chise-wiki-glyphs-url + plane code) + t 'literal)) + )) + (goto-char (point-min)) + (while (search-forward ">-" nil t) + (replace-match "&GT-" t 'literal)) + + (buffer-string)))) + +(defun www-format-props-to-string (props &optional format) + (unless format + (setq format (plist-get props :format))) + (concat "%" + (plist-get props :flag) + (if (plist-get props :zero-padding) + "0") + (if (plist-get props :len) + (format "%d" (plist-get props :len))) + (cond + ((eq format 'decimal) "d") + ((eq format 'hex) "x") + ((eq format 'HEX) "X") + ((eq format 'S-exp) "S") + (t "s")))) + +(defun www-format-apply-value (format props value + &optional uri-char uri-feature + without-tags) + (let (ret) + (setq ret + (cond + ((memq format '(decimal hex HEX)) + (if (integerp value) + (format (www-format-props-to-string props format) + value) + (www-format-encode-string + (format "%s" value) + without-tags)) + ) + ((eq format 'S-exp) + (www-format-encode-string + (format (www-format-props-to-string props format) + value) + without-tags)) + ((eq format 'ku-ten) + (www-format-value-as-kuten value)) + ((eq format 'space-separated-char-list) + (www-format-value-as-char-list value without-tags)) + (t + (setq format 'default) + (www-format-encode-string + (format (www-format-props-to-string props 'default) + value) + without-tags)))) + (if (or without-tags (eq (plist-get props :mode) 'peek)) + ret + (format "%s " + ret + chise-wiki-edit-url + uri-char uri-feature format)))) + +(defun www-format-eval-feature-value (char + feature-name + &optional format lang uri-char value) + (unless value + (setq value (char-feature char feature-name))) + (unless format + (setq format (www-feature-value-format feature-name))) + (cond + ((symbolp format) + (www-format-apply-value + format nil value + uri-char (www-uri-encode-feature-name feature-name)) + ) + ((consp format) + (cond ((null (cdr format)) + (setq format (car format)) + (www-format-apply-value + (car format) (nth 1 format) value + uri-char (www-uri-encode-feature-name feature-name)) + ) + (t + (www-format-eval-list format char feature-name lang uri-char) + ))))) + +(defun www-format-eval-unit (exp char feature-name + &optional lang uri-char value) + (unless value + (setq value (char-feature char feature-name))) + (unless uri-char + (setq uri-char (www-uri-encode-char char))) + (cond + ((stringp exp) (www-format-encode-string exp)) + ((null exp) "") + ((consp exp) + (cond + ((memq (car exp) '(value decimal hex HEX ku-ten S-exp default)) + (if (eq (car exp) 'value) + (www-format-eval-feature-value char feature-name + (plist-get (nth 1 exp) :format) + lang uri-char value) + (www-format-apply-value + (car exp) (nth 1 exp) value + uri-char (www-uri-encode-feature-name feature-name))) + ) + ((eq (car exp) 'name) + (format "%s" + chise-wiki-view-url + (www-uri-encode-feature-name feature-name) + uri-char + (www-format-feature-name feature-name lang)) + ) + ((eq (car exp) 'link) + (format "%s" + (www-format-eval-list (plist-get (nth 1 exp) :ref) + char feature-name lang uri-char) + (www-format-eval-list (nthcdr 2 exp) + char feature-name lang uri-char))) + (t + (format "<%s +>%s" + (car exp) + (www-format-eval-list (nthcdr 2 exp) char feature-name + lang uri-char) + (car exp))))))) + +(defun www-format-eval-list (format-list char feature-name + &optional lang uri-char) + (if (consp format-list) + (mapconcat + (lambda (exp) + (www-format-eval-unit exp char feature-name lang uri-char)) + format-list "") + (www-format-eval-unit format-list char feature-name lang uri-char))) + + +;;; @ HTML generator +;;; + +(defun www-html-display-text (text) + (princ + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (search-forward "<" nil t) + (replace-match "<" nil t)) + (goto-char (point-min)) + (while (search-forward ">" nil t) + (replace-match ">" nil t)) + (goto-char (point-min)) + (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t) + (replace-match + (format "%s" + (match-string 2) + (match-string 1)) + nil t)) + (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er) + (goto-char (point-min)) + (while (search-forward "&" nil t) + (replace-match "&" nil t)) + (buffer-string)))) + +(defun www-html-display-paragraph (text) + (princ "

") + (www-html-display-text text) + (princ "

\n")) + +(provide 'cwiki-common) diff --git a/cwiki-edit.el b/cwiki-edit.el new file mode 100644 index 0000000..7ceb3ed --- /dev/null +++ b/cwiki-edit.el @@ -0,0 +1,268 @@ +;; -*- coding: utf-8-mcs-er -*- +(defvar chise-wiki-view-url "../view.cgi") +(defvar chise-wiki-edit-url "edit.cgi") + +(require 'cwiki-common) + +(defun www-edit-display-char-feature-default (char feature-name &optional value + lang) + (unless value + (setq value (char-feature char feature-name))) + (www-html-display-paragraph + (format "[[%s|%s?feature=%s]] : %s [[[edit|edit.cgi?char=%s&feature=%s]]]" + (www-format-feature-name feature-name lang) + chise-wiki-view-url + (www-uri-encode-feature-name feature-name) + (www-format-value value feature-name nil 'without-tags) + (char-to-string char) + (www-uri-encode-feature-name feature-name) + ))) + +(defun www-edit-display-char-feature-as-ucs (char feature-name &optional value) + (unless value + (setq value (char-feature char feature-name))) + (www-html-display-paragraph + (format "= [[U+%s|http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%s]] (%d)" + (www-format-value-as-HEX value) + (www-format-value-as-HEX value) + value))) + +(defun www-edit-display-input-box (name value &optional format) + (when (stringp format) + (setq format (intern format))) + (let (prefix) + (if (or (eq format 'HEX) + (eq format 'hex)) + (if (integerp value) + (setq prefix "0x"))) + (princ (www-format-encode-string + (format "%s \u2190 %s" + name + (or prefix "")))) + (princ + (format " + + +" + (www-format-encode-string + (format "%s" name) 'without-tags) + (www-format-apply-value format nil value + nil nil + 'without-tags) + )))) + +(defun www-edit-display-char-desc (uri-char uri-feature-name + &optional lang format) + (when (stringp format) + (setq format (intern format))) + (let ((char (www-uri-decode-char uri-char)) + (feature-name (www-uri-decode-feature-name uri-feature-name)) + base-name metadata-name + char-spec str) + (when (characterp char) + (princ + (format " +CHISE-wiki character: %s +\n" + (www-format-encode-string uri-char 'without-tags))) + (princ "\n") + (princ + (format "

%s

\n" + (www-format-encode-string (char-to-string char)))) + (princ "
\n") + (princ + (encode-coding-string + (format "

(char : )

+" + uri-char) + 'utf-8-mcs-er)) + (setq char-spec (char-attribute-alist char)) + (if (string-match "\\*" (setq str (symbol-name feature-name))) + (setq base-name (intern (substring str 0 (match-beginning 0))) + metadata-name (intern (substring str (match-end 0)))) + (setq base-name feature-name)) + (unless (assq base-name char-spec) + (setq char-spec (cons (cons base-name nil) + char-spec))) + (dolist (cell (sort char-spec + (lambda (a b) + (char-attribute-name< (car a)(car b))))) + (cond + ((eq (car cell) feature-name) + ;; (www-edit-display-input-box feature-name (cdr cell) format) + (princ + (format "

" + feature-name)) + (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er)) + (princ + (format "%s +

+" + (if (or (eq format 'HEX)(eq format 'hex)) + "0x" + "") + format + (www-format-value (cdr cell) feature-name + format 'without-tags))) + ) + (t + (princ "

") + (princ + (www-format-eval-list + (or (char-feature-property (car cell) 'format) + '((name) " : " (value))) + char (car cell) lang uri-char)) + (princ "

\n") + (when (and (eq base-name (car cell)) metadata-name) + (princ "")) + )) + ) + (princ "
\n") + ))) + +(defun www-edit-display-feature-desc (uri-feature-name + uri-property-name + &optional lang uri-char) + (let ((feature-name (www-uri-decode-feature-name uri-feature-name)) + (property-name (www-uri-decode-feature-name uri-property-name)) + name@lang) + (princ + (encode-coding-string + (format " +CHISE-wiki feature: %s +\n" + feature-name) + 'utf-8-mcs-er)) + (princ "\n") + (princ "
\n") + (princ + (encode-coding-string + (format "

feature :

\n" + feature-name) + 'utf-8-mcs-er)) + (princ + (encode-coding-string + (format "

(に限\u5B9Aしない) +" + uri-char) + 'utf-8-mcs-er)) + (princ "

") + (if (eq property-name 'name) + (www-edit-display-input-box + property-name + (or (www-format-feature-name feature-name) "")) + (www-html-display-paragraph + (format "name : %s [[[edit|edit.cgi?feature=%s&property=name]]]" + (or (www-format-feature-name feature-name) "") + ;; (char-feature-property feature-name 'name) + uri-feature-name ; (www-uri-encode-feature-name feature-name) + ))) + (when lang + (setq name@lang (intern (format "name@%s" lang))) + (if (eq property-name name@lang) + (www-edit-display-input-box + name@lang + (or (char-feature-property feature-name name@lang) "")) + (www-html-display-paragraph + (format "%s : %s [[[edit|edit.cgi?feature=%s&property=%s]]]" + name@lang + (or (char-feature-property feature-name name@lang) "") + 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 "

\n") + )) + +(defun www-batch-edit () + (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) + (princ "Content-Type: text/html; charset=UTF-8 + + + +") + (setq target + (mapcar (lambda (cell) + (if (string-match "=" cell) + (cons + (intern + (decode-uri-string + (substring cell 0 (match-beginning 0)) + 'utf-8-mcs-er)) + (substring cell (match-end 0))) + (list (decode-uri-string cell 'utf-8-mcs-er)))) + (split-string target "&"))) + (setq ret (car target)) + (cond ((eq (car ret) 'char) + (www-edit-display-char-desc + (decode-uri-string (cdr ret) 'utf-8-mcs-er) + (decode-uri-string (cdr (assq 'feature target)) + 'utf-8-mcs-er) + lang + (decode-uri-string (cdr (assq 'format target)) + 'utf-8-mcs-er)) + ) + ((eq (car ret) 'feature) + (www-edit-display-feature-desc + (decode-uri-string (cdr ret) 'utf-8-mcs-er) + (decode-uri-string (cdr (assq 'property target)) + 'utf-8-mcs-er) + lang + (decode-uri-string (cdr (assq 'char target)) + 'utf-8-mcs-er)) + )) + (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))) + )) diff --git a/cwiki-set.el b/cwiki-set.el new file mode 100644 index 0000000..fc0b541 --- /dev/null +++ b/cwiki-set.el @@ -0,0 +1,214 @@ +;; -*- 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-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-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 'decimal) + (string-to-number string)) + ((or (eq format 'HEX)(eq format 'hex)) + (string-to-number string 16)) + ((eq format 'S-exp) + (if (= (length string) 0) + nil + (read string))) + (t 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))) + (when (characterp char) + (princ + (encode-coding-string + (format " +CHISE-wiki character: %s +\n" + uri-char) + '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" char)) + (www-html-display-paragraph + (format "feature-name = %S" feature)) + (www-html-display-paragraph + (format "feature-value = %S" value)) + (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))))) + (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\n" + feature-name property-name value lang)) + (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 + (or (www-format-encode-string + (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 + (decode-uri-string (cdr ret) 'utf-8-mcs-er) + (cdr (assq 'feature-name target)) + (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 + (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))) + )) diff --git a/cwiki-view.el b/cwiki-view.el new file mode 100644 index 0000000..2f7721e --- /dev/null +++ b/cwiki-view.el @@ -0,0 +1,214 @@ +;; -*- coding: utf-8-mcs-er -*- +(require 'cwiki-common) + +(defvar chise-wiki-view-url "view.cgi") +(defvar chise-wiki-edit-url "edit/edit.cgi") +(defvar chise-wiki-add-url "edit/add.cgi") + +(defun www-char-display-feature-default (char feature-name &optional value + lang uri-char) + (unless value + (setq value (char-feature char feature-name))) + (unless uri-char + (setq uri-char (char-to-string char))) + (www-html-display-paragraph + (format "[[%s|%?feature=%s&char=%s]] : %s [[[edit|%s?char=%s&feature=%s]]]" + (www-format-feature-name feature-name lang) + chise-wiki-view-url + (www-uri-encode-feature-name feature-name) + uri-char + (www-format-value value feature-name) + chise-wiki-edit-url + uri-char + (www-uri-encode-feature-name feature-name) + ))) + +(defun www-char-display-feature-as-ucs (char feature-name &optional value) + (unless value + (setq value (char-feature char feature-name))) + (www-html-display-paragraph + (format "= [[U+%s|http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%s]] (%d)" + (www-format-value-as-HEX value) + (www-format-value-as-HEX value) + value))) + +(defun www-display-char-desc (uri-char &optional lang level) + (unless level + (setq level 1)) + (let ((char (www-uri-decode-char uri-char))) + (when (characterp char) + (when (= level 1) + (princ + (encode-coding-string + (format " +CHISE-wiki character: %s +\n" + uri-char) + 'utf-8-mcs-er)) + (princ "\n")) + (princ (format "%s\n" + level + (www-format-encode-string (char-to-string char)) + level)) + (if (> level 1) + (princ "