;;;High-level parameter manipulation
;;;Individual parameters
(define (parameter:text-table-entry name)
    (let ((par (parameter:find-par name)))
      (if par
	  (parameter:tabulate-par par)
	  (else (format-error "Parameter ~S is not defined" name)))))

(define (parameter:html-table-entry name)
    (let ((par (parameter:find-par name)))
      (if par
	  (parameter:html-tabulate-par par)
	  (else (format-error "Parameter ~S is not defined" name)))))


;;;Tables of parameters
(define (parameter:text-table-from-regex regexp)
  (let ((par-list (parameter:find-parameter-regex regexp)))
    (if (null? par-list)
	(format #f "No parameters containing ~S were found" regexp)
	(reduce string-append (map parameter:tabulate-par par-list)))))


(define (parameter:html-table-from-regex regexp)
  (let ((par-list (parameter:find-parameter-regex regexp)))
    (if (null? par-list)
	(format #f "No parameters containing ~S were found" regexp)
	(string-append
	 (format #f "~D parameter~:P matched your request:<BR>
<UL>~{~%<LI><A HREF = \"#~A\">~:*~A</A>~}
</UL>"
		 (length par-list) (map parameter:human-name par-list)) 
	 (reduce string-append (map parameter:html-tabulate-par par-list))))))


;;;
(define (parameter:tabulate-par par)
  (format #f "~&~100,,,'*A~%~:{* :names ~8A*  ~@{~S   ~}~%~}~:{* ~15A*  ~30@A~%~}"
	  #\* (parameter:names par) (remove-if (lambda (x) (eq? (car x) ':names)) par)))

#|
;;;This procedure leaves filled in boxes in html tables, but otherwise was doing pretty good
(define (parameter:html-tabulate-par par)
  (let ((names (parameter:names par))
	(rest (remove-if (lambda (x) (eq? (car x) ':names)) par)))
    (format #f "<CENTER>
<A NAME = ~S></A>
<TABLE BORDER=5 WIDTH=100%>
<TR><TH ROWSPAN=~D>:names</TH>
~:{<TH>~A</TH> ~@{ <TD>~A~}</TR>~%<TR>~}
~:{<TH COLSPAN=2>~A</TH> <TD COLSPAN=3>~A</TR>~%<TR>~}
~:[~;<TD COLSPAN=5 ALIGN=CENTER><FONT SIZE = -1><I>You can reset the current value of the parameter by typing the value you want and hitting the reset button.</I></FONT>
<FORM METHOD=\"POST\" ACTION=\"http://localhost:8000/users/sofya/html-test\">
<INPUT TYPE=\"text\" NAME=\"value\" SIZE=\"7\">
<INPUT TYPE=\"submit\" NAME=\"reset-parameter\" VALUE=\"RESET\">
</FORM>~]
</TABLE>
</CENTER>" (parameter:names->human names) (length names) names rest
    (parameter:resettable? (parameter:resettable rest)))))
|#

(define (parameter:html-tabulate-par par)
  (let* ((names (parameter:names par))
	 (colspan (apply max (map length names)))
	 (rest (remove-if (lambda (x) (eq? (car x) ':names)) par)))
    (format #f
	    (format #f "<CENTER>
<A NAME = ~S></A>
<TABLE BORDER=5 WIDTH=100%>
<TR><TH ROWSPAN=~D>:names</TH>
~:{<TH>~A</TH> ~@{ <TD~#[~;~; COLSPAN=~A~]>~A</TD>~}</TR>~%<TR>~}
~:{<TH COLSPAN=2>~A</TH> <TD COLSPAN=~~A~~:*>~A</TD></TR>~%<TR>~}~~*
~:[~4*~;<TD COLSPAN=~A ALIGN=CENTER>You can reset the current value of the parameter by typing the value you want and hitting the reset botton.
<FORM METHOD=\"POST\" ACTION=\"http://~A:~A/reset-parameter\">
<INPUT TYPE=\"hidden\" NAME=\"name\" VALUE=\"~A\">
<INPUT TYPE=\"text\" NAME=\"value\" SIZE=\"7\">
<INPUT TYPE=\"submit\" NAME=\"RESET-PARAMETER\" VALUE=\"RESET\"></TD></TR>
</FORM>~]
</TABLE>
</CENTER>" (parameter:names->human names) (length names)
     (map  (lambda (i)
	     (let ((rev (reverse i)))
	       (nreverse (cons (car rev) (cons (1+ (- colspan (length i))) (cdr rev))))))  names) rest
     (parameter:resettable? (parameter:resettable rest))
     (1+ colspan) yenta-machine-name yenta-UI-port (parameter:names->human names)) (1- colspan))))

;;;development aids
(define (parameter:scheme-table-entry name)
  (let ((par (parameter:find-par name)))
    (if par
	(lambda ()
	 (parameter:scheme-tabulate-par par))
	(format-error "Parameter ~S is not defined" name))))

(define (parameter:scheme-table-from-regex regexp)
  (let ((par-list (parameter:find-parameter-regex regexp)))
    (if (null? par-list)
	(format t "No parameters containing ~S were found" regexp)
	(lambda ()
	  (map parameter:scheme-tabulate-par par-list)))))

(define (parameter:scheme-tabulate-par par)
    (eval (macroexpand `(def-yenta-parameter ,@par))))


