core/implementation/HtmlTag.tcl



@implementation HtmlTag {

  + new: { tagName } {
      return [[$self new] type: $tagName]
    }

  + new:withAttributes: { tagName anAttributesString } {
      return [[[$self new] type: $tagName] \
                    attributes: $anAttributesString]
    }

  + new:withValue: { tagName aValue } {
      return [[[$self new] type: $tagName] \
                         value: $aValue]
    }

  + new:withAttributes:andValue: { tagName anAttributesString aValue } {
      return [[[[$self new] type: $tagName] \
                     attributes: $anAttributesString] \
                          value: $aValue]
    }

  + new:withValue:andAttributes: { tagName aValue anAttributesString } {
      return [[[[$self new] type: $tagName] \
                     attributes: $anAttributesString] \
                          value: $aValue]
    }

  - init {} {
      $super init
      set closed 1
      set value ""
      set type HTML
    }

  - type: { tagName } {
      set type $tagName
      switch -exact -- [string toupper $tagName] {
        BR { $self dontClose }
        BODY { 
          $self attributes: \
           "BGCOLOR=WHITE TEXT=BLACK LINK=8080C0 VLINK=8080C0 ALINK=808C0" 
        }
        STYLE { 
          $self value: {
            BODY, TABLE, TR, TD, A:link, A:visited {
              font-size: 13 ;
              font-weight: normal ;
              font-family: "arial, helvetica" ;
              text-decoration: none ;
              background-color: white ;
            }
            A:link, A:visited, A:active {
              color: #8080C0
            }
            A:hover, A:active {
              text-decoration: underline ;
            }
            LI {
              list-style-type: circle;
            }
          }
        }
        UL { $self attributes: "TYPE=CIRCLE" }
        TABLE { 
          $self attributes: \
            "BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=100% ALIGN=CENTER"
        }
        TD { $self attributes: "ALIGN=CENTER VALIGN=CENTER" }
        TR { $self attributes: "ALIGN=CENTER VALIGN=CENTER" }
      }
    }
  - type {} {
      return $type
    }

  - value: { aValue } {
      set value $aValue
    }
  - value {} {
      return $value
    }

  - attributes: { anAttributesString } {
      set attributes $anAttributesString
    }
  - attributes {} {
      return $attributes
    }

  - dontClose {} {
      set closed 0
    }

  - add: aTagObject {
      lappend tags $aTagObject
    }

  - remove: aTagObject {
      if [tags contains: $aTagObject] {
        tags remove: $aTagObject
      }
    }

  - html {} {
      set txt "<$type"
      if [string length $attributes] { 
        append txt " "
        append txt $attributes
      }
      append txt ">\n"
      if [string length $value] {
        append txt $value
        append txt "\n"
      }
      if [llength $tags] {
        foreach subtag $tags {
          append txt [$subtag html]
        }
      }
      if {$closed} { 
        append txt "</$type>"
        append txt "\n"
      }
      return $txt
    }
  - dealloc {} { 
      foreach subtag $tags {
        $subtag release
      }
      return [$super dealloc]
    }

  - tags {} {
      return $tags
    }

  - tagsOfType: aTagName {
      set subtags ""
      foreach tag $tags {
        if {"[string toupper [$tag type]]" == "[string toupper $aTagName]"} {
          lappend subtags $tag
        }
      }
      return $subtags
    }

  - allTagsOfType: aTagName {
      set subtags [$self tagsOfType: $aTagName]
      foreach tag $tags {
        if [string length [set t [$tag allTagsOfType: $aTagName]]] {
          lappend subtags $t
          set subtags [join $subtags]
        }
      }
      return $subtags
    }
}