--- /dev/null
+;; -*- 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 "<a href=\"%s?char=%s\">%s</a>"
+ 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 "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\">"
+ 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 "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\">"
+ 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 "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\">"
+ 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 "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\">"
+ 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 <a href=\"%s?char=%s&feature=%s&format=%s\"
+><input type=\"submit\" value=\"edit\" /></a>"
+ 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 "<a href=\"%s?feature=%s&char=%s\">%s</a>"
+ 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 "<a
+ href=\"%s\"
+>%s</a
+>"
+ (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</%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 "<a href=\"%s\">%s</a>"
+ (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 "<p>")
+ (www-html-display-text text)
+ (princ "</p>\n"))
+
+(provide 'cwiki-common)
--- /dev/null
+;; -*- 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 "<input type=\"text\" name=\"%s\"
+size=\"30\" maxlength=\"30\" value=\"%s\">
+<input type=\"submit\" value=\"set\" />
+
+"
+ (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 "<head>
+<title>CHISE-wiki character: %s</title>
+</head>\n"
+ (www-format-encode-string uri-char 'without-tags)))
+ (princ "<body>\n")
+ (princ
+ (format "<h1>%s</h1>\n"
+ (www-format-encode-string (char-to-string char))))
+ (princ "<form action=\"set.cgi\" method=\"GET\">\n")
+ (princ
+ (encode-coding-string
+ (format "<p>(char : <input type=\"text\" name=\"char\"
+size=\"30\" maxlength=\"30\" value=\"%s\">)</p>
+"
+ 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 "<p><input type=\"text\" name=\"feature-name\"
+size=\"30\" maxlength=\"30\" value=\"%s\">"
+ feature-name))
+ (princ (encode-coding-string " \u2190 " 'utf-8-mcs-er))
+ (princ
+ (format "%s<input type=\"text\" name=\"%s\"
+size=\"30\" maxlength=\"30\" value=\"%s\">
+<input type=\"submit\" value=\"set\" /></p>
+"
+ (if (or (eq format 'HEX)(eq format 'hex))
+ "0x"
+ "")
+ format
+ (www-format-value (cdr cell) feature-name
+ format 'without-tags)))
+ )
+ (t
+ (princ "<p>")
+ (princ
+ (www-format-eval-list
+ (or (char-feature-property (car cell) 'format)
+ '((name) " : " (value)))
+ char (car cell) lang uri-char))
+ (princ "</p>\n")
+ (when (and (eq base-name (car cell)) metadata-name)
+ (princ "<ul>\n")
+ (princ "<li>")
+ (www-edit-display-input-box feature-name
+ (char-feature char feature-name)
+ format)
+ (princ "</li>")
+ (princ "</ul>"))
+ ))
+ )
+ (princ "</form>\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 "<head>
+<title>CHISE-wiki feature: %s</title>
+</head>\n"
+ feature-name)
+ 'utf-8-mcs-er))
+ (princ "<body>\n")
+ (princ "<form action=\"set.cgi\" method=\"GET\">\n")
+ (princ
+ (encode-coding-string
+ (format "<h1>feature : <input type=\"text\" name=\"feature\"
+size=\"30\" maxlength=\"30\" value=\"%s\"></h1>\n"
+ feature-name)
+ 'utf-8-mcs-er))
+ (princ
+ (encode-coding-string
+ (format "<p>(<input type=\"text\" name=\"char\"
+size=\"30\" maxlength=\"30\" value=\"%s\">ăŤé\u5B9AăăŞă)
+"
+ uri-char)
+ 'utf-8-mcs-er))
+ (princ "<p>")
+ (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 "</form>\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
+
+<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+ \"http://www.w3.org/TR/html4/loose.dtd\">
+<html lang=\"ja\">
+")
+ (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<hr>\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 "
+</body>
+</html>")
+ )
+ (error nil
+ (princ (format "%S" err)))
+ ))
--- /dev/null
+;; -*- 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 "<head>
+<title>CHISE-wiki character: %s</title>
+</head>\n"
+ uri-char)
+ 'utf-8-mcs-er))
+ (princ "<body>\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 "<h1>%s</h1>\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 "<p>")
+ (princ
+ (www-format-eval-list
+ (or (char-feature-property (car cell) 'format)
+ '((name) " : " (value)))
+ char (car cell) lang uri-char))
+ (princ
+ (format " <a href=\"%s?char=%s&feature=%s\"
+><input type=\"submit\" value=\"note\" /></a>"
+ 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 "</p>\n")
+ )
+ (princ
+ (format "<p><a href=\"%s?char=%s\"
+><input type=\"submit\" value=\"add feature\" /></a></p>"
+ 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 "<head>
+<title>CHISE-wiki feature: %s</title>
+</head>\n"
+ feature-name)
+ 'utf-8-mcs-er))
+ (princ "<body>\n")
+ (princ
+ (encode-coding-string
+ (format "<h1>%s</h1>\n"
+ feature-name)
+ 'utf-8-mcs-er))
+ (princ
+ (format "<p>name : %s <a href=\"%s?feature=%s&property=name\"
+><input type=\"submit\" value=\"edit\" /></a></p>
+"
+ (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 "<p>%s : %s <a href=\"%s?feature=%s&property=%s\"
+><input type=\"submit\" value=\"edit\" /></a></p>
+"
+ 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 "<hr />")
+ (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
+
+<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+ \"http://www.w3.org/TR/html4/loose.dtd\">
+<html lang=\"ja\">
+")
+ (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<hr>\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 "
+</body>
+</html>")
+ )
+ (error nil
+ (princ (format "%S" err)))
+ ))
--- /dev/null
+;; -*- 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 "<head>
+<title>CHISE-wiki character: %s</title>
+</head>\n"
+ uri-char)
+ 'utf-8-mcs-er))
+ (princ "<body>\n"))
+ (princ (format "<h%d>%s</h%d>\n"
+ level
+ (www-format-encode-string (char-to-string char))
+ level))
+ (if (> level 1)
+ (princ "<ul>"))
+ (dolist (cell (sort (char-attribute-alist char)
+ (lambda (a b)
+ (char-attribute-name< (car a)(car b)))))
+ (princ
+ (if (= level 1)
+ "<p>\n"
+ "<li>\n"))
+ (princ
+ (www-format-eval-list
+ (or (char-feature-property (car cell) 'format)
+ '((name) " : " (value)))
+ char (car cell) lang uri-char))
+ (princ
+ (format " <a href=\"%s?char=%s&feature=%s\"
+><input type=\"submit\" value=\"note\" /></a>"
+ 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
+ (if (= level 1)
+ "</p>\n"
+ "<li>\n"))
+ )
+ (princ
+ (if (= level 1)
+ "<p>\n"
+ "<li>\n"))
+ (princ
+ (format "<a href=\"%s?char=%s\"
+><input type=\"submit\" value=\"add feature\" /></a>
+"
+ chise-wiki-add-url
+ (www-format-encode-string uri-char)))
+ (princ
+ (if (= level 1)
+ "</p>\n"
+ "<li>\n"))
+ )))
+
+(defun www-display-feature-desc (uri-feature-name uri-char &optional lang)
+ (let ((feature-name (www-uri-decode-feature-name uri-feature-name))
+ (name@lang (intern (format "name@%s" lang))))
+ (princ
+ (encode-coding-string
+ (format "<head>
+<title>CHISE-wiki feature: %s</title>
+</head>\n"
+ feature-name)
+ 'utf-8-mcs-er))
+ (princ "<body>\n")
+ (princ
+ (format "<h1>%s</h1>\n"
+ (www-format-encode-string
+ (symbol-name feature-name))))
+ (princ (format "<p>name : %s "
+ (or (www-format-feature-name feature-name) "")))
+ (www-html-display-text
+ (format "[[[edit|%s?feature=%s&property=name&char=%s]]]"
+ ;; (char-feature-property feature-name 'name)
+ chise-wiki-edit-url
+ uri-feature-name ; (www-uri-encode-feature-name feature-name)
+ uri-char))
+ (princ "</p>")
+ (when lang
+ (princ "<p>")
+ (princ
+ (www-format-encode-string
+ (format "%s : %s"
+ name@lang
+ (or (char-feature-property feature-name name@lang) ""))))
+ (www-html-display-text
+ (format " [[[edit|%s?feature=%s&property=%s&char=%s]]]"
+ chise-wiki-edit-url
+ uri-feature-name
+ name@lang
+ uri-char))
+ (princ "</p>"))
+ (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)))
+ ""))))
+ ))
+
+(defun www-batch-view ()
+ (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
+
+<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+ \"http://www.w3.org/TR/html4/loose.dtd\">
+<html lang=\"ja\">
+")
+ (cond
+ ((stringp target)
+ (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-display-char-desc
+ (decode-uri-string (cdr ret) 'utf-8-mcs-er)
+ lang)
+ )
+ ((eq (car ret) 'feature)
+ (www-display-feature-desc
+ (decode-uri-string (cdr ret) 'utf-8-mcs-er)
+ (decode-uri-string (cdr (assq 'char target)))
+ lang)
+ ))
+ ))
+ (princ "\n<hr>\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 "
+</body>
+</html>")
+ )
+ (error nil
+ (princ (format "%S" err)))
+ ))
+
+(provide 'cwiki-view)
projects / chise / est.git / commitdiff