## $Header: /cvs/codebase/tcl/html.tcl,v 1.3 2001/02/13 02:50:27 setok Exp $


package provide fishpool.html 0.1

package require XOTcl 0.82


@ @File {
    description {
	This package provides the class HtmlDocument, which can be used to 
	generate HTML documents, or a part of a document.
    }
    authors {
	Antti Salonen, as@fishpool.com
    }
    date {
	$Date: 2001/02/13 02:50:27 $
    }
}
	

Class HtmlDocument

## The constructor.
##
## The HtmlDocument object has two instance variables. The document Tcl list
## contains the document as a list of strings. The document is stored as a list
## rather than a single string to allow further indentation of the whole
## document when necessary.
##   The indentLevel variable is the level of indentation, which is generally
## increased for the contents of any HTML element that may contain block-level
## elements. Typical examples would be <ul>, <li>, <td> and so forth.

HtmlDocument instproc init {} {
    [self] instvar document indentLevel
    set document [list] 
    set indentLevel 0
    return
}


HtmlDocument instproc clear {} {
    [self] instvar document indentLevel

    set document ""
    set indentLevel 0
    return
}


HtmlDocument instproc getDocument {} {
    [self] instvar document
    return $document
}


HtmlDocument instproc toString {} {
    [self] instvar document
    
    for {set n 0} {$n < [llength $document]} {incr n} {
        append rvalue [lindex $document $n] "\n"
    }
    
    return $rvalue
}


## parseCommonArguments is a class-wide utility procedure that parses arguments
## related to attributes common to most HTML elements:
##   -id elementId
##   -class elementClass
##   -style inlineStyle
##   -title elementTitle
##   -lang elementLanguage
##   -dir elementTextDirectionality
## The procedure returns the HTML attributes in form such as 
## ' id="foo" class="bar"'. The corresponding arguments are deleted from the
## list with the name given as the only argument.


HtmlDocument proc parseCommonArguments {argsName} {
    upvar $argsName args
    set attributes ""
    set lvalue ""
    for {set i 0} {$i < [llength $args]} {} { 
        if {[string length $lvalue] > 0} {
            append attributes " $lvalue=\"[lindex $args $i]\""
            set lvalue ""
            set args [lreplace $args $i $i]
            continue
        }
        switch -- [lindex $args $i] {
            -id {
                set lvalue "ID"
                set args [lreplace $args $i $i]
            }
            -class {
                set lvalue "CLASS"
                set args [lreplace $args $i $i]
            }
            -style {
                set lvalue "STYLE"
                set args [lreplace $args $i $i]
            }
            -title {
                set lvalue "TITLE"
                set args [lreplace $args $i $i]
            }
            -lang {
                set lvalue "LANG"
                set args [lreplace $args $i $i]
            }
            -dir {
                set lvalue "DIR"
                set args [lreplace $args $i $i]
            }
            default {
                incr i
            }
        }
    }

    return $attributes
}

    
    




#####################################
## Low-level modification methods:
##
## addString
## addStringIncr
## addStringDecr
## addWhiteSpace
## addDocument
#####################################


## Add a new arbitrary string to the document. This method is used by other
## modification methods, as well as the user directly to add content other than
## HTML elements.
##   The string str is appended to the document with properindentation. Note
## that in order the document to be layed out properly, the string is assumed
## not to contain newline characters.

HtmlDocument instproc addString {str} {
    [self] instvar document indentLevel
    
    for {set n 0} {$n < $indentLevel} {incr n} {
        append newLine "  "
    }
    append newLine $str
    lappend document $newLine

    return
}


## Add a string to the document and increase the indentation level.

HtmlDocument instproc addStringIncr {str} {
    [self] instvar indentLevel
    [self] addString $str
    incr indentLevel
    return
}


## Decrease the indentation level and add a string to the document.

HtmlDocument instproc addStringDecr {str} {
    [self] instvar indentLevel
    incr indentLevel -1
    [self] addString $str
    return
}

 
## Add a single line of white space to the HTML document.
   
HtmlDocument instproc addWhiteSpace {} {
    [self] addString ""
    return
}

## Treat the document parameter as another HtmlDocument object and add its
## content to the document.

HtmlDocument instproc addDocument {document} {
    set documentList [$document getDocument]
    for {set i 0} {$i < [llength $documentList]} {incr i} {
        [self] addString [lindex $documentList $i]
    }
    return
}



###############################################################################
## HTML generation methods:                                                
##              
## The methods for generating various HTML structures are either a pair of 
## start and end methods, such as startParagraph and endParagraph, or a single
## method such as addListItem. Even if the the closing tag for <p>, for
## example, is not required by the HTML specification, using the closing method
## is necessary to have the document properly indented.
###############################################################################


# Add a string to the document within <strong>...</strong>

HtmlDocument instproc addStringStrong {str} {
    [self] addString "<STRONG>$str</STRONG>"
    return
}

# Add a string to the document within <em>...</em>

HtmlDocument instproc addStringEmphasized {str} {
    [self] addString "<EM>$str</EM>"
    return
}

# Add a comment to the document <!-- ... -->

HtmlDocument instproc addComment {str} {
    [self] addString "<!-- $str -->"
    return
}

HtmlDocument instproc addLineBreak {} {
    [self] addString "<BR>"
    return
}

## startDocument - Start an HTML document. Currently all documents are HTML 4.0
## Transitional. HTML, BODY, HEAD and TITLE elements are added/started here.
## Optional arguments:
##   -title documentTitle (empty if not given)
##   -stylesheet externalStyleSheet

HtmlDocument instproc startDocument {args} {
    set title ""
    foreach {name value} $args {
        switch -- $name {
            -title {
                set title $value
            }
            -stylesheet {
                set stylesheet $value
            }
        }
    }
    [self] addString {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/frameset.dtd">}
    [self] addWhiteSpace
    [self] addString {<HTML>}
    [self] addStringIncr {<HEAD>}
    [self] addString "<TITLE>$title</TITLE>"
    if {[info exists stylesheet]} {
        [self] addString "<LINK REL=\"StyleSheet\" HREF=\"$stylesheet\" TYPE=\"text/css\">"
    }
    [self] addStringDecr {</HEAD>}
    [self] addWhiteSpace
    [self] addStringIncr {<BODY>}
    return
}

## endDocument - end an HTML document

HtmlDocument instproc endDocument {} {
    [self] addStringDecr {</BODY>}
    [self] addString {</HTML>}
    return
}

## startParagraph - start a P element
## Optional arguments:
##   Common HTML arguments

HtmlDocument instproc startParagraph {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    [self] addStringIncr "<P$attributes>"
    return
}

## endParagraph - end a P element

HtmlDocument instproc endParagraph {} {
    [self] addStringDecr {</P>}
    return
}

## startAnchor - start an A element
## Optional arguments:
##   -href URI
##   -name cdata
##   -target frameTarget
##   Common HTML arguments

HtmlDocument instproc startAnchor {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach {name value} $args {
        switch -- $name {
            -href {
                append attributes " HREF=\"$value\""
            }
            -name {
                append attributes " NAME=\"$value\""
            }
            -target {
                append attributes " TARGET=\"$value\""
            }
        }
    }
    [self] addStringIncr "<A$attributes>"
    return
}

## endAnchor - end an A element

HtmlDocument instproc endAnchor {args} {
    [self] addStringDecr {</A>}
}

## startUnorderedList - start a UL element
## Optional arguments:
##   Commmon HTML arguments

HtmlDocument instproc startUnorderedList {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    [self] addStringIncr "<UL$attributes>"
    return
}

## endUnorderedList - end a UL element

HtmlDocument instproc endUnorderedList {} {
    [self] addStringDecr {</UL>}
    return
}

## startListItem - start an LI element
## Optional arguments:
##   Common HTML arguments

HtmlDocument instproc startListItem {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    [self] addStringIncr "<LI$attributes>"
    return
}

## endListItem - end an LI element

HtmlDocument instproc endListItem {} {
    [self] addStringDecr {</LI>}
    return
}

## startTable - start a TABLE element
## Optional arguments:
##   -border pixels
##   -cellpadding length
##   -cellspacing length
##   -summary text
##   -width length
##   Common HTML arguments

HtmlDocument instproc startTable {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    set borderSpecified 0
    foreach {name value} $args {
        switch -- $name {
            -border {
                append attributes " BORDER=\"$value\""
                set borderSpecified 1
            }
            -cellpadding {
                append attributes " CELLPADDING=\"$value\""
            }
            -cellspacing {
                append attributes " CELLSPACING=\"$value\""
            }
            -summary {
                append attributes " SUMMARY=\"$value\""
            }
            -width {
                append attributes " WIDTH=\"$value\""
            }
        }
    }
    # If the layout of borders is unspecified, use <table border>.
    if {!$borderSpecified} {
        append attributes " BORDER"
    }

    [self] addStringIncr "<TABLE$attributes>"
    return
}

## endTable - end a TABLE element

HtmlDocument instproc endTable {} {
    [self] addStringDecr {</TABLE>}
    return
}

## startTableRow - start a TR element
## Optional arguments:
##   Common HTML arguments

HtmlDocument instproc startTableRow {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    [self] addStringIncr "<TR$attributes>"
    return
}

## endTableRow - end a TR element

HtmlDocument instproc endTableRow {} {
    [self] addStringDecr {</TR>}
    return
}

## startTableCell - start a TD element
## Optional arguments:
##   -colspan number
##   -rowspan number
##   -align left|center|right|justify|char
##   -valign top|middle|bottom|baseline
##   Common HTML arguments

HtmlDocument instproc startTableCell {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach {name value} $args {
        switch -- $name {
            -colspan {
                append attributes " COLSPAN=\"$value\""
            }
            -rowspan {
                append attributes " ROWSPAN=\"$value\""
            }
            -align {
                append attributes " ALIGN=\"$value\""
            }
            -valign {
                append attributes " VALIGN=\"value\""
            }
        }
    }

    [self] addStringIncr "<TD$attributes>"
    return
}

## endTableCell - end a TD element

HtmlDocument instproc endTableCell {} {
    [self] addStringDecr {</TD>}
    return
}

## startTableHeaderCell - start a TH element
## Optional arguments:
##   -colspan number
##   -rowspan number
##   -align left|center|right|justify|char
##   -valign top|middle|bottom|baseline
##   Common HTML arguments

HtmlDocument instproc startTableHeaderCell {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach {name value} $args {
        switch -- $name {
            -colspan {
                append attributes " COLSPAN=\"$value\""
            }
            -rowspan {
                append attributes " ROWSPAN=\"$value\""
            }
            -align {
                append attributes " ALIGN=\"$value\""
            }
            -valign {
                append attributes " VALIGN=\"value\""
            }
        }
    }

    [self] addStringIncr "<TH$attributes>"
    return
}

## endTableHeaderCell - end a TH element

HtmlDocument instproc endTableHeaderCell {} {
    [self] addStringDecr {</TH>}
    return
}

## startForm - start a FORM element
## Required arguments:
##   -action URI
## Optional arguments:
##   -method get|post
##   Common HTML arguments

HtmlDocument instproc startForm {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach {name value} $args {
        switch -- $name {
            -action {
                append attributes " ACTION=\"$value\""
            }
            -method {
                append attributes " METHOD=\"$value\""
            }
        }
    }
    [self] addStringIncr "<FORM$attributes>"
    return
}

## endForm - end a FORM element

HtmlDocument instproc endForm {} {
    [self] addStringDecr {</FORM>}
    return
}

## addInput - add in INPUT element
## Required arguments:
##   -type <input type>
##   -name <control name>
## Optional arguments:
##   -value <initial value>
##   -size <width of input, in pixels of characters>
##   -maxlength <max number of characters for text input>
##   -checked
##   Common HTML arguments
 
HtmlDocument instproc addInput {args} {
    set attributes ""
    set lvalue ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach i $args {
        if {[string length $lvalue] > 0} {
            append attributes " $lvalue=\"$i\""
            set lvalue ""
            continue
        }
        switch -- $i {
            -type {
                set lvalue "TYPE"
            }
            -name {
                set lvalue "NAME"
            }
            -value {
                set lvalue "VALUE"
            }
            -size {
                set lvalue "SIZE"
            }
            -maxlength {
                set lvalue "MAXLENGTH"
            }
            -checked {
                append attributes " CHECKED"
            }
            default {
                # This is error
            }
        }
    }
    [self] addString "<INPUT$attributes>"
    return
}

## addTextArea - start a TEXTAREA element
## Required arguments:
##   -rows <number of rows>
##   -cols <number of columns>
## Optional arguments:
##   -name <control name>
##   -value <initial value>
##   Common HTML Arguments

HtmlDocument instproc addTextArea {args} {
    set attributes ""
    set ivalue ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach {name value} $args {
        switch -- $name {
            -rows {
                append attributes " ROWS=\"$value\""
            }
            -cols {
                append attributes " COLS=\"$value\""
            }
            -name {
                append attributes " NAME=\"$value\""
            }
            -value {
                set ivalue $value
            }
        }
    }
    [self] addString "<TEXTAREA$attributes>$ivalue</TEXTAREA>"
    return
}

## startOptionSelector - start a SELECT element
## Optional arguments:
##   -name <control name>
##   -size <number of visible items>
##   -multiple
##   Common HTML arguments

HtmlDocument instproc startOptionSelector {args} {
    set attributes ""
    set lvalue ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach i $args {
        if {[string length $lvalue] > 0} {
            append attributes " $lvalue=\"$i\""
            set lvalue ""
            continue
        }
        switch -- $i {
            -name {
                set lvalue "NAME"
            }
            -size {
                set lvalue "SIZE"
            }
            -multiple {
                append attributes " MULTIPLE"
            }
            default {
                # This is error
            }
        }
    }
    [self] addStringIncr "<SELECT$attributes>"
    return
}    

## endOptionSelector - end a SELECT element

HtmlDocument instproc endOptionSelector {} {
    [self] addStringDecr "</SELECT>"
    return
}

## startOption - start an OPTION element
## Optional arguments:
##   -value <value of option>
##   -selected
##   Common HTML arguments

HtmlDocument instproc startOption {args} {
    set attributes ""
    set lvalue ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach i $args {
        if {[string length $lvalue] > 0} {
            append attributes " $lvalue=\"$i\""
            set lvalue ""
            continue
        }
        switch -- $i {
            -value {
                set lvalue "VALUE"
            }
            -selected {
                append attributes " SELECTED"
            }
            default {
                # This is error
            }
        }
    }
    [self] addStringIncr "<OPTION$attributes>"
    return
}

## endOption - end an OPTION element

HtmlDocument instproc endOption {} {
    [self] addStringDecr "</OPTION>"
    return
}

## addImage - add an IMG element
## Required arguments:
##   -src <url>
##   -alt <alternate text>
## Optional arguments:
##   Common HTML arguments

HtmlDocument instproc addImage {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    foreach {name value} $args {
        switch -- $name {
            -src {
                append attributes " SRC=\"$value\""
            }
            -alt {
                append attributes " ALT=\"$value\""
            }
            default {
                error "Invalid argument $name"
            }
        }
    }
    [self] addString "<IMG$attributes>"
    return
}

## startBlock - start a DIV element (a generic block-level container)
## Optional arguments:
##   Common HTML attributes

HtmlDocument instproc startBlock {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    [self] addStringIncr "<DIV$attributes>"
    return
}

## endBlock - end a DIV element

HtmlDocument instproc endBlock {} {
    [self] addStringDecr "</DIV>"
    return
}

## addHorizontalRule - add an HR element
## Optional arguments:
##   Common HTML arguments

HtmlDocument instproc addHorizontalRule {args} {
    set attributes ""
    append attributes [HtmlDocument parseCommonArguments args]
    [self] addString "<HR$attributes>"
    return
}


# Simple test program; create a document, add different kinds of elements to
# it and print the whole thing to stdout.
if {0} {
    HtmlDocument kala
    kala startDocument -title "foobar"
    kala startUnorderedList -class foobar
    kala startListItem
    kala startParagraph
    kala addString "alksjdf ljdsah flksjda hflkjashdl jhs"
    kala endParagraph
    kala endListItem
    kala endUnorderedList
    kala startBlock -class asdf
    kala addString "asdlkjf haslk hflksaj hflkasjhfslkajh"
    kala endBlock
    kala addImage -src foo.gif -alt foo -id 1 -class blokki
    kala endDocument
    puts [kala toString]
}