;; -*- coding: utf-8-mcs-er -*-
(require 'cwiki-format)

(defvar chise-wiki-view-url "view.cgi")
(defvar chise-wiki-edit-url "edit.cgi")
(defvar chise-wiki-add-url "add.cgi")

(defun est-rdf-encode-feature-name (feature-name)
  (let ((str (symbol-name feature-name))
	base domain
	ret is-not-top
	xmlns-prefix xmlns-uri)
    (if (string-match "@" str)
	(setq base (substring str 0 (match-beginning 0))
	      domain (substring str (match-end 0)))
      (setq base str))
    (setq ret (mapconcat (lambda (c)
			   (prog1
			       (cond ((eq c ?*)
				      (if is-not-top
					  ".-."
					"meta."))
				     ((eq c ?/)
				      "...")
				     (t (char-to-string c)))
			     (setq is-not-top t)))
			 base ""))
    (if domain
	(setq xmlns-prefix
	      (or xmlns-prefix
		  (concat "est."
			  (mapconcat #'identity
				     (split-string domain "/")
				     "."))))
      (setq xmlns-prefix (or (char-feature-property
			      feature-name 'rdf-namespace-prefix)
			     'est)
	    xmlns-uri (char-feature-property
		       feature-name 'rdf-namespace-uri)))
    (list xmlns-prefix
	  (or xmlns-uri
	      (format "http://www.chise.org/est/rdf.cgi?domain=%s/"
		      xmlns-prefix))
	  (www-uri-encode-feature-name (intern ret)))))

(defun est-rdf-format-object (obj)
  (if (or (characterp obj)
	  (concord-object-p obj))
      (let ((genre (est-object-genre obj))
	    (url-object (www-uri-encode-object obj)))
	(format "
    <rdf:Description
     rdf:about=\"http://www.chise.org/est/rdf.cgi?%s=%s\">
    </rdf:Description>"
		genre url-object))
    (encode-coding-string (format "
    %s" obj)
			  'utf-8-mcs-er)))

(defun est-rdf-format-object-list (obj-list &optional with-li)
  ;; (concat (mapconcat #'est-rdf-format-object
  ;;                    obj-list
  ;;                    "")
  ;;         "\n")
  (let ((rest obj-list)
	dest obj)
    (while (consp rest)
      (setq obj (pop rest))
      (if with-li
	  (setq dest (concat dest
			     "
    <rdf:li>"
			     (est-rdf-format-object obj)
			     "
    </rdf:li>"))
	(setq dest (concat dest (est-rdf-format-object obj)))))
    (if rest
	(setq dest (concat dest (est-rdf-format-object rest))))
    (concat dest "\n  ")))

(defun est-rdf-display-object-desc (genre uri-object &optional lang level)
  (unless level
    (setq level 0))
  (let ((object (www-uri-decode-object genre uri-object))
	logical-feature chise-wiki-displayed-features
	logical-feature-name
	object-spec logical-object-spec
	rdf-feature-name rdf-feature-name-space
	rdf-feature-name-base rdf-feature-name-domain rdf-feature-name-uri
	feature-type rdf-container
	value ret
	metadata-feature-target metadata-feature-type
	have-matedata)
    (if (eq level 0)
	(setq level 1))
    (when object
      (when (and (eq genre 'character)
		 (= (length uri-object) 1))
	(setq uri-object (www-uri-encode-object object)))
      (when (eq genre 'character)
	(dolist (feature (char-feature-property '$object 'additional-features))
	  (mount-char-attribute-table
	   (char-feature-name-at-domain feature '$rev=latest))))
      (setq object-spec
	    (if (eq genre 'character)
		(char-attribute-alist object)
	      (concord-object-spec object)))
      (dolist (cell (sort object-spec
			  (lambda (a b)
			    (char-attribute-name<
			     (char-feature-name-sans-versions (car a))
			     (char-feature-name-sans-versions (car b))))))
	(setq logical-feature (char-feature-name-sans-versions (car cell)))
	(setq logical-feature-name (symbol-name logical-feature))
	(when (string-match "[^*]\\*[^*]+$" logical-feature-name)
	  (setq metadata-feature-target
		(intern (substring logical-feature-name
				   0 (1+ (match-beginning 0)))))
          (push metadata-feature-target have-matedata))
	(push (cons logical-feature (cdr cell))
	      logical-object-spec)
	)
      (dolist (cell (nreverse logical-object-spec))
        ;; (setq logical-feature (char-feature-name-sans-versions (car cell)))
	(setq logical-feature (car cell))
	(setq logical-feature-name (symbol-name logical-feature))
	(unless (memq logical-feature chise-wiki-displayed-features)
	  (push logical-feature chise-wiki-displayed-features)
	  (setq value (www-get-feature-value object logical-feature))
	  (setq ret (est-rdf-encode-feature-name logical-feature))
	  (setq rdf-feature-name-domain (car ret)
		rdf-feature-name-uri (nth 1 ret)
		rdf-feature-name-base (nth 2 ret))
	  (setq rdf-feature-name (format "%s:%s"
					 rdf-feature-name-domain
					 rdf-feature-name-base))
	  (setq rdf-feature-name-space
		(format "xmlns:%s=\"%s\""
			rdf-feature-name-domain
			rdf-feature-name-uri))
	  (setq feature-type (www-feature-type logical-feature))
	  (if (and (consp value)
		   (cdr value))
	      (cond
	       ((eq feature-type 'structure)
		(setq rdf-container "rdf:Seq")
		)
               ;; ((eq feature-type 'relation)
               ;;  (setq rdf-container "rdf:Bag")
               ;;  )
	       (t
		(setq rdf-container "rdf:Bag")
		))
	    (setq rdf-container nil))
	  (cond
	   ((string-match "[^*]\\*[^*]+$" logical-feature-name)
	    (setq metadata-feature-target
		  (intern (substring logical-feature-name
				     0 (1+ (match-beginning 0)))))
            ;; (setq metadata-feature-type
            ;;       (intern (substring logical-feature-name
            ;;                          (1+ (match-beginning 0)))))
	    (setq metadata-feature-type
		  (intern (substring logical-feature-name
				     (+ (match-beginning 0) 2))))
	    (setq ret (est-rdf-encode-feature-name metadata-feature-target))
	    (princ
	     (format "<rdf:Description
 rdf:about=\"#%s...%s\">\n"
		     (car ret)(nth 2 ret)))
	    (setq ret (est-rdf-encode-feature-name metadata-feature-type))
	    (setq rdf-feature-name-domain (car ret)
		  rdf-feature-name-uri (nth 1 ret)
		  rdf-feature-name-base (nth 2 ret))
	    (setq rdf-feature-name (format "%s:%s"
					 rdf-feature-name-domain
					 rdf-feature-name-base))
	    (setq rdf-feature-name-space
		  (format "xmlns:%s=\"%s\""
			  rdf-feature-name-domain
			  rdf-feature-name-uri))
	    )
	   (t
	    (setq metadata-feature-type nil)
	    (princ
	     (format "<rdf:Description
 rdf:about=\"http://www.chise.org/est/rdf.cgi?%s=%s\">\n"
		     genre uri-object
		     ))
	    ))
	  (princ
	   (cond
	    ((memq logical-feature have-matedata)
	     ;; (setq ret (assq logical-feature feature-metadata-alist))
	     (format "  <%s\n   %s\n   rdf:ID=\"%s...%s\">%s%s%s</%s>\n"
		     rdf-feature-name
		     rdf-feature-name-space
		     rdf-feature-name-domain rdf-feature-name-base
		     (if rdf-container
			 (format "\n  <%s>" rdf-container)
		       "")
		     (est-rdf-format-object-list value rdf-container)
		     (if rdf-container
			 (format "</%s>\n  " rdf-container)
		       "")
		     rdf-feature-name)
	     )
	    (t
	     (format "  <%s\n   %s>%s%s%s</%s>\n"
		     rdf-feature-name
		     rdf-feature-name-space
		     (if rdf-container
			 (format "\n  <%s>" rdf-container)
		       "")
		     (est-rdf-format-object-list value rdf-container)
		     (if rdf-container
			 (format "</%s>\n  " rdf-container)
		       "")
		     rdf-feature-name)
	     )))
	  (princ "</rdf:Description>\n")
	  ))
      )))

(defun est-rdf-display-feature-desc (uri-feature-name genre uri-object
						  &optional lang simple)
  (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>EsT feature: %s</title>
</head>\n"
	      feature-name)
      'utf-8-mcs-er))
    (princ "<body>\n")
    (princ
     (format
      (if simple
	  "<div style=\"text-align:right;\">
<a href=\"edit/view.cgi?feature=%s&%s=%s\">
<input type=\"submit\" value=\"Edit\" />
</a>
<input type=\"submit\" value=\"New Account\" />
</div>
<hr />\n"
	  "<div style=\"text-align:right;\">
<a href=\"../view.cgi?feature=%s&%s=%s\">
<input type=\"submit\" value=\"Simple\" />
</a>
</div>
<hr />\n")
      uri-feature-name genre uri-object))
    (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) "")))
    (unless simple
      (princ
       (format
	" <a href=\"%s?feature=%s&property=name&format=string&%s=%s\">"
	chise-wiki-edit-url
	uri-feature-name
	genre
	uri-object))
      (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
    (princ "</p>\n")
    (when lang
      (princ "<p>")
      (princ
       (www-format-encode-string
	(format "%s : %s"
		name@lang
		(or (char-feature-property feature-name name@lang) ""))))
      (unless simple
	(princ
	 (format
	  " <a href=\"%s?feature=%s&property=%s&format=string&%s=%s\">"
	  chise-wiki-edit-url
	  uri-feature-name
	  name@lang
	  genre
	  uri-object))
	(princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
      (princ "</p>\n"))
    (www-html-display-paragraph
     (format "type : %s"
             (or (www-feature-type feature-name)
		 ;; (char-feature-property feature-name 'type)
		 'generic)))
    (princ (format "<p>value-format : %s "
		   (www-format-value
		    nil 'value-format 
		    (or (www-feature-value-format feature-name)
			'default)
		    'default
		    'without-tags)
		   ))
    (unless simple
      (princ
       (format
	" <a href=\"%s?feature=%s&property=value-format&format=wiki-text&%s=%s\"
>"
	chise-wiki-edit-url
	uri-feature-name
	genre
	uri-object))
      (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
    (princ "</p>\n")

    (princ "<p>format : ")
    (www-html-display-text
     (decode-coding-string
      (www-xml-format-list
       (www-feature-format feature-name))
      'utf-8-mcs-er))
    (unless simple
      (princ
       (format
	" <a href=\"%s?feature=%s&property=format&format=wiki-text&%s=%s\"
>"
	chise-wiki-edit-url
	uri-feature-name
	genre
	uri-object))
      (princ "<input type=\"submit\" value=\"edit\" /></a>\n"))
    (princ "</p>\n")
    
    (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 est-rdf-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))
	     (mode (intern (pop command-line-args-left)))
	     (lang
	      (intern
	       (car (split-string
		     (car (split-string
			   (car (split-string accept-language ","))
			   ";"))
		     "-"))))
	     ret genre)
	(princ "Content-Type: application/xml

<?xml version=\"1.0\" encoding=\"UTF-8\" ?>
<rdf:RDF
  xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
  xmlns:dc=\"http://purl.org/dc/elements/1.1/\">
")
	(cond
	 ((stringp target)
	  (when (string-match "^char=\\(&[^&;]+;\\)" target)
	    (setq ret (match-end 0))
	    (setq target
		  (concat "char="
			  (www-uri-encode-object
			   (www-uri-decode-object
			    'character (match-string 1 target)))
			  (substring target ret))))
	  (setq target
		(mapcar (lambda (cell)
			  (if (string-match "=" cell)
			      (progn
				(setq genre (substring cell 0 (match-beginning 0))
				      ret (substring cell (match-end 0)))
				(cons
				 (intern
				  (decode-uri-string genre 'utf-8-mcs-er))
				 ret))
			    (list (decode-uri-string cell 'utf-8-mcs-er))))
			(split-string target "&")))
	  (setq ret (car target))
	  (cond ((eq (car ret) 'char)
		 (est-rdf-display-object-desc
		  'character
                  (cdr ret)
		  lang nil)
		 )
		((eq (car ret) 'feature)
		 (est-rdf-display-feature-desc
		  (decode-uri-string (cdr ret) 'utf-8-mcs-er)
		  (car (nth 1 target))
		  (cdr (nth 1 target))
		  lang
		  (eq mode 'simple))
		 )
		(t
		 (est-rdf-display-object-desc
		  (car ret)
                  (cdr ret)
		  lang nil)
		 ))
	  ))
        (princ "</rdf:RDF>")
	)
    (error nil
	   (princ (format "%S" err)))
    ))

(provide 'cwiki-view)