;; -*- coding: utf-8-mcs-er -*-
(require 'cwiki-common)
(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)
  (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
;;;

(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?%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)))))))

(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)))


;;; @ End.
;;;

(provide 'cwiki-format)

;;; cwiki-format.el ends here