X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fest.git;a=blobdiff_plain;f=cwiki-format.el;h=c11eff46fd4ec934a2d7ebe53a99be7522b07390;hp=4a14786e20bdfe067b77514c6f753fa64d87f76f;hb=HEAD;hpb=8b983ed82a699b043f397aa4fc21a7b52c6b3748

diff --git a/cwiki-format.el b/cwiki-format.el
index 4a14786..c11eff4 100644
--- a/cwiki-format.el
+++ b/cwiki-format.el
@@ -1,185 +1,14 @@
 ;; -*- coding: utf-8-mcs-er -*-
 (require 'cwiki-common)
+(require 'est-eval)
+(require 'est-format)
 (require 'est-xml)
 
-;;; @ 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-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))
-	 (let (genre-o name-f ret)
-	   (lambda (unit)
-	     (if (characterp unit)
-		 (format "<a href=\"%s?char=%s\">%s</a>"
-			 chise-wiki-view-url
-			 (www-uri-encode-object unit)
-			 (www-format-encode-string (char-to-string unit)))
-	       (format "<a href=\"%s?%s=%s\">%s</a>"
-		       chise-wiki-view-url
-		       (concord-object-genre unit)
-		       (concord-object-id unit)
-		       (cond
-			((setq ret
-			       (www-get-feature-value
-				unit
-				(setq name-f
-				      (if (setq genre-o
-						(concord-decode-object
-						 '=id
-						 (concord-object-genre unit)
-						 'genre))
-					  (www-get-feature-value
-					   genre-o
-					   'object-representation-format)
-					'name))))
-			 (www-format-eval-feature-value
-			  unit name-f nil nil nil ret
-			  'without-tags 'without-edit)
-			 )
-                        (t
-			 (www-format-encode-string
-			  (format "%S" unit))
-			 ))
-		       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-object 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)
+  (if (symbolp object)
+      (setq object (concord-decode-object '=id object 'feature)))
   (unless value
     (setq value (www-get-feature-value object feature-name)))
   (www-format-apply-value object feature-name
@@ -187,255 +16,24 @@
 			  without-tags without-edit)
   )
 
-
-;;; @ format evaluator
-;;;
-
-(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-value-as-char-list (value &optional without-tags)
+  (est-format-unit
+   (est-eval-value-as-object-list value " ") without-tags))
 
 (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?%s=%s&feature=%s&format=%s\"
-><input type=\"submit\" value=\"edit\" /></a>"
-	      ret
-	      chise-wiki-edit-url
-	      (est-object-genre object)
-	      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-object 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-object 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-object 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)))))))
+  (est-format-unit
+   (est-eval-apply-value object feature-name format props value uri-object)
+   without-tags without-edit))
 
 (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)))
+  (est-format-unit
+   (est-eval-list format-list object feature-name lang uri-object)
+   without-tags without-edit))
 
 
 ;;; @ End.