;;;   -*- Mode: LISP; Package: CGP; BASE: 10; Syntax: ANSI-Common-Lisp; Readtable: augmented-readtable -*-
;;
;; Copyright (C) Paul Meurer 2000 - 2004. All rights reserved.
;; paul.meurer@aksis.uib.no
;; Aksis, University of Bergen
;;

(in-package :cgp)

;;-------------------------------------------------------------------------------------
;; TO DO:
;;
;;-------------------------------------------------------------------------------------

;; *analyser-version* :new

(defmethod ranked-analyses-xml ((cg constraint-grammar) word &key (stream *standard-output*))
  (let* ((*tagger* (multi-tagger cg))
	 (morph:*analyser-lexicon* (compound-analyser (print *tagger*))))
    #m(compound
       #+old
       #L(morph::with-compound-analyser (analyser)
	   (when word (morph::%analyse-compound analyser word))
	   (with-slots (morph::analysis-tree morph::ranking) analyser
	     (setf morph::ranking (morph::rank-analyses analyser))
	     #m((ranking :type "old" :compound #S (or word ""))
		#L(when word
		    (dotimes (i (length morph::ranking))
		      #m((analysis :id #S i)
			 #L(dolist (chunk-info (morph::nth-analysis-codes
						(morph::ranking-info-position (aref morph::ranking i))
						morph::analysis-tree))
			     (destructuring-bind (chunk codes . analyses) chunk-info
			       #m((chunk :string #s chunk)
				  #L(dolist (lemma+features analyses)
				      (destructuring-bind (lemma . features) lemma+features
					#m((lemma :features
						  #s(reduce (lambda (x y)
							      (concat (string-downcase x) " " (string-downcase y)))
							    features
							    :initial-value ""))
					   #s lemma))))))))))))
       #+new
       #L(let ((*analyser-version* :new))
	   (morph::with-compound-analyser (analyser)
	     (when word (morph::%analyse-compound analyser word))
	     (with-slots (morph::analysis-tree morph::ranking) analyser
	       (setf morph::ranking (morph::rank-analyses analyser))
	       #m((ranking :type "new" :compound #S (or word ""))
		  #L(when word
		      (dotimes (i (length morph::ranking))
			#m((analysis :id #S i)
			   #L(dolist (chunk-info (morph::nth-analysis-codes
						  (morph::ranking-info-position (aref morph::ranking i))
						  morph::analysis-tree))
			       (print (cons :chunk-info chunk-info))
			       (destructuring-bind (chunk codes . analyses) chunk-info
				 #m((chunk :string #s chunk)
				    #L(dolist (lemma+features analyses)
					(destructuring-bind (lemma . features) lemma+features
					  (setf features (car features))
					  #m((lemma :features
						    #s(reduce (lambda (x y)
								(concat (string-downcase x) " " (string-downcase y)))
							      (if (symbolp features)
								  (list features)
								(code-features features))
							      :initial-value ""))
					     #s lemma)))))))))))))
       #L(let ((*analyser-version* :regexp))
	   (morph::with-compound-analyser (analyser)
	     (when word (morph::%analyse-compound analyser word))
	     (with-slots (morph::analysis-tree morph::ranking) analyser
	       (setf morph::ranking (morph::rank-analyses analyser))
	       #m((ranking :type "new" :compound #S (or word ""))
		  #L(when word
		      (dotimes (i (length morph::ranking))
			#m((analysis :id #S i)
			   #L(dolist (chunk-info (morph::nth-analysis-codes-regexp
						  (morph::ranking-info-position (aref morph::ranking i))
						  morph::analysis-tree))
			       #+debug(print (cons :chunk-info chunk-info))
			       (destructuring-bind (chunk lemma . features) chunk-info
				 #m((chunk :string #s chunk)
				    ((lemma :features
					    #s(reduce (lambda (x y)
							(concat (string-downcase x) " " (string-downcase y)))
						      (if (consp features)
							  features
							(code-features features))
						      :initial-value ""))
				     #s lemma))))))))))))))

(defmethod ranked-analyses-form-xml ((request http-request) entity)
  (with-xml-response (request entity stream (compound)
			      :xsl #'ranked-analyses-form-xsl
			      :force-xslt :sablotron
			      )
    #m(?xml-stylesheet :type "text/xsl" :href "/cl/cgp/ranked-analyses.xsl")
    ;;(ranked-analyses-xml (gethash "nbo" *cg-table*) (utf-8-decode compound) :stream *standard-output*)
    (terpri stream)
    (ranked-analyses-xml (gethash "nbo" *cg-table*) (utf-8-decode compound) :stream stream)))

#+test
(print (multi-tagger (gethash "nbo" *cg-table*)))

(defstylesheet ranked-analyses-form-xsl ()
  #m((xsl:stylesheet xmlns:xsl "http://www.w3.org/1999/XSL/Transform" :version "1.0")
     ((xsl:template :match "/compound")
      (html
       ((head)
	(title "Sammensetningsanalysator")
        #+ignore
	((SCRIPT :type "text/javascript" :language "javascript") 
	 (!CDATA #L(js/load-dict stream)))
        ((style :type "text/css" :id "editStyle")
	 (CSS-STYLE
	  (div :margin "16"
	       :color "#004499"
	       :font-family "Tahoma, MS Sans Serif, Arial, Geneva, Helvetica")
	  (tr.supertitle :font-size "16" :color "green" :text-align "center")
	  (tr.title :font-size "14" :color "red")
	  (tr.col-title :font-size "12" :color "blue")
	  (td.chunk :font-weight "bold")
	  (div.sub-sense-title :font-size "13" :margin "6")
	  (div.lemma :font-size "18" :font-weight "bold" :color "black")
	  (div.title :font-size "24" :font-weight "bold" :text-align "center")
	  (span.label :font-weight "bold")
	  (a :text-decoration "none" :color "black")
	  (|a:hover| :text-decoration "underline" :color "black")
	  (a.page-link :text-decoration "none" :color "blue" :font-size "10")
	  (|a.page-link:hover| :text-decoration "underline" :color "blue" :font-size "10")
	  )))
       ((body)
        (div ((a :class "page-link" :href "/cl/cgp/obt.html") "Oslo-Bergen-taggeren"))
	((div :class "title") "Sammensetningsanalysator")
	(div ((form :method "get" :id "searchForm")
	      (input/ :type "submit" :value "Analyser")
              (xsl:text " ")
              ((xsl:element :name "input")
               ((xsl:attribute :name "type") "text")
               ((xsl:attribute :name "name") "compound")
               ((xsl:attribute :name "value") (xsl:value-of/ :select "ranking/@compound")))))
        (div (table
	      #+old
	      ((tr :class "supertitle")
	       (td "Gammel") #+new(td "Ny") (td "Regexp"))
	      (tr
	       (xsl:apply-templates/ :select "ranking")))))))
          
     ((xsl:template :match "ranking")
      ((td :style "vertical-align: top")
       (table
	(xsl:apply-templates/ :select "analysis"))))
     #+test
     ((xsl:template :match "ranking")
      ((tr :class "title")
       (td "Gammel") (td "Ny"))
      (tr
       (td
	(xsl:apply-templates/ :select "analysis[@type='old']"))
       #+new
       (td
	(xsl:apply-templates/ :select "analysis[@type='new']"))))
     
     ((xsl:template :match "analysis")
      ((tr :class "title")
       ((td :colspan 3) "Analyse " (xsl:value-of/ :select "@id") ":"))
      ((tr :class "col-title")
       (td "komponent")
       (td "lemma")
       (td "trekk"))
      (xsl:apply-templates/ :select "chunk"))
     
     ((xsl:template :match "chunk")
      ((xsl:if :test "not(lemma)")
       (tr ((td :class "chunk") (xsl:value-of/ :select "@string"))
	   (td)
	   (td)))
      (xsl:apply-templates/ :select "lemma"))

     ((xsl:template :match "lemma")
      (tr ((td :class "chunk")
	   ((xsl:if :test "not(preceding-sibling::lemma)")
	    (xsl:value-of/ :select "../@string")))
	  (td (xsl:value-of/ :select "text()"))
	  (td (xsl:value-of/ :select "@features"))))))

(publish :path "/cl/cgp/ranked-analyses.xml"
	 :class 'xml/html-entity
	 :function #'ranked-analyses-form-xml)

(publish :path "/cl/cgp/ranked-analyses.xsl"
	 :content-type "text/xml"
	 :function #'ranked-analyses-form-xsl)

:eof