X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-common.el;h=6e7b01467fc646ef38466b2398911986d8daa734;hb=037263b4f76fb61dd7835ef61aa921ebe2a895df;hp=195ec737e96ac9d996fa33774a2b9adfbd730de7;hpb=ef2129bf9a0cd887806a0f01a5e99de254695de9;p=chise%2Fest.git

diff --git a/cwiki-common.el b/cwiki-common.el
index 195ec73..6e7b014 100644
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -3,20 +3,32 @@
 
 (setq file-name-coding-system 'utf-8-mcs-er)
 
-(concord-assign-genre 'creator "/usr/local/var/ruimoku/db")
-(concord-assign-genre 'bibliography "/usr/local/var/ruimoku/db")
-(concord-assign-genre 'era "/usr/local/var/ruimoku/db")
-(concord-assign-genre 'period "/usr/local/var/ruimoku/db")
-(concord-assign-genre 'journal "/usr/local/var/ruimoku/db")
+
+(concord-assign-genre 'creator@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'person-name@ruimoku "/usr/local/var/ruimoku/db")
+
+(concord-assign-genre 'journal-volume@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'article@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'book@ruimoku "/usr/local/var/ruimoku/db")
+
+(concord-assign-genre 'classification@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'region@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'era@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'period@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'journal@ruimoku "/usr/local/var/ruimoku/db")
+
+(mount-char-attribute-table 'instance@ruimoku/bibliography/title)
+;; (mount-char-attribute-table 'instance@ruimoku/bibliography/content*note)
+
 
 (defvar chise-wiki-view-url "view.cgi")
 (defvar chise-wiki-edit-url "edit.cgi")
 
 (defvar chise-wiki-bitmap-glyphs-url
-  "http://chise.zinbun.kyoto-u.ac.jp/glyphs")
+  "http://www.chise.org/glyphs")
 
 (defvar chise-wiki-glyph-cgi-url
-  "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
+  "http://www.chise.org/chisewiki/glyph.cgi")
 
 (defvar chise-wiki-displayed-features nil)
 
@@ -122,6 +134,11 @@
 	(intern (substring feature-name 0 (match-beginning 0)))
       feature)))
 
+(defun est-object-genre (object)
+  (if (characterp object)
+      'character
+    (concord-object-genre object)))
+
 (defun www-get-feature-value (object feature)
   (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
     (cond
@@ -131,8 +148,12 @@
 	  (char-feature object feature))
       )
      (t
-      (or (concord-object-get object latest-feature)
-	  (concord-object-get object feature))
+      (or (condition-case nil
+	      (concord-object-get object latest-feature)
+	    (error nil))
+	  (condition-case nil
+	      (concord-object-get object feature)
+	    (error nil)))
       ))))
 
 (defun get-previous-code-point (ccs code)
@@ -346,9 +367,9 @@
     )
    (t feature-name)))
 
-(defun www-uri-make-feature-name-url (uri-feature-name uri-char)
-  (format "%s?feature=%s&char=%s"
-	  chise-wiki-view-url uri-feature-name uri-char))
+(defun www-uri-make-feature-name-url (uri-genre uri-feature-name uri-object)
+  (format "%s?feature=%s&%s=%s"
+	  chise-wiki-view-url uri-feature-name uri-genre uri-object))
 
 (defun www-uri-decode-object (genre char-rep)
   (let (ccs cpos)
@@ -386,54 +407,63 @@
 	 '=id (car (read-from-string char-rep)) genre)
 	))))))
 
-(defun www-uri-encode-char (char)
-  (if (encode-char char '=ucs)
-      (mapconcat
-       (lambda (byte)
-	 (format "%%%02X" byte))
-       (encode-coding-string (char-to-string char) 'utf-8-mcs-er)
-       "")
-    (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 =>zinbun-oracle
-		      =daikanwa
-		      =gt =gt-k
-		      =>>jis-x0208 =>>jis-x0213-1
-		      =>jis-x0208 =>jis-x0213-1
-		      =>>gt
-		      =ruimoku-v6
-		      =big5
-		      =big5-cdp))
-	  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))
-	    ((and (setq ccs (car (split-char char)))
-		  (setq ret (encode-char char ccs)))
-	     (format "%s:0x%X"
-		     (www-uri-encode-feature-name ccs)
-		     ret))
-	    (t
-	     (format "system-char-id:0x%X"
-		     (encode-char char 'system-char-id))
-	     )))))
+(defun www-uri-encode-object (object)
+  (if (characterp object)
+      (if (encode-char object '=ucs)
+	  (mapconcat
+	   (lambda (byte)
+	     (format "%%%02X" byte))
+	   (encode-coding-string (char-to-string object) 'utf-8-mcs-er)
+	   "")
+	(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 =>zinbun-oracle
+			  =daikanwa
+			  =gt =gt-k
+			  =>>jis-x0208 =>>jis-x0213-1
+			  =>jis-x0208 =>jis-x0213-1
+			  =>>gt
+			  =ruimoku-v6
+			  =big5
+			  =big5-cdp))
+	      ccs ret)
+	  (while (and ccs-list
+		      (setq ccs (pop ccs-list))
+		      (not (setq ret (encode-char object ccs 'defined-only)))))
+	  (cond (ret
+		 (format "%s:0x%X"
+			 (www-uri-encode-feature-name ccs)
+			 ret))
+		((and (setq ccs (car (split-char object)))
+		      (setq ret (encode-char object ccs)))
+		 (format "%s:0x%X"
+			 (www-uri-encode-feature-name ccs)
+			 ret))
+		(t
+		 (format "system-char-id:0x%X"
+			 (encode-char object 'system-char-id))
+		 ))))
+    (format "rep.id:%s" (concord-object-id object))))
 
 (defun est-format-object (object)
   (if (characterp object)
       (char-to-string object)
     (format "%s" (concord-object-id object))))
 
+(defun www-uri-make-object-url (object &optional uri-object)
+  (format "%s?%s=%s"
+	  chise-wiki-view-url
+	  (est-object-genre object)
+	  (or uri-object
+	      (www-uri-encode-object object))))
+
 
 ;;; @ Feature name presentation
 ;;;
@@ -528,172 +558,19 @@
    (www-format-feature-name* feature-name lang)))
 
 
-;;; @ Feature value presentation
+;;; @ HTML generator
 ;;;
 
-(defun www-format-value-as-kuten (value)
-  (format "%02d-%02d"
-	  (- (lsh value -8) 32)
-	  (- (logand value 255) 32)))
-
-(defun www-format-value-default (value &optional without-tags)
-  (if (listp value)
-      (mapconcat
-       (lambda (unit)
-	 (www-format-encode-string
-	  (format "%S" unit)
-	  without-tags))
-       value " ")
-    (www-format-encode-string (format "%S" value) without-tags)))
-  
-(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-domain-list (value &optional without-tags)
-  (let (name source0 source num dest rest unit start end ddest)
-    (if (listp value)
-	(if without-tags
-	    (mapconcat
-	     (lambda (unit)
-	       (format "%s" unit))
-	     value " ")
-	  (setq rest value)
-	  (while rest
-	    (setq unit (pop rest))
-	    (if (symbolp unit)
-		(setq name (symbol-name unit)))
-	    (setq dest
-		  (concat
-		   dest
-		   (cond
-		    ((string-match "^zob1968=" name)
-		     (setq source (intern (substring name 0 (match-end 0)))
-			   num (substring name (match-end 0)))
-		     (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
-			 (setq start (string-to-number
-				      (match-string 1 num))
-			       end (string-to-number
-				    (match-string 2 num)))
-		       (setq start (string-to-number num)
-			     end start))
-		     (setq ddest
-			   (if (eq source source0)
-			       (format
-				", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
-				start start)
-			     (setq source0 source)
-			     (format
-			      " <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/\">%s</a>=<a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
-			      (www-format-encode-string "\u4EAC大人\u6587研甲\u9AA8")
-			      start start)))
-		     (setq start (1+ start))
-		     (while (<= start end)
-		       (setq ddest
-			     (concat
-			      ddest
-			      (format
-			       ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
-			       start start)))
-		       (setq start (1+ start)))
-		     ddest)
-		    (t
-		     (setq source unit)
-		     (if (eq source source0)
-			 ""
-		       (setq source0 source)
-		       (concat " " name))
-		     )))))
-	  dest)
-      (www-format-encode-string (format "%s" value) without-tags))))
-
-(defun www-format-value-as-ids (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)))))
-       (ideographic-structure-to-ids 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-as-kangxi-radical (value)
-  (if (and (integerp value)
-	   (<= 0 value)
-	   (<= value 214))
-      (www-format-encode-string
-       (format "%c" (ideographic-radical value)))
-    (www-format-value-as-S-exp value)))
-
-(defun www-format-value (object feature-name
-				&optional value format
-				without-tags without-edit)
-  (unless value
-    (setq value (www-get-feature-value object feature-name)))
-  (www-format-apply-value object feature-name
-			  format nil value nil nil
-			  without-tags without-edit)
-  )
-
-
-;;; @ format evaluator
-;;;
+(defvar www-format-char-img-style "vertical-align:bottom;")
 
-(defun www-format-encode-string (string &optional without-tags)
+(defun www-format-encode-string (string &optional without-tags as-body)
   (with-temp-buffer
     (insert string)
     (let (plane code start end char variants ret rret)
+      (when as-body
+	(goto-char (point-min))
+	(while (search-forward "&" nil t)
+	  (replace-match "&amp;" nil t)))
       (goto-char (point-min))
       (while (search-forward "<" nil t)
 	(replace-match "&lt;" nil t))
@@ -731,10 +608,12 @@
 	  (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\">"
+	     (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\"
+style=\"%s\">"
 		     code
 		     chise-wiki-bitmap-glyphs-url
-		     (/ code 1000) code)
+		     (/ code 1000) code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
@@ -742,12 +621,14 @@
 	    (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\">"
+	     (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\"
+style=\"%s\">"
 		     plane code
 		     chise-wiki-bitmap-glyphs-url
 		     plane
 		     (- (lsh code -8) 32)
-		     (- (logand code 255) 32))
+		     (- (logand code 255) 32)
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
@@ -755,12 +636,14 @@
 	    (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\">"
+	     (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\"
+style=\"%s\">"
 		     plane code
 		     chise-wiki-bitmap-glyphs-url
 		     plane
 		     (- (lsh code -8) 32)
-		     (- (logand code 255) 32))
+		     (- (logand code 255) 32)
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
@@ -768,10 +651,12 @@
 	    (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\">"
+	     (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\"
+style=\"%s\">"
 		     plane code
 		     chise-wiki-bitmap-glyphs-url
-		     plane code)
+		     plane code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
@@ -786,69 +671,83 @@
 	  (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
 	    (setq code (string-to-int (match-string 2)))
 	    (replace-match
-	     (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\">"
+	     (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\"
+style=\"vertical-align:middle\">"
 		     code
 		     chise-wiki-bitmap-glyphs-url
-		     code)
+		     code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
 	  (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
 	    (setq code (string-to-int (match-string 2)))
 	    (replace-match
-	     (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\">"
+	     (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\"
+style=\"%s\">"
 		     code
 		     chise-wiki-glyph-cgi-url
-		     code)
+		     code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
 	  (while (re-search-forward "&\\(G-\\)?GT-K\\([0-9]+\\);" nil t)
 	    (setq code (string-to-int (match-string 2)))
 	    (replace-match
-	     (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\">"
+	     (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\"
+style=\"%s\">"
 		     code
 		     chise-wiki-glyph-cgi-url
-		     code)
+		     code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
 	  (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
 	    (setq code (string-to-int (match-string 1) 16))
 	    (replace-match
-	     (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\">"
+	     (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\"
+style=\"%s\">"
 		     code
 		     chise-wiki-glyph-cgi-url
-		     code)
+		     code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
 	  (while (re-search-forward "&CDP-\\([0-9A-F]+\\);" nil t)
 	    (setq code (string-to-int (match-string 1) 16))
 	    (replace-match
-	     (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\">"
+	     (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\"
+style=\"%s\">"
 		     code
 		     chise-wiki-glyph-cgi-url
-		     code)
+		     code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
 	  (while (re-search-forward "&RUI6-\\([0-9A-F]+\\);" nil t)
 	    (setq code (string-to-int (match-string 1) 16))
 	    (replace-match
-	     (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\">"
+	     (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\"
+style=\"vertical-align:middle\">"
 		     code
 		     chise-wiki-glyph-cgi-url
-		     code)
+		     code
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
 	  (while (re-search-forward "&\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
 	    (setq code (string-to-int (match-string 2) 16))
 	    (replace-match
-	     (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\">"
+	     (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\"
+style=\"vertical-align:middle\">"
+		     code
 		     code
-		     code)
+		     www-format-char-img-style)
 	     t 'literal))
 
 	  (goto-char (point-min))
@@ -898,321 +797,6 @@
       ;;   (replace-match "&amp;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 "0%d"
-		      (let ((ret (plist-get props :len)))
-			(if (stringp ret)
-			    (string-to-int ret)
-			  ret))))
-	  (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 (object feature-name
-				      format props value
-				      &optional uri-object uri-feature
-				      without-tags without-edit)
-  (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 'wiki-text)
-	    (if without-tags
-		(www-xml-format-list value)
-	      (www-format-eval-list value object feature-name nil uri-object
-				    without-tags without-edit))
-	    )
-	   ((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 'kangxi-radical)
-	    (www-format-value-as-kangxi-radical value))
-	   ((eq format 'space-separated-char-list)
-	    (www-format-value-as-char-list value without-tags))
-	   ((eq format 'space-separated-ids)
-	    (www-format-value-as-ids value without-tags))
-	   ((eq format 'space-separated-domain-list)
-	    (www-format-value-as-domain-list value without-tags))
-	   ((eq format 'string)
-	    (www-format-encode-string (format "%s" value) without-tags)
-	    )
-	   (t
-	    (www-format-value-default value without-tags)
-            ))
-	  )
-    (if (or without-tags
-	    without-edit
-	    (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-object uri-feature format))))
-
-(defun www-format-eval-feature-value (object
-				      feature-name
-				      &optional format lang uri-object value
-				      without-tags without-edit)
-  (unless value
-    (setq value (www-get-feature-value object feature-name)))
-  (unless format
-    (setq format (www-feature-value-format feature-name)))
-  (cond
-   ((symbolp format)
-    (www-format-apply-value
-     object feature-name
-     format nil value
-     uri-object (www-uri-encode-feature-name feature-name)
-     without-tags without-edit)
-    )
-   ((consp format)
-    (cond ((null (cdr format))
-	   (setq format (car format))
-	   (www-format-apply-value
-	    object feature-name
-	    (car format) (nth 1 format) value
-	    uri-object (www-uri-encode-feature-name feature-name)
-	    without-tags without-edit)
-	   )
-	  (t
-	   (www-format-eval-list format object feature-name lang uri-object
-				 without-tags without-edit)
-	   )))))
-
-(defun www-format-eval-unit (exp object feature-name
-				 &optional lang uri-object value
-				 without-tags without-edit)
-  (unless value
-    (setq value (www-get-feature-value object feature-name)))
-  (unless uri-object
-    (setq uri-object (www-uri-encode-char object)))
-  (cond
-   ((stringp exp) (www-format-encode-string exp))
-   ((null exp) "")
-   ((consp exp)
-    (cond
-     ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
-			      S-exp string default))
-      (let ((fn (plist-get (nth 1 exp) :feature))
-	    domain domain-fn ret)
-	(when fn
-	  (when (stringp fn)
-	    (setq fn (intern fn)))
-	  (setq domain (char-feature-name-domain feature-name))
-	  (setq domain-fn (char-feature-name-at-domain fn domain))
-	  (if (setq ret (www-get-feature-value object domain-fn))
-	      (setq feature-name domain-fn
-		    value ret)
-	    (setq feature-name fn
-		  value (www-get-feature-value object fn)))
-	  (push feature-name chise-wiki-displayed-features)
-          ))
-      (if (eq (car exp) 'value)
-	  (www-format-eval-feature-value object feature-name
-					 (plist-get (nth 1 exp) :format)
-					 lang uri-object value
-					 without-tags without-edit)
-	(www-format-apply-value
-	 object feature-name
-	 (car exp) (nth 1 exp) value
-	 uri-object (www-uri-encode-feature-name feature-name)
-	 without-tags without-edit))
-      )
-     ((eq (car exp) 'name)
-      (let ((fn (plist-get (nth 1 exp) :feature))
-	    domain domain-fn)
-	(when fn
-	  (setq domain (char-feature-name-domain feature-name))
-	  (when (stringp fn)
-	    (setq fn (intern fn)))
-	  (setq domain-fn (char-feature-name-at-domain fn domain))
-	  (setq feature-name domain-fn)))
-      (if without-tags
-	  (www-format-feature-name feature-name lang)
-	(format "<a href=\"%s\">%s</a>"
-		(www-uri-make-feature-name-url
-		 (www-uri-encode-feature-name feature-name)
-		 uri-object)
-		(www-format-feature-name feature-name lang))
-        )
-      )
-     ((eq (car exp) 'name-url)
-      (let ((fn (plist-get (nth 1 exp) :feature))
-	    domain domain-fn)
-	(when fn
-	  (setq domain (char-feature-name-domain feature-name))
-	  (when (stringp fn)
-	    (setq fn (intern fn)))
-	  (setq domain-fn (char-feature-name-at-domain fn domain))
-	  (setq feature-name domain-fn)))
-      (www-uri-make-feature-name-url
-       (www-uri-encode-feature-name feature-name)
-       uri-object)
-      )
-     ((eq (car exp) 'domain-name)
-      (let ((domain (char-feature-name-domain feature-name)))
-	(if domain
-	    (format "@%s" domain))))
-     ((eq (car exp) 'prev-char)
-      (if without-tags
-	  ""
-	(let ((prev-char (find-previous-defined-code-point
-			  feature-name value)))
-	  (if prev-char
-	      (format "\n<a href=\"%s?char=%s\">%s</a>"
-		      chise-wiki-view-url
-		      (www-uri-encode-char prev-char)
-                      "<input type=\"submit\" value=\"-\" />"
-		      ;; (www-format-encode-string
-                      ;;  (char-to-string prev-char))
-		      )
-	    "")))
-      )
-     ((eq (car exp) 'next-char)
-      (if without-tags
-	  ""
-	(let ((next-char (find-next-defined-code-point
-			  feature-name value)))
-	  (if next-char
-	      (format "<a href=\"%s?char=%s\">%s</a>"
-		      chise-wiki-view-url
-		      (www-uri-encode-char next-char)
-                      "<input type=\"submit\" value=\"+\" />"
-		      ;; (www-format-encode-string
-                      ;;  (char-to-string next-char))
-		      )
-	    "")))
-      )
-     ((eq (car exp) 'link)
-      (if without-tags
-	  (www-format-eval-list (nthcdr 2 exp)
-				object feature-name lang uri-object
-				without-tags without-edit)
-	(format "<a
- href=\"%s\"
->%s</a
->"
-		(www-format-eval-list (plist-get (nth 1 exp) :ref)
-				      object feature-name lang uri-object
-				      'without-tags 'without-edit)
-		(www-format-eval-list (nthcdr 2 exp)
-				      object feature-name lang uri-object
-				      without-tags without-edit)))
-      )
-     (t
-      (format "<%s
->%s</%s
->"
-	      (car exp)
-	      (www-format-eval-list (nthcdr 2 exp) object feature-name
-				    lang uri-object
-				    without-tags without-edit)
-	      (car exp)))))))
-
-(defun www-format-eval-list (format-list object feature-name
-					 &optional lang uri-object
-					 without-tags without-edit)
-  (if (consp format-list)
-      (mapconcat
-       (lambda (exp)
-	 (www-format-eval-unit exp object feature-name lang uri-object
-			       nil without-tags without-edit))
-       format-list "")
-    (www-format-eval-unit format-list object feature-name lang uri-object
-			  nil without-tags without-edit)))
-
-
-;;; @ XML generator
-;;;
-
-(defun www-xml-format-props (props)
-  (let ((dest "")
-	key val)
-    (while props
-      (setq key (pop props)
-	    val (pop props))
-      (if (symbolp key)
-	  (setq key (symbol-name key)))
-      (if (eq (aref key 0) ?:)
-	  (setq key (substring key 1)))
-      (setq dest
-	    (format "%s %s=\"%s\""
-		    dest key
-		    (www-format-encode-string
-		     (format "%s" val) 'without-tags))))
-    dest))
-
-(defun www-xml-format-unit (format-unit)
-  (let (name props children ret)
-    (cond
-     ((stringp format-unit)
-      (mapconcat (lambda (c)
-		   (cond
-		    ((eq c ?&) "&amp;")
-                    ;; ((eq c ?<) "&amp;lt;")
-                    ;; ((eq c ?>) "&amp;gt;")
-		    (t
-		     (char-to-string c))))
-		 (www-format-encode-string format-unit 'without-tags)
-		 "")
-      )
-     ((consp format-unit)
-      (setq name (car format-unit)
-	    props (nth 1 format-unit)
-	    children (nthcdr 2 format-unit))
-      (when (eq name 'link)
-	(setq ret (plist-get props :ref))
-	(unless (stringp ret)
-	  (setq props (plist-remprop (copy-list props) :ref))
-	  (setq children
-		(cons (list* 'ref nil ret)
-		      children))))
-      (if children
-	  (format "<%s%s>%s</%s>"
-		  name
-		  (if props
-		      (www-xml-format-props props)
-		    "")
-		  (www-xml-format-list children)
-		  name)
-	(format "<%s%s/>"
-		name (www-xml-format-props props)))
-      )
-     (t
-      (format "%s" format-unit)))))
-
-(defun www-xml-format-list (format-list)
-  (if (atom format-list)
-      (www-xml-format-unit format-list)
-    (mapconcat #'www-xml-format-unit
-	       format-list "")))
-
-
-;;; @ HTML generator
-;;;
-
 (defun www-html-display-text (text)
   (princ
    (with-temp-buffer