1## $Header: /home/neumann/cvs/xotcl/xotcl/library/lib/htmllib.xotcl,v 1.6 2006/09/27 08:12:40 neumann Exp $ 2 3# 4# htmllib.xotcl 5# 6# Author: Antti Salonen, as@fishpool.fi 7# 8# Copyright: 9# 10# This software is copyrighted by Fishpool Creations Oy Ltd. The following 11# terms apply to all files associated with the software unless explicitly 12# disclaimed in individual files. 13# 14# The authors hereby grant permission to use, copy, modify, distribute, 15# and license this software and its documentation for any purpose, provided 16# that existing copyright notices are retained in all copies and that this 17# notice is included verbatim in any distributions. No written agreement, 18# license, or royalty fee is required for any of the authorized uses. 19# Modifications to this software may be copyrighted by their authors 20# and need not follow the licensing terms described here, provided that 21# the new terms are clearly indicated on the first page of each file where 22# they apply. 23# 24# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 25# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 26# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 27# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 28# POSSIBILITY OF SUCH DAMAGE. 29# 30# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 31# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 32# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 33# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 34# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 35# MODIFICATIONS. 36# 37 38package provide xotcl::htmllib 0.1 39package require XOTcl 40 41namespace eval ::xotcl::htmllib { 42 namespace import ::xotcl::* 43 44 @ @File { 45 description { 46 This package provides the class HtmlBuilder, which can be used to 47 generate HTML documents, or a part of a document. 48 } 49 authors { 50 Antti Salonen, as@fishpool.fi 51 } 52 date { 53 $Date: 2006/09/27 08:12:40 $ 54 } 55 } 56 57 # 58 # the compressed parameter means that minimal HTML page are created 59 # i.e. that space indentation is turned off 60 # 61 Class HtmlBuilder -parameter { 62 {compressed 0} 63 } 64 65 ## The constructor. 66 ## 67 ## The HtmlBuilder object has two instance variables. The document Tcl list 68 ## contains the document as a list of strings. The document is stored as a list 69 ## rather than a single string to allow further indentation of the whole 70 ## document when necessary. 71 ## The indentLevel variable is the level of indentation, which is generally 72 ## increased for the contents of any HTML element that may contain block-level 73 ## elements. Typical examples would be <ul>, <li>, <td> and so forth. 74 75 HtmlBuilder instproc init {} { 76 my instvar document indentLevel 77 set document [list] 78 set indentLevel 0 79 return 80 } 81 82 83 HtmlBuilder instproc clear {} { 84 my instvar document indentLevel 85 86 set document [list] 87 set indentLevel 0 88 return 89 } 90 91 92 HtmlBuilder instproc getDocument {} { 93 my instvar document 94 return $document 95 } 96 97 98 HtmlBuilder instproc toString {} { 99 my instvar document compressed 100 set rvalue "" 101 foreach line $document { 102 if {$compressed == "0"} { 103 append rvalue "$line\n" 104 } else { 105 ## only new line for closing tags at the beginnig 106 ## of a document element 107 if {[string equal -length 2 "</" $line]} { 108 append rvalue "$line\n" 109 } else { 110 append rvalue "$line " 111 } 112 } 113 } 114 return $rvalue 115 } 116 117 118 ## parseArguments - Parses the arguments in argList as described in the two 119 ## additional Tcl lists. In addition to the arguments listed in the two 120 ## additional lists, the procedure also accepts arguments common to all 121 ## HTML elements. 122 ## Arguments: 123 ## argList - List of arguments to be parsed 124 ## argParamList - List of arguments that take a parameter 125 ## argNoParamList - List of arguments that don't take a parameter 126 ## Returns: 127 ## A string with arguments to an HTML element. 128 129 HtmlBuilder proc parseArguments {argList argParamList argNoParamList} { 130 set rvalue "" 131 set argParamList [concat $argParamList [list "ID" "CLASS" "STYLE" "TITLE" "LANG" "DIR"]] 132 set param 0 133 foreach arg $argList { 134 if {$param} { 135 append rvalue "=\"$arg\"" 136 set param 0 137 } else { 138 set arg2 [string toupper [string trimleft $arg "-"]] 139 if {[lsearch -exact $argParamList $arg2] != -1} { 140 append rvalue " $arg2" 141 set param 1 142 } elseif {[lsearch -exact $argNoParamList $arg2] != -1} { 143 append rvalue " $arg2" 144 } else { 145 error "HTML syntax error: Invalid argument $arg2 to element" 146 } 147 } 148 } 149 if {$param} { 150 error "HTML syntax error: Missing parameter to argument $arg2" 151 } 152 return $rvalue 153 } 154 155 156 ############################################################################## 157 ## Low-level modification methods: 158 ## 159 ## The efficiency of these is of utmost importance if efficiency is an issue 160 ## in the first place. 161 ## 162 ## addString 163 ## addStringIncr 164 ## addStringDecr 165 ## addWhiteSpace 166 ## addDocument 167 ## mergeDocument 168 169 170 ## Add a new arbitrary string to the document. This method is used by other 171 ## modification methods, as well as the user directly to add content other than 172 ## HTML elements. The string str is appended to the document with proper 173 ## indentation. 174 175 HtmlBuilder instproc addString {str} { 176 my instvar document indentLevel compressed 177 178 if {$compressed == "0"} { 179 for {set n 0} {$n < $indentLevel} {incr n} { 180 append newLine " " 181 } 182 } 183 append newLine $str 184 lappend document $newLine 185 186 return 187 } 188 189 ## Add a string to the document and increase the indentation level. 190 191 HtmlBuilder instproc addStringIncr {str} { 192 my instvar indentLevel 193 my addString $str 194 incr indentLevel 195 return 196 } 197 198 199 ## Decrease the indentation level and add a string to the document. 200 201 HtmlBuilder instproc addStringDecr {str} { 202 my instvar indentLevel 203 incr indentLevel -1 204 my addString $str 205 return 206 } 207 208 # 209 # add the string and replace all line breaks in the 210 # string with addLineBreak calls so that given plain text 211 # appears similar in HTML output 212 213 HtmlBuilder instproc addStringWithLineBreaks {str} { 214 while {[set idx [string first "\n" $str]] != -1} { 215 my addString [string range $str 0 [expr {$idx - 1}]] 216 my addLineBreak 217 set str [string range $str [expr {$idx + 1}] end] 218 } 219 my addString $str 220 } 221 222 ## Add a single line of white space to the HTML document. 223 224 HtmlBuilder instproc addWhiteSpace {} { 225 my addString "" 226 return 227 } 228 229 ## Add the content of the document given as parameter. 230 231 HtmlBuilder instproc addDocument {document} { 232 set documentList [$document getDocument] 233 234 foreach line $documentList { 235 my addString $line 236 } 237 return 238 } 239 240 ## Merge the content of the document given as a parameter. The difference 241 ## to addDocument is that the document merged is destroyed. 242 243 HtmlBuilder instproc mergeDocument {document} { 244 set documentList [$document getDocument] 245 246 foreach line $documentList { 247 my addString $line 248 } 249 $document destroy 250 return 251 } 252 253 254 255 256 ############################################################################## 257 ## HTML generation methods: 258 ## 259 ## The methods for generating various HTML structures are either a pair of 260 ## start and end methods, such as startParagraph and endParagraph, or a single 261 ## method such as addListItem. Even if the the closing tag for <p>, for 262 ## example, is not required by the HTML specification, using the closing method 263 ## is necessary to have the document properly indented. 264 265 266 # Add a string to the document within <strong>...</strong> 267 268 HtmlBuilder instproc addStringStrong {str} { 269 my addString "<STRONG>$str</STRONG>" 270 return 271 } 272 273 # Add a string to the document within <em>...</em> 274 275 HtmlBuilder instproc addStringEmphasized {str} { 276 my addString "<EM>$str</EM>" 277 return 278 } 279 280 # Add a comment to the document <!-- ... --> 281 282 HtmlBuilder instproc addComment {str} { 283 my addString "<!-- $str -->" 284 return 285 } 286 287 HtmlBuilder instproc addLineBreak {} { 288 my addString "<BR>" 289 return 290 } 291 292 ## startDocument - Start an HTML document. Currently all documents are HTML 4.0 293 ## Transitional. HTML, BODY, HEAD and TITLE elements are added/started here. 294 ## Optional arguments: 295 ## -title documentTitle (empty if not given) 296 ## -stylesheet externalStyleSheet 297 ## -bgcolor backgroundColour (deprecated in HTML 4.0) 298 299 HtmlBuilder instproc startDocument {args} { 300 set title "" 301 foreach {name value} $args { 302 switch -- $name { 303 -title { 304 set title $value 305 } 306 -stylesheet { 307 set stylesheet $value 308 } 309 -bgcolor { 310 set bgcolor $value 311 } 312 } 313 } 314 my addString {<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/frameset.dtd">} 315 my addWhiteSpace 316 my addString {<HTML>} 317 my addStringIncr {<HEAD>} 318 my addString "<TITLE>$title</TITLE>" 319 if {[info exists stylesheet]} { 320 my addString "<LINK REL=\"StyleSheet\" HREF=\"$stylesheet\" TYPE=\"text/css\">" 321 } 322 my addStringDecr {</HEAD>} 323 my addWhiteSpace 324 if {[info exists bgcolor]} { 325 my addStringIncr "<BODY BGCOLOR=\"$bgcolor\">" 326 } else { 327 my addStringIncr {<BODY>} 328 } 329 return 330 } 331 332 ## endDocument - end an HTML document 333 334 HtmlBuilder instproc endDocument {} { 335 my addStringDecr {</BODY>} 336 my addString {</HTML>} 337 return 338 } 339 340 ## startParagraph - start a P element 341 ## Optional arguments: 342 ## Common HTML arguments 343 344 HtmlBuilder instproc startParagraph {args} { 345 set attributes [HtmlBuilder parseArguments $args [list] [list]] 346 my addStringIncr "<P$attributes>" 347 return 348 } 349 350 ## endParagraph - end a P element 351 352 HtmlBuilder instproc endParagraph {} { 353 my addStringDecr {</P>} 354 return 355 } 356 357 ## startAnchor - start an A element 358 ## Optional arguments: 359 ## -href URI 360 ## -name cdata 361 ## -target frameTarget 362 ## Common HTML arguments 363 364 HtmlBuilder instproc startAnchor {args} { 365 set attributes [HtmlBuilder parseArguments $args \ 366 [list "HREF" "NAME" "TARGET"] [list]] 367 my addStringIncr "<A$attributes>" 368 return 369 } 370 371 ## endAnchor - end an A element 372 373 HtmlBuilder instproc endAnchor {args} { 374 my addStringDecr {</A>} 375 return 376 } 377 378 ## addAnchor - add an A element, using content as the visible link. 379 ## Optional arguments: 380 ## -href URI 381 ## -name cdata 382 ## -target frameTarget 383 ## Common HTML arguments 384 385 HtmlBuilder instproc addAnchor {content args} { 386 eval my startAnchor $args 387 my addString $content 388 my endAnchor 389 return 390 } 391 392 ## startUnorderedList - start a UL element 393 ## Optional arguments: 394 ## Commmon HTML arguments 395 396 HtmlBuilder instproc startUnorderedList {args} { 397 set attributes [HtmlBuilder parseArguments $args [list] [list]] 398 my addStringIncr "<UL$attributes>" 399 return 400 } 401 402 ## endUnorderedList - end a UL element 403 404 HtmlBuilder instproc endUnorderedList {} { 405 my addStringDecr {</UL>} 406 return 407 } 408 409 ## startListItem - start an LI element 410 ## Optional arguments: 411 ## Common HTML arguments 412 413 HtmlBuilder instproc startListItem {args} { 414 set attributes [HtmlBuilder parseArguments $args [list] [list]] 415 my addStringIncr "<LI$attributes>" 416 return 417 } 418 419 ## endListItem - end an LI element 420 421 HtmlBuilder instproc endListItem {} { 422 my addStringDecr {</LI>} 423 return 424 } 425 426 ## add a simple list item 427 HtmlBuilder instproc addListItem {content} { 428 my startListItem 429 my addString $content 430 my endListItem 431 } 432 433 ## startTable - start a TABLE element. Note that if the -border argument isn't 434 ## used, by default the table are created with borders (<TABLE BORDER>). 435 436 ## Optional arguments: 437 ## -border pixels 438 ## -cellpadding length 439 ## -cellspacing length 440 ## -summary text 441 ## -width length 442 ## -bgcolor color spec 443 ## Common HTML arguments 444 445 HtmlBuilder instproc startTable {args} { 446 set attributes [HtmlBuilder parseArguments $args \ 447 [list "BORDER" "CELLPADDING" "CELLSPACING" "SUMMARY" \ 448 "WIDTH" "BGCOLOR"] [list]] 449 if {[lsearch $args "-border"] == -1} { 450 append attributes " BORDER" 451 } 452 my addStringIncr "<TABLE$attributes>" 453 return 454 } 455 456 ## endTable - end a TABLE element 457 458 HtmlBuilder instproc endTable {} { 459 my addStringDecr {</TABLE>} 460 return 461 } 462 463 ## startTableRow - start a TR element 464 ## Optional arguments: 465 ## Common HTML arguments 466 HtmlBuilder instproc startTableRow {args} { 467 set attributes [HtmlBuilder parseArguments $args [list "VALIGN"] [list]] 468 my addStringIncr "<TR$attributes>" 469 return 470 } 471 472 ## endTableRow - end a TR element 473 474 HtmlBuilder instproc endTableRow {} { 475 my addStringDecr {</TR>} 476 return 477 } 478 479 ## startTableCell - start a TD element 480 ## Optional arguments: 481 ## -colspan number 482 ## -rowspan number 483 ## -align left|center|right|justify|char 484 ## -valign top|middle|bottom|baseline 485 ## -bgcolor 486 ## -width 487 ## Common HTML arguments 488 489 HtmlBuilder instproc startTableCell {args} { 490 set attributes [HtmlBuilder parseArguments $args \ 491 [list "COLSPAN" "ROWSPAN" "ALIGN" "VALIGN" \ 492 "BGCOLOR" "WIDTH"] [list]] 493 my addStringIncr "<TD$attributes>" 494 return 495 } 496 497 ## endTableCell - end a TD element 498 499 HtmlBuilder instproc endTableCell {} { 500 my addStringDecr {</TD>} 501 return 502 } 503 504 # 505 # add a simple table cell which just contains a string 506 # 507 HtmlBuilder instproc addTableCell {{string ""} args} { 508 eval my startTableCell $args 509 my addString $string 510 my endTableCell 511 } 512 513 ## startTableHeaderCell - start a TH element 514 ## Optional arguments: 515 ## -colspan number 516 ## -rowspan number 517 ## -align left|center|right|justify|char 518 ## -valign top|middle|bottom|baseline 519 ## Common HTML arguments 520 521 HtmlBuilder instproc startTableHeaderCell {args} { 522 set attributes [HtmlBuilder parseArguments $args \ 523 [list "COLSPAN" "ROWSPAN" "ALIGN" "VALIGN"] [list]] 524 my addStringIncr "<TH$attributes>" 525 return 526 } 527 528 ## endTableHeaderCell - end a TH element 529 530 HtmlBuilder instproc endTableHeaderCell {} { 531 my addStringDecr {</TH>} 532 return 533 } 534 535 ## startForm - start a FORM element 536 ## Required arguments: 537 ## -action URI 538 ## Optional arguments: 539 ## -method get|post 540 ## Common HTML arguments 541 542 HtmlBuilder instproc startForm {args} { 543 set attributes [HtmlBuilder parseArguments $args \ 544 [list "ACTION" "METHOD" "ENCTYPE"] [list]] 545 my addStringIncr "<FORM$attributes>" 546 return 547 } 548 549 ## endForm - end a FORM element 550 551 HtmlBuilder instproc endForm {} { 552 my addStringDecr {</FORM>} 553 return 554 } 555 556 ## addInput - add in INPUT element 557 ## Required arguments: 558 ## -type <input type> 559 ## -name <control name> 560 ## Optional arguments: 561 ## -value <initial value> 562 ## -size <width of input, in pixels of characters> 563 ## -maxlength <max number of characters for text input> 564 ## -checked 565 ## Common HTML arguments 566 567 HtmlBuilder instproc addInput {args} { 568 set attributes [HtmlBuilder parseArguments $args \ 569 [list "TYPE" "NAME" "VALUE" "SIZE" "MAXLENGTH"] \ 570 [list "CHECKED"]] 571 my addString "<INPUT$attributes>" 572 return 573 } 574 575 ## addTextArea - start a TEXTAREA element 576 ## First parameter: value - Default value of the text area 577 ## Required arguments: 578 ## -rows <number of rows> 579 ## -cols <number of columns> 580 ## Optional arguments: 581 ## -name <control name> 582 ## Common HTML Arguments 583 584 HtmlBuilder instproc addTextArea {value args} { 585 set attributes [HtmlBuilder parseArguments $args \ 586 [list "ROWS" "COLS" "NAME"] [list]] 587 my addString "<TEXTAREA$attributes>$value</TEXTAREA>" 588 return 589 } 590 591 ## startOptionSelector - start a SELECT element 592 ## Optional arguments: 593 ## -name <control name> 594 ## -size <number of visible items> 595 ## -multiple 596 ## Common HTML arguments 597 598 HtmlBuilder instproc startOptionSelector {args} { 599 set attributes [HtmlBuilder parseArguments $args \ 600 [list "NAME" "SIZE"] [list "MULTIPLE"]] 601 my addStringIncr "<SELECT$attributes>" 602 return 603 } 604 605 ## endOptionSelector - end a SELECT element 606 607 HtmlBuilder instproc endOptionSelector {} { 608 my addStringDecr "</SELECT>" 609 return 610 } 611 612 ## startOption - start an OPTION element 613 ## Optional arguments: 614 ## -value <value of option> 615 ## -selected 616 ## Common HTML arguments 617 618 HtmlBuilder instproc startOption {args} { 619 set attributes [HtmlBuilder parseArguments $args \ 620 [list "VALUE"] [list "SELECTED"]] 621 my addStringIncr "<OPTION$attributes>" 622 return 623 } 624 625 ## endOption - end an OPTION element 626 627 HtmlBuilder instproc endOption {} { 628 my addStringDecr "</OPTION>" 629 return 630 } 631 632 ## addImage - add an IMG element 633 ## Required arguments: 634 ## -src <url> 635 ## -alt <alternate text> 636 ## -align <alignment> (deprecated in HTML 4.0) 637 ## Optional arguments: 638 ## Common HTML arguments 639 640 HtmlBuilder instproc addImage {args} { 641 set attributes [HtmlBuilder parseArguments $args \ 642 [list "SRC" "ALT" "ALIGN"] [list]] 643 my addString "<IMG$attributes>" 644 return 645 } 646 647 ## startBlock - start a DIV element (a generic block-level container) 648 ## Optional arguments: 649 ## Common HTML attributes 650 651 HtmlBuilder instproc startBlock {args} { 652 set attributes [HtmlBuilder parseArguments $args [list] [list]] 653 my addStringIncr "<DIV$attributes>" 654 return 655 } 656 657 ## endBlock - end a DIV element 658 659 HtmlBuilder instproc endBlock {} { 660 my addStringDecr "</DIV>" 661 return 662 } 663 664 ## addHorizontalRule - add an HR element 665 ## Optional arguments: 666 ## Common HTML arguments 667 668 HtmlBuilder instproc addHorizontalRule {args} { 669 set attributes [HtmlBuilder parseArguments $args [list] [list]] 670 my addString "<HR$attributes>" 671 return 672 } 673 674 namespace export HtmlBuilder 675} 676 677namespace import ::xotcl::htmllib::* 678