1# Scrolledhtml 2# ---------------------------------------------------------------------- 3# Implements a scrolled html text widget by inheritance from scrolledtext 4# Import reads from an html file, while export still writes plain text 5# Also provides a render command, to display html text passed in as an 6# argument. 7# 8# This widget is HTML3.2 compliant, with the following exceptions: 9# a) nothing requiring a connection to an HTTP server is supported 10# b) some of the image alignments aren't supported, because they're not 11# supported by the text widget 12# c) the br attributes that go with the image alignments aren't implemented 13# d) background images are not supported, because they're not supported 14# by the text widget 15# e) automatic table/table cell sizing doesn't work very well. 16# 17# WISH LIST: 18# This section lists possible future enhancements. 19# 20# 1) size tables better using dlineinfo. 21# 2) make images scroll smoothly off top like they do off bottom. (limitation 22# of text widget?) 23# 3) add ability to get non-local URLs 24# a) support forms 25# b) support imagemaps 26# 4) keep track of visited links 27# 5) add tclets support 28# 29# BUGS: 30# Cells in a table can be caused to overlap. ex: 31# <table border width="100%"> 32# <tr><td>cell1</td><td align=right rowspan=2>cell2</td></tr> 33# <tr><td colspan=2>cell3 w/ overlap</td> 34# </table> 35# It hasn't been fixed because 1) it's a pain to fix, 2) the fix would slow 36# tables down by a significant amount, and 3) netscape has the same 37# bug, as of V3.01, and no one seems to care. 38# 39# In order to size tables properly, they must be visible, which causes an 40# annoying jump from table to table through the document at render time. 41# 42# ---------------------------------------------------------------------- 43# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com 44# 45# @(#) $Id: scrolledhtml.itk,v 1.8 2004/12/02 17:49:18 davygrvy Exp $ 46# ---------------------------------------------------------------------- 47# Copyright (c) 1996 DSC Technologies Corporation 48# ====================================================================== 49# Permission to use, copy, modify, distribute and license this software 50# and its documentation for any purpose, and without fee or written 51# agreement with DSC, is hereby granted, provided that the above copyright 52# notice appears in all copies and that both the copyright notice and 53# warranty disclaimer below appear in supporting documentation, and that 54# the names of DSC Technologies Corporation or DSC Communications 55# Corporation not be used in advertising or publicity pertaining to the 56# software without specific, written prior permission. 57# 58# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 59# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 60# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 61# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 62# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 63# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 64# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 65# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 66# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 67# SOFTWARE. 68# ====================================================================== 69 70# Acknowledgements: 71# 72# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his 73# tkhtml.tcl code from tk inspect. The original code is copyright 1995 74# Lawrence Berkeley Laboratory. 75# 76# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory. 77# 78# Redistribution and use in source and binary forms, with or without 79# modification, are permitted provided that: (1) source code distributions 80# retain the above copyright notice and this paragraph in its entirety, (2) 81# distributions including binary code include the above copyright notice and 82# this paragraph in its entirety in the documentation or other materials 83# provided with the distribution, and (3) all advertising materials mentioning 84# features or use of this software display the following acknowledgement: 85# ``This product includes software developed by the University of California, 86# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of 87# the University nor the names of its contributors may be used to endorse 88# or promote products derived from this software without specific prior 89# written permission. 90# 91# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED 92# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 93# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. 94# 95# This code is based on Angel Li's (angel@flipper.rsmas.miami.edu) HTML 96 97 98# 99# Default resources. 100# 101option add *Scrolledhtml.borderWidth 2 widgetDefault 102option add *Scrolledhtml.relief sunken widgetDefault 103option add *Scrolledhtml.scrollMargin 3 widgetDefault 104option add *Scrolledhtml.width 500 widgetDefault 105option add *Scrolledhtml.height 600 widgetDefault 106option add *Scrolledhtml.visibleItems 80x24 widgetDefault 107option add *Scrolledhtml.vscrollMode static widgetDefault 108option add *Scrolledhtml.hscrollMode static widgetDefault 109option add *Scrolledhtml.labelPos n widgetDefault 110option add *Scrolledhtml.wrap word widgetDefault 111 112# 113# Usual options. 114# 115itk::usual Scrolledhtml { 116 keep -fontname -fontsize -fixedfont -link -alink -linkhighlight \ 117 -activebackground -activerelief -background -borderwidth -cursor \ 118 -elementborderwidth -foreground -highlightcolor -highlightthickness \ 119 -insertbackground -insertborderwidth -insertofftime -insertontime \ 120 -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ 121 -selectforeground -textbackground -textfont -troughcolor -unknownimage 122} 123 124# ------------------------------------------------------------------ 125# SCROLLEDHTML 126# ------------------------------------------------------------------ 127itcl::class iwidgets::Scrolledhtml { 128 inherit iwidgets::Scrolledtext 129 130 constructor {args} {} 131 destructor {} 132 133 itk_option define -feedback feedBack FeedBack {} 134 itk_option define -linkcommand linkCommand LinkCommand {} 135 itk_option define -fontname fontname FontName times 136 itk_option define -fixedfont fixedFont FixedFont courier 137 itk_option define -fontsize fontSize FontSize medium 138 itk_option define -link link Link blue 139 itk_option define -alink alink ALink red 140 itk_option define -linkhighlight alink ALink red 141 itk_option define -unknownimage unknownimage File {} 142 itk_option define -textbackground textBackground Background {} 143 itk_option define -update update Update 1 144 itk_option define -debug debug Debug 0 145 146 public method import {args} 147 public method clear {} 148 public method render {html {wd .}} 149 public method title {} {return $_title} 150 public method pwd {} {return $_cwd} 151 152 protected method _setup {} 153 protected method _set_tag {} 154 protected method _reconfig_tags {} 155 protected method _append_text {text} 156 protected method _do {text} 157 protected method _definefont {name foundry family weight slant registry} 158 protected method _peek {instack} 159 protected method _push {instack value} 160 protected method _pop {instack} 161 protected method _parse_fields {array_var string} 162 protected method _href_click {cmd href} 163 protected method _set_align {align} 164 protected method _fixtablewidth {hottext table multiplier} 165 166 protected method _header {level args} 167 protected method _/header {level} 168 169 protected method _entity_a {args} 170 protected method _entity_/a {} 171 protected method _entity_address {} 172 protected method _entity_/address {} 173 protected method _entity_b {} 174 protected method _entity_/b {} 175 protected method _entity_base {{args {}}} 176 protected method _entity_basefont {{args {}}} 177 protected method _entity_big {} 178 protected method _entity_/big {} 179 protected method _entity_blockquote {} 180 protected method _entity_/blockquote {} 181 protected method _entity_body {{args {}}} 182 protected method _entity_/body {} 183 protected method _entity_br {{args {}}} 184 protected method _entity_center {} 185 protected method _entity_/center {} 186 protected method _entity_cite {} 187 protected method _entity_/cite {} 188 protected method _entity_code {} 189 protected method _entity_/code {} 190 protected method _entity_dir {{args {}}} 191 protected method _entity_/dir {} 192 protected method _entity_div {{args {}}} 193 protected method _entity_dl {{args {}}} 194 protected method _entity_/dl {} 195 protected method _entity_dt {} 196 protected method _entity_dd {} 197 protected method _entity_dfn {} 198 protected method _entity_/dfn {} 199 protected method _entity_em {} 200 protected method _entity_/em {} 201 protected method _entity_font {{args {}}} 202 protected method _entity_/font {} 203 protected method _entity_h1 {{args {}}} 204 protected method _entity_/h1 {} 205 protected method _entity_h2 {{args {}}} 206 protected method _entity_/h2 {} 207 protected method _entity_h3 {{args {}}} 208 protected method _entity_/h3 {} 209 protected method _entity_h4 {{args {}}} 210 protected method _entity_/h4 {} 211 protected method _entity_h5 {{args {}}} 212 protected method _entity_/h5 {} 213 protected method _entity_h6 {{args {}}} 214 protected method _entity_/h6 {} 215 protected method _entity_hr {{args {}}} 216 protected method _entity_i {} 217 protected method _entity_/i {} 218 protected method _entity_img {{args {}}} 219 protected method _entity_kbd {} 220 protected method _entity_/kbd {} 221 protected method _entity_li {{args {}}} 222 protected method _entity_listing {} 223 protected method _entity_/listing {} 224 protected method _entity_menu {{args {}}} 225 protected method _entity_/menu {} 226 protected method _entity_ol {{args {}}} 227 protected method _entity_/ol {} 228 protected method _entity_p {{args {}}} 229 protected method _entity_pre {{args {}}} 230 protected method _entity_/pre {} 231 protected method _entity_samp {} 232 protected method _entity_/samp {} 233 protected method _entity_small {} 234 protected method _entity_/small {} 235 protected method _entity_sub {} 236 protected method _entity_/sub {} 237 protected method _entity_sup {} 238 protected method _entity_/sup {} 239 protected method _entity_strong {} 240 protected method _entity_/strong {} 241 protected method _entity_table {{args {}}} 242 protected method _entity_/table {} 243 protected method _entity_td {{args {}}} 244 protected method _entity_/td {} 245 protected method _entity_th {{args {}}} 246 protected method _entity_/th {} 247 protected method _entity_title {} 248 protected method _entity_/title {} 249 protected method _entity_tr {{args {}}} 250 protected method _entity_/tr {} 251 protected method _entity_tt {} 252 protected method _entity_/tt {} 253 protected method _entity_u {} 254 protected method _entity_/u {} 255 protected method _entity_ul {{args {}}} 256 protected method _entity_/ul {} 257 protected method _entity_var {} 258 protected method _entity_/var {} 259 260 protected variable _title {} ;# The title of the html document 261 protected variable _licount 1 ;# list element count 262 protected variable _listyle bullet ;# list element style 263 protected variable _lipic {} ;# picture to use as bullet 264 protected variable _color black ;# current text color 265 protected variable _bgcolor #d9d9d9 ;# current background color 266 protected variable _link blue ;# current link color 267 protected variable _alink red ;# current highlight link color 268 protected variable _smallpoints "60 80 100 120 140 180 240" ;# font point 269 protected variable _mediumpoints "80 100 120 140 180 240 360" ;# sizes for 270 protected variable _largepoints "100 120 140 180 240 360 480" ;# various 271 protected variable _hugepoints "120 140 180 240 360 480 640" ;# fontsizes 272 protected variable _font times ;# name of current font 273 protected variable _rulerheight 6 ;# 274 protected variable _indentincr 4 ;# increment to indent by 275 protected variable _counter -1 ;# counter to give unique numbers 276 protected variable _left 0 ;# initial left margin 277 protected variable _left2 0 ;# subsequent left margin 278 protected variable _right 0 ;# right margin 279 protected variable _justify L ;# text justification 280 protected variable _offset 0 ;# text offset (super/subscript) 281 protected variable _textweight 0 ;# boldness of text 282 protected variable _textslant 0 ;# whether to use italics 283 protected variable _underline 0 ;# whether to use underline 284 protected variable _verbatim 0 ;# whether to skip formatting 285 protected variable _pre 0 ;# preformatted text 286 protected variable _intitle 0 ;# in <title>...</title> 287 protected variable _anchorcount 0 ;# number of anchors 288 protected variable _stack ;# array of stacks 289 protected variable _pointsndx 2 ;# 290 protected variable _fontnames ;# list of accepted font names 291 protected variable _fontinfo ;# array of font info given font name 292 protected variable _tag ;# 293 protected variable _tagl ;# 294 protected variable _tagfont ;# 295 protected variable _cwd . ;# base directory of current page 296 protected variable _anchor ;# array of indexes by anchorname 297 protected variable _defaulttextbackground;# default text background 298 protected variable _intable 0 ;# whether we are in a table now 299 protected variable _hottext ;# widget where text currently goes 300 protected variable _basefontsize 2 ;# as named 301 protected variable _unknownimg {} ;# name of unknown image 302 protected variable _images {} ;# list of images we created 303 protected variable _prevpos {} ;# temporary used for table updates 304 protected variable _prevtext {} ;# temporary used for table updates 305 306 private variable _initialized 0 307 308 private variable _defUnknownImg [::image create photo -data { 309R0lGODdhHwAgAPQAAP///wAAAMzMzC9PT76+vvnTogCR/1WRVaoAVf//qvT09OKdcWlcx19f 310X9/f339/f8vN/J2d/aq2qoKCggAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 311ACwAAAAAHwAgAAAF/iAgjqRDnmiKmqOkqsTaToDjvudTttLjOITJbTQhGI+iQE0xMvZqQIDw 312NAEiAcqRVdKAGh0NyVCkuyqZBEmwofgRrFIxSaI0JmuA9KTrthIicWMTAQ8xWHgSe15AVgcJ 313eVMjDwECOkome22Mb0cHCzEPOiQPgwGXCjomakedA0VgY1IPDZcuP3l5YkcRDwMHqDQoEzq2 314Pz8IQkK7Bw8HDg+xO26PCAgRDcpGswEK2Dh9ItUMDdirPYUKwTKMjwDV1gHlR2oCkSmcI9UE 315BabYrGnQoolgBCGckX7yWJWDYaUMAYSRFECAwMXeiU1BHpKTB4CBR4+oBOb5By1UNgUfXj0C 3168HaP079sBCCkZIAKWst/OGPOhNBNHQmXOeftJBASRVCcEiIojQDBwIOeRo+SpGXKFFGbP6Xi 317nLWxEMsmWpEOC9XDYtigYtKSwsH2xdq2cEfRmFS1rt27eE09CAEAOw== 318}] 319} 320 321# 322# Provide a lowercased access method for the Scrolledhtml class. 323# 324proc ::iwidgets::scrolledhtml {pathName args} { 325 uplevel ::iwidgets::Scrolledhtml $pathName $args 326} 327 328# ------------------------------------------------------------------ 329# CONSTRUCTOR 330# ------------------------------------------------------------------ 331itcl::body iwidgets::Scrolledhtml::constructor {args} { 332 # define the fonts we're going to use 333 set _fontnames "" 334 _definefont helvetica adobe helvetica "medium bold" "r o" iso8859 335 _definefont courier adobe courier "medium bold" "r o" iso8859 336 _definefont times adobe times "medium bold" "r i" iso8859 337 _definefont symbol adobe symbol "medium medium" "r r" adobe 338 339 $itk_component(text) configure -state disabled 340 341 eval itk_initialize $args 342 if {[lsearch -exact $args -linkcommand] == -1} { 343 configure -linkcommand [itcl::code $this import -link] 344 } 345 set _initialized 1 346} 347 348# ------------------------------------------------------------------ 349# DESTRUCTOR 350# ------------------------------------------------------------------ 351itcl::body iwidgets::Scrolledhtml::destructor {} { 352 foreach x $_images { 353 ::image delete $x 354 } 355 if {$_unknownimg != $_defUnknownImg} { 356 ::image delete $_unknownimg 357 } 358} 359 360# ------------------------------------------------------------------ 361# OPTIONS 362# ------------------------------------------------------------------ 363 364# ------------------------------------------------------------------ 365# OPTION: -fontsize 366# 367# Set the general size of the font. 368# ------------------------------------------------------------------ 369itcl::configbody iwidgets::Scrolledhtml::fontsize { 370 switch $itk_option(-fontsize) { 371 small { } 372 medium { } 373 large { } 374 huge { } 375 default { 376 error "bad fontsize option\ 377 \"$itk_option(-fontsize)\": should\ 378 be small, medium, large, or huge" 379 } 380 } 381 _reconfig_tags 382} 383 384# ------------------------------------------------------------------ 385# OPTION: -fixedfont 386# 387# Set the fixed font name 388# ------------------------------------------------------------------ 389itcl::configbody iwidgets::Scrolledhtml::fixedfont { 390 if {[lsearch -exact $_fontnames $itk_option(-fixedfont)] == -1} { 391 error "Invalid font name \"$itk_option(-fixedfont)\". Must be one of \ 392 $_fontnames" 393 } 394} 395 396# ------------------------------------------------------------------ 397# OPTION: -fontname 398# 399# Set the default font name 400# ------------------------------------------------------------------ 401itcl::configbody iwidgets::Scrolledhtml::fontname { 402 if {[lsearch -exact $_fontnames $itk_option(-fontname)] == -1} { 403 error "Invalid font name \"$itk_option(-fontname)\". Must be one of \ 404 $_fontnames" 405 } 406} 407 408# ------------------------------------------------------------------ 409# OPTION: -textbackground 410# 411# Set the default text background 412# ------------------------------------------------------------------ 413itcl::configbody iwidgets::Scrolledhtml::textbackground { 414 set _defaulttextbackground $itk_option(-textbackground) 415} 416 417# ------------------------------------------------------------------ 418# OPTION: -linkhighlight 419# 420# same as alink 421# ------------------------------------------------------------------ 422itcl::configbody iwidgets::Scrolledhtml::linkhighlight { 423 configure -alink $itk_option(-linkhighlight) 424} 425 426# ------------------------------------------------------------------ 427# OPTION: -unknownimage 428# 429# set image to use as substitute for images that aren't found 430# ------------------------------------------------------------------ 431itcl::configbody iwidgets::Scrolledhtml::unknownimage { 432 set oldimage $_unknownimg 433 if {$itk_option(-unknownimage) != {}} { 434 set uki $itk_option(-unknownimage) 435 if [catch { set _unknownimg [::image create photo -file $uki] } err] { 436 error "Couldn't create image $uki:\n$err\nUnknown image not found" 437 } 438 } else { 439 set _unknownimg $_defUnknownImg 440 } 441 if {$oldimage != {} && $oldimage != $_defUnknownImg} { 442 ::image delete $oldimage 443 } 444} 445 446# ------------------------------------------------------------------ 447# OPTION: -update 448# 449# boolean indicating whether to update during rendering 450# ------------------------------------------------------------------ 451itcl::configbody iwidgets::Scrolledhtml::update { 452 switch -- $itk_option(-update) { 453 0 {} 454 1 {} 455 true { 456 configure -update 1 457 } 458 yes { 459 configure -update 1 460 } 461 false { 462 configure -update 0 463 } 464 yes { 465 configure -update 0 466 } 467 default { 468 error "invalid -update; must be boolean" 469 } 470 } 471} 472 473# ------------------------------------------------------------------ 474# METHODS 475# ------------------------------------------------------------------ 476 477# ------------------------------------------------------------------ 478# METHOD: clear 479# 480# Clears the text out 481# ------------------------------------------------------------------ 482itcl::body iwidgets::Scrolledhtml::clear {} { 483 $itk_component(text) config -state normal 484 $itk_component(text) delete 1.0 end 485 foreach x $_images { 486 ::image delete $x 487 } 488 set _images {} 489 _setup 490 $itk_component(text) config -state disabled 491} 492 493# ------------------------------------------------------------------ 494# METHOD import ?-link? filename?#anchorname? 495# 496# read html text from a file (import filename) if the keyword link is present, 497# pathname is relative to last page, otherwise it is relative to current 498# directory. This allows the user to use a linkcommand of 499# "<widgetname> import -link" 500# 501# if '#anchorname' is appended to the filename, the page is displayed starting 502# at the anchor named 'anchorname' If an anchor is specified without a filename, 503# the current page is assumed. 504# ------------------------------------------------------------------ 505itcl::body iwidgets::Scrolledhtml::import {args} { 506 507 update idletasks 508 509 set len [llength $args] 510 if {$len != 1 && $len != 2} { 511 error "wrong # args: should be \ 512 \"$itk_component(hull) import ?-link? filename\"" 513 } 514 set linkname [lindex $args [expr {$len - 1}]] 515 516 # 517 # Seperate filename#anchorname 518 # 519 if ![regexp {(.*)#(.*)} $linkname dummy filename anchorname] { 520 set filename $linkname 521 } 522 if {$filename!=""} { 523 # 524 # Check for -link option 525 # 526 switch -- $len { 527 1 { 528 # 529 # open file & set cwd to that file's directory 530 # 531 set f [open $filename r] 532 set _cwd [file dirname $filename] 533 } 534 2 { 535 switch -- [lindex $args 0] { 536 -link { 537 # 538 # got -link, so set path relative to current locale, if path 539 # is a relative pathname 540 # 541 if {[string compare "." [file dirname $filename]] == 0} { 542 set f [open $_cwd/$filename r] 543 } else { 544 if {[string index [file dirname $filename] 0] != "/" &&\ 545 [string index [file dirname $filename] 0] != "~"} { 546 set f [open $_cwd/$filename r] 547 append _cwd / 548 append _cwd [file dirname $filename] 549 } else { 550 set f [open $filename r] 551 set _cwd [file dirname $filename] 552 } 553 } 554 } 555 default { 556 # got something other than -link 557 error "invalid format: should be \ 558 \"$itk_component(hull) import ?-link? filename\"" 559 } 560 } 561 } 562 } 563 set txt [read $f] 564 close $f 565 render $txt $_cwd 566 } 567 568 # 569 # if an anchor was requested, move that anchor into view 570 # 571 if [ info exists anchorname] { 572 if {$anchorname!=""} { 573 if [info exists _anchor($anchorname)] { 574 $itk_component(text) see end 575 $itk_component(text) see $_anchor($anchorname) 576 } 577 } else { 578 $itk_component(text) see 0.0 579 } 580 } 581} 582 583# ------------------------------------------------------------------ 584# METHOD: render text ?wd? 585# 586# Clear the text, then render html formatted text. Optional wd argument 587# sets the base directory for any links or images. 588# ------------------------------------------------------------------ 589itcl::body iwidgets::Scrolledhtml::render {html {wd .}} { 590 591 update idletasks 592 593 # 594 # blank text and reset all state variables 595 # 596 clear 597 set _cwd $wd 598 599 # 600 # make text writable 601 # 602 $itk_component(text) config -state normal 603 set continuerendering 1 604 _set_tag 605 while {$continuerendering} { 606 # normal state 607 while {[set len [string length $html]]} { 608 # look for text up to the next <> element 609 if [regexp -indices "^\[^<\]+" $html match] { 610 set text [string range $html 0 [lindex $match 1]] 611 _append_text "$text" 612 set html \ 613 [string range $html [expr {[lindex $match 1]+1}] end] 614 } 615 # we're either at a <>, or at the eot 616 if [regexp -indices "^<((\[^>\"\]+|(\"\[^\"\]*\"))*)>" $html match entity] { 617 regsub -all "\n" [string range $html [lindex $entity 0] \ 618 [lindex $entity 1]] "" entity 619 set cmd [string tolower [lindex $entity 0]] 620 if {[info command _entity_$cmd]!=""} { 621 if {[catch {eval _entity_$cmd [lrange $entity 1 end]} bad]} { 622 if {$itk_option(-debug)} { 623 global errorInfo 624 puts stderr "render: _entity_$cmd [lrange $entity 1 end] = Error:$bad\n$errorInfo" 625 } 626 } 627 } 628 set html \ 629 [string range $html [expr {[lindex $match 1]+1}] end] 630 } 631 if {$itk_option(-feedback) != {} } { 632 eval $itk_option(-feedback) $len 633 } 634 if $_verbatim break 635 } 636 # we reach here if html is empty, or _verbatim is 1 637 if !$len break 638 # _verbatim must be 1 639 # append text until next tag is reached 640 if [regexp -indices "<.*>" $html match] { 641 set text [string range $html 0 [expr {[lindex $match 0]-1}]] 642 set html [string range $html [expr {[lindex $match 0]}] end] 643 } else { 644 set text $html 645 set html "" 646 } 647 _append_text "$text" 648 } 649 $itk_component(text) config -state disabled 650} 651 652# ------------------------------------------------------------------ 653# PRIVATE METHOD: _setup 654# 655# Reset all state variables to prepare for a new page. 656# ------------------------------------------------------------------ 657itcl::body iwidgets::Scrolledhtml::_setup {} { 658 set _font $itk_option(-fontname) 659 set _left 0 660 set _left2 0 661 set _right 0 662 set _justify L 663 set _textweight 0 664 set _textslant 0 665 set _underline 0 666 set _verbatim 0 667 set _pre 0 668 set _title {} 669 set _intitle 0 670 set _anchorcount 0 671 set _intable 0 672 set _hottext $itk_component(text) 673 set _stack(font) {} 674 set _stack(color) {} 675 set _stack(bgcolor) {} 676 set _stack(link) {} 677 set _stack(alink) {} 678 set _stack(justify) {} 679 set _stack(listyle) {} 680 set _stack(lipic) {} 681 set _stack(href) {} 682 set _stack(pointsndx) {} 683 set _stack(left) {} 684 set _stack(left2) {} 685 set _stack(offset) {} 686 set _stack(table) {} 687 set _stack(tablewidth) {} 688 set _stack(row) {} 689 set _stack(column) {} 690 set _stack(hottext) {} 691 set _stack(tableborder) {} 692 set _stack(cellpadding) {} 693 set _stack(cellspacing) {} 694 set _stack(licount) {} 695 set _basefontsize 2 696 set _pointsndx 2 697 set _counter -1 698 set _bgcolor $_defaulttextbackground 699 set _color $itk_option(-foreground) 700 set _link $itk_option(-link) 701 set _alink $itk_option(-alink) 702 config -textbackground $_bgcolor 703 foreach x [array names _anchor] { unset _anchor($x) } 704 $itk_component(text) tag config hr -relief sunken -borderwidth 2 \ 705 -font -*-*-*-*-*-*-$_rulerheight-*-*-*-*-*-*-* 706} 707 708# ------------------------------------------------------------------ 709# PRIVATE METHOD: _definefont name foundry family weight slant registry 710# 711# define font information used to generate font value from font name 712# ------------------------------------------------------------------ 713itcl::body iwidgets::Scrolledhtml::_definefont \ 714 {name foundry family weight slant registry} { 715 if {[lsearch -exact $_fontnames $name] == -1 } { 716 lappend _fontnames $name 717 } 718 set _fontinfo($name) \ 719 [list $foundry $family $weight $slant $registry] 720} 721 722# ------------------------------------------------------------------ 723# PRIVATE METHOD: _append_text text 724# 725# append text in the format described by the state variables 726# ------------------------------------------------------------------ 727itcl::body iwidgets::Scrolledhtml::_append_text {text} { 728 if {!$_intable && $itk_option(-update)} {update} 729 if {[string first "&" $text] != -1} { 730 regsub -nocase -all "&" $text {\&} text 731 regsub -nocase -all "<" $text "<" text 732 regsub -nocase -all ">" $text ">" text 733 regsub -nocase -all """ $text "\"" text 734 } 735 if !$_verbatim { 736 if !$_pre { 737 set text [string trim $text "\n\r"] 738 regsub -all "\[ \n\r\t\]+" $text " " text 739 } 740 if ![string length $text] return 741 } 742 if {!$_pre && !$_intitle} { 743 if {[catch {$_hottext get "end - 2c"} p]} { 744 set p "" 745 } 746 set n [string index $text 0] 747 if {$n == " " && $p == " "} { 748 set text [string range $text 1 end] 749 } 750 if {[catch {$_hottext insert end $text $_tag}]} { 751 set pht [winfo parent $_hottext] 752 catch {$pht insert end $text $_tag} 753 } 754 return 755 } 756 if {$_pre && !$_intitle} { 757 if {[catch {$_hottext insert end $text $_tag}]} { 758 set pht [winfo parent $_hottext] 759 catch {$pht insert end $text $_tag} 760 } 761 return 762 } 763 append _title $text 764} 765 766# ------------------------------------------------------------------ 767# PRIVATE METHOD: _set_tag 768# 769# generate a tag 770# ------------------------------------------------------------------ 771# a tag is constructed as: font?B?I?U?Points-LeftLeft2RightColorJustify 772itcl::body iwidgets::Scrolledhtml::_set_tag {} { 773 set i -1 774 foreach var {foundry family weight slant registry} { 775 set $var [lindex $_fontinfo($_font) \ 776 [incr i]] 777 } 778 set x_font "-$foundry-$family-" 779 set _tag $_font 780 set args {} 781 if {$_textweight > 0} { 782 append _tag "B" 783 append x_font [lindex $weight 1]- 784 } else { 785 append x_font [lindex $weight 0]- 786 } 787 if {$_textslant > 0} { 788 append _tag "I" 789 append x_font [lindex $slant 1]- 790 } else { 791 append x_font [lindex $slant 0]- 792 } 793 if {$_underline > 0} { 794 append _tag "U" 795 append args " -underline 1" 796 } 797 switch $_justify { 798 L { append args " -justify left" } 799 R { append args " -justify right" } 800 C { append args " -justify center" } 801 } 802 append args " -offset $_offset" 803 804 set pts [lindex [set [format "_%spoints" $itk_option(-fontsize)]] \ 805 $_pointsndx] 806 append _tag $_pointsndx - $_left \ 807 $_left2 $_right \ 808 $_color $_justify 809 append x_font "normal-*-*-$pts-*-*-*-*-$registry-*" 810 if $_anchorcount { 811 set href [_peek href] 812 set href_tag href[incr _counter] 813 set tags [list $_tag $href_tag] 814 if { $itk_option(-linkcommand)!= {} } { 815 $_hottext tag bind $href_tag <1> \ 816 [list uplevel #0 $itk_option(-linkcommand) $href] 817 } 818 $_hottext tag bind $href_tag <Enter> \ 819 [list $_hottext tag configure $href_tag \ 820 -foreground $_alink] 821 $_hottext tag bind $href_tag <Leave> \ 822 [list $_hottext tag configure $href_tag \ 823 -foreground $_color] 824 } else { 825 set tags $_tag 826 } 827 if {![info exists _tagl($_tag)]} { 828 set _tagfont($_tag) 1 829 eval $_hottext tag configure $_tag \ 830 -foreground ${_color} \ 831 -lmargin1 ${_left}m \ 832 -lmargin2 ${_left2}m $args 833 if [catch {eval $_hottext tag configure $_tag \ 834 -font $x_font} err] { 835 _definefont $_font * $family $weight $slant * 836 regsub \$foundry $x_font * x_font 837 regsub \$registry $x_font * x_font 838 catch {eval $_hottext tag configure $_tag -font $x_font} 839 } 840 } 841 if [info exists href_tag] { 842 $_hottext tag raise $href_tag $_tag 843 } 844 set _tag $tags 845} 846 847# ------------------------------------------------------------------ 848# PRIVATE METHOD: _reconfig_tags 849# 850# reconfigure tags following a configuration change 851# ------------------------------------------------------------------ 852itcl::body iwidgets::Scrolledhtml::_reconfig_tags {} { 853 if $_initialized { 854 foreach tag [$itk_component(text) tag names] { 855 foreach efont $_fontnames { 856 if [regexp "${efont}(B?)(I?)(U?)(\[1-9\]\[0-9\]*)-" $tag t b i u points] { 857 set j -1 858 set _font $efont 859 foreach var {foundry family weight slant registry} { 860 set $var [lindex $_fontinfo($_font) [incr j]] 861 } 862 set x_font "-$foundry-$family-" 863 if {$b == "B"} { 864 append x_font [lindex $weight 1]- 865 } else { 866 append x_font [lindex $weight 0]- 867 } 868 if {$i == "I"} { 869 append x_font [lindex $slant 1]- 870 } else { 871 append x_font [lindex $slant 0]- 872 } 873 set pts [lindex [set [format \ 874 "_%spoints" $itk_option(-fontsize)]] $points] 875 append x_font "normal-*-*-$pts-*-*-*-*-$registry-*" 876 $itk_component(text) tag config $tag -font $x_font 877 break 878 } 879 } 880 } 881 } 882} 883 884# ------------------------------------------------------------------ 885# PRIVATE METHOD: _push instack value 886# 887# push value onto stack(instack) 888# ------------------------------------------------------------------ 889itcl::body iwidgets::Scrolledhtml::_push {instack value} { 890 set _stack($instack) [linsert $_stack($instack) 0 $value] 891} 892 893# ------------------------------------------------------------------ 894# PRIVATE METHOD: _pop instack 895# 896# pop value from stack(instack) 897# ------------------------------------------------------------------ 898itcl::body iwidgets::Scrolledhtml::_pop {instack} { 899 if {$_stack($instack) == ""} { 900 error "popping empty _stack $instack" 901 } 902 set val [lindex $_stack($instack) 0] 903 set _stack($instack) [lrange $_stack($instack) 1 end] 904 return $val 905} 906 907# ------------------------------------------------------------------ 908# PRIVATE METHOD: _peek instack 909# 910# peek at top value on stack(instack) 911# ------------------------------------------------------------------ 912itcl::body iwidgets::Scrolledhtml::_peek {instack} { 913 return [lindex $_stack($instack) 0] 914} 915 916# ------------------------------------------------------------------ 917# PRIVATE METHOD: _parse_fields array_var string 918# 919# parse fields from a href or image tag. At the moment, doesn't support 920# spaces in field values. (e.g. alt="not avaliable") 921# ------------------------------------------------------------------ 922itcl::body iwidgets::Scrolledhtml::_parse_fields {array_var string} { 923 upvar $array_var array 924 if {$string != "{}" } { 925 regsub -all "( *)=( *)" $string = string 926 regsub -all {\\\"} $string \" string 927 while {$string != ""} { 928 if ![regexp "^ *(\[^ \n\r=\]+)=\"(\[^\"\n\r\t\]*)(.*)" $string \ 929 dummy field value newstring] { 930 if ![regexp "^ *(\[^ \n\r=\]+)=(\[^\n\r\t \]*)(.*)" $string \ 931 dummy field value newstring] { 932 if ![regexp "^ *(\[^ \n\r\]+)(.*)" $string dummy field newstring] { 933 error "malformed command field; field = \"$string\"" 934 continue 935 } 936 set value "" 937 } 938 } 939 set array([string tolower $field]) $value 940 set string "$newstring" 941 } 942 } 943} 944 945# ------------------------------------------------------------------ 946# PRIVATE METHOD: _href_click 947# 948# process a click on an href 949# ------------------------------------------------------------------ 950itcl::body iwidgets::Scrolledhtml::_href_click {cmd href} { 951 uplevel #0 $cmd $href 952} 953 954# ------------------------------------------------------------------ 955# PRIVATE METHOD: _set_align 956# 957# set text alignment 958# ------------------------------------------------------------------ 959itcl::body iwidgets::Scrolledhtml::_set_align {align} { 960 switch [string tolower $align] { 961 center { 962 set _justify C 963 } 964 left { 965 set _justify L 966 } 967 right { 968 set _justify R 969 } 970 default {} 971 } 972} 973 974# ------------------------------------------------------------------ 975# PRIVATE METHOD: _fixtablewidth 976# 977# fix table width & height 978# essentially, with nested tables the outer table must be configured before 979# the inner table, but the idle tasks get queued up in the opposite order, 980# so process later idle tasks before sizing yourself. 981# ------------------------------------------------------------------ 982itcl::body iwidgets::Scrolledhtml::_fixtablewidth {hottext table multiplier} { 983 update idletasks 984 $hottext see $_anchor($table) 985 update idletasks 986 $table configure \ 987 -width [expr {$multiplier * [winfo width $hottext] - \ 988 2* [$hottext cget -padx] - \ 989 2* [$hottext cget -borderwidth]} ] \ 990 -height [winfo height $table] 991 grid propagate $table 0 992} 993 994 995# ------------------------------------------------------------------ 996# PRIVATE METHOD: _header level 997# 998# generic entity to set state for <hn> tag 999# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? 1000# ------------------------------------------------------------------ 1001itcl::body iwidgets::Scrolledhtml::_header {level args} { 1002 eval _parse_fields ar $args 1003 _push justify $_justify 1004 if [info exists ar(align)] { 1005 _entity_p align=$ar(align) 1006 } else { 1007 _entity_p 1008 } 1009 if [info exists ar(src)] { 1010 _entity_img src=$ar(src) 1011 } 1012 _push pointsndx $_pointsndx 1013 set _pointsndx [expr {7-$level}] 1014 incr _textweight 1015 _set_tag 1016} 1017 1018# ------------------------------------------------------------------ 1019# PRIVATE METHOD: _/header level 1020# 1021# generic entity to set state for </hn> tag 1022# ------------------------------------------------------------------ 1023itcl::body iwidgets::Scrolledhtml::_/header {level} { 1024 set _justify [_pop justify] 1025 set _pointsndx [_pop pointsndx] 1026 incr _textweight -1 1027 _set_tag 1028 _entity_p 1029} 1030 1031# ------------------------------------------------------------------ 1032# PRIVATE METHOD: _entity_a 1033# 1034# add an anchor. Accepts arguments of the form ?href=filename#anchorpoint? 1035# ?name=anchorname? 1036# ------------------------------------------------------------------ 1037itcl::body iwidgets::Scrolledhtml::_entity_a {args} { 1038 _parse_fields ar $args 1039 _push color $_color 1040 if [info exists ar(href)] { 1041 _push href $ar(href) 1042 incr _anchorcount 1043 set _color $_link 1044 _entity_u 1045 } else { 1046 _push href {} 1047 } 1048 if [info exists ar(name)] { 1049 set _anchor($ar(name)) [$itk_component(text) index end] 1050 } 1051 if [info exists ar(id)] { 1052 set _anchor($ar(id)) [$itk_component(text) index end] 1053 } 1054} 1055 1056# ------------------------------------------------------------------ 1057# PRIVATE METHOD: _entity_/a 1058# 1059# End anchor 1060# ------------------------------------------------------------------ 1061itcl::body iwidgets::Scrolledhtml::_entity_/a {} { 1062 set href [_pop href] 1063 if {$href != {}} { 1064 incr _anchorcount -1 1065 set _color [_pop color] 1066 _entity_/u 1067 } 1068} 1069 1070# ------------------------------------------------------------------ 1071# PRIVATE METHOD: _entity_address 1072# 1073# display an address 1074# ------------------------------------------------------------------ 1075itcl::body iwidgets::Scrolledhtml::_entity_address {} { 1076 _entity_br 1077 _entity_i 1078} 1079 1080# ------------------------------------------------------------------ 1081# PRIVATE METHOD: _entity_/address 1082# 1083# change state back from address display 1084# ------------------------------------------------------------------ 1085itcl::body iwidgets::Scrolledhtml::_entity_/address {} { 1086 _entity_/i 1087 _entity_br 1088} 1089 1090# ------------------------------------------------------------------ 1091# PRIVATE METHOD: _entity_b 1092# 1093# Change current font to bold 1094# ------------------------------------------------------------------ 1095itcl::body iwidgets::Scrolledhtml::_entity_b {} { 1096 incr _textweight 1097 _set_tag 1098} 1099 1100# ------------------------------------------------------------------ 1101# PRIVATE METHOD: _entity_/b 1102# 1103# change current font back from bold 1104# ------------------------------------------------------------------ 1105itcl::body iwidgets::Scrolledhtml::_entity_/b {} { 1106 incr _textweight -1 1107 _set_tag 1108} 1109 1110# ------------------------------------------------------------------ 1111# PRIVATE METHOD: _entity_base 1112# 1113# set the cwd of the document 1114# ------------------------------------------------------------------ 1115itcl::body iwidgets::Scrolledhtml::_entity_base {{args {}}} { 1116 _parse_fields ar $args 1117 if [info exists ar(href)] { 1118 set _cwd [file dirname $ar(href)] 1119 } 1120} 1121 1122# ------------------------------------------------------------------ 1123# PRIVATE METHOD: _entity_basefont 1124# 1125# set base font size 1126# ------------------------------------------------------------------ 1127itcl::body iwidgets::Scrolledhtml::_entity_basefont {{args {}}} { 1128 _parse_fields ar $args 1129 if {[info exists ar(size)]} { 1130 set _basefontsize $ar(size) 1131 } 1132} 1133 1134# ------------------------------------------------------------------ 1135# PRIVATE METHOD: _entity_big 1136# 1137# Change current font to a bigger size 1138# ------------------------------------------------------------------ 1139itcl::body iwidgets::Scrolledhtml::_entity_big {} { 1140 _push pointsndx $_pointsndx 1141 if {[incr _pointsndx 2] > 6} { 1142 set _pointsndx 6 1143 } 1144 _set_tag 1145} 1146 1147# ------------------------------------------------------------------ 1148# PRIVATE METHOD: _entity_/big 1149# 1150# change current font back from bigger size 1151# ------------------------------------------------------------------ 1152itcl::body iwidgets::Scrolledhtml::_entity_/big {} { 1153 set _pointsndx [_pop pointsndx] 1154 _set_tag 1155} 1156 1157# ------------------------------------------------------------------ 1158# PRIVATE METHOD: _entity_blockquote 1159# 1160# display a block quote 1161# ------------------------------------------------------------------ 1162itcl::body iwidgets::Scrolledhtml::_entity_blockquote {} { 1163 _entity_p 1164 _push left $_left 1165 incr _left $_indentincr 1166 _push left2 $_left2 1167 set _left2 $_left 1168 _set_tag 1169} 1170 1171# ------------------------------------------------------------------ 1172# PRIVATE METHOD: _entity_/blockquote 1173# 1174# change back from blockquote 1175# ------------------------------------------------------------------ 1176itcl::body iwidgets::Scrolledhtml::_entity_/blockquote {} { 1177 _entity_p 1178 set _left [_pop left] 1179 set _left2 [_pop left2] 1180 _set_tag 1181} 1182 1183# ------------------------------------------------------------------ 1184# PRIVATE METHOD: _entity_body 1185# 1186# begin body text. Takes argument of the form ?bgcolor=<color>? ?text=<color>? 1187# ?link=<color>? 1188# ------------------------------------------------------------------ 1189itcl::body iwidgets::Scrolledhtml::_entity_body {{args {}}} { 1190 _parse_fields ar $args 1191 if [info exists ar(bgcolor)] { 1192 set _bgcolor $ar(bgcolor) 1193 set temp $itk_option(-textbackground) 1194 config -textbackground $_bgcolor 1195 set _defaulttextbackground $temp 1196 } 1197 if [info exists ar(text)] { 1198 set _color $ar(text) 1199 } 1200 if [info exists ar(link)] { 1201 set _link $ar(link) 1202 } 1203 if [info exists ar(alink)] { 1204 set _alink $ar(alink) 1205 } 1206} 1207 1208# ------------------------------------------------------------------ 1209# PRIVATE METHOD: _entity_/body 1210# 1211# end body text 1212# ------------------------------------------------------------------ 1213itcl::body iwidgets::Scrolledhtml::_entity_/body {} { 1214} 1215 1216# ------------------------------------------------------------------ 1217# PRIVATE METHOD: _entity_br 1218# 1219# line break 1220# ------------------------------------------------------------------ 1221itcl::body iwidgets::Scrolledhtml::_entity_br {{args {}}} { 1222 $_hottext insert end "\n" 1223} 1224 1225# ------------------------------------------------------------------ 1226# PRIVATE METHOD: _entity_center 1227# 1228# change justification to center 1229# ------------------------------------------------------------------ 1230itcl::body iwidgets::Scrolledhtml::_entity_center {} { 1231 _push justify $_justify 1232 set _justify C 1233 _set_tag 1234} 1235 1236# ------------------------------------------------------------------ 1237# PRIVATE METHOD: _entity_/center 1238# 1239# change state back from center 1240# ------------------------------------------------------------------ 1241itcl::body iwidgets::Scrolledhtml::_entity_/center {} { 1242 set _justify [_pop justify] 1243 _set_tag 1244} 1245 1246# ------------------------------------------------------------------ 1247# PRIVATE METHOD: _entity_cite 1248# 1249# display citation 1250# ------------------------------------------------------------------ 1251itcl::body iwidgets::Scrolledhtml::_entity_cite {} { 1252 _entity_i 1253} 1254 1255# ------------------------------------------------------------------ 1256# PRIVATE METHOD: _entity_/cite 1257# 1258# change state back from citation 1259# ------------------------------------------------------------------ 1260itcl::body iwidgets::Scrolledhtml::_entity_/cite {} { 1261 _entity_/i 1262} 1263 1264# ------------------------------------------------------------------ 1265# PRIVATE METHOD: _entity_code 1266# 1267# display code listing 1268# ------------------------------------------------------------------ 1269itcl::body iwidgets::Scrolledhtml::_entity_code {} { 1270 _entity_pre 1271} 1272 1273# ------------------------------------------------------------------ 1274# PRIVATE METHOD: _entity_/code 1275# 1276# end code listing 1277# ------------------------------------------------------------------ 1278itcl::body iwidgets::Scrolledhtml::_entity_/code {} { 1279 _entity_/pre 1280} 1281 1282# ------------------------------------------------------------------ 1283# PRIVATE METHOD: _entity_dir 1284# 1285# display dir list 1286# ------------------------------------------------------------------ 1287itcl::body iwidgets::Scrolledhtml::_entity_dir {{args {}}} { 1288 _entity_ul plain $args 1289} 1290 1291# ------------------------------------------------------------------ 1292# PRIVATE METHOD: _entity_/dir 1293# 1294# end dir list 1295# ------------------------------------------------------------------ 1296itcl::body iwidgets::Scrolledhtml::_entity_/dir {} { 1297 _entity_/ul 1298} 1299 1300# ------------------------------------------------------------------ 1301# PRIVATE METHOD: _entity_div 1302# 1303# divide text. same as <p> 1304# ------------------------------------------------------------------ 1305itcl::body iwidgets::Scrolledhtml::_entity_div {{args {}}} { 1306 _entity_p $args 1307} 1308 1309# ------------------------------------------------------------------ 1310# PRIVATE METHOD: _entity_dl 1311# 1312# begin definition list 1313# ------------------------------------------------------------------ 1314itcl::body iwidgets::Scrolledhtml::_entity_dl {{args {}}} { 1315 if {$_left == 0} { 1316 _entity_p 1317 } 1318 _push left $_left 1319 _push left2 $_left2 1320 if {$_left2 == $_left } { 1321 incr _left2 [expr {$_indentincr+3}] 1322 } else { 1323 incr _left2 $_indentincr 1324 } 1325 incr _left $_indentincr 1326 _push listyle $_listyle 1327 _push licount $_licount 1328 set _listyle none 1329 _set_tag 1330} 1331 1332# ------------------------------------------------------------------ 1333# PRIVATE METHOD: _entity_/dl 1334# 1335# end definition list 1336# ------------------------------------------------------------------ 1337itcl::body iwidgets::Scrolledhtml::_entity_/dl {} { 1338 set _left [_pop left] 1339 set _left2 [_pop left2] 1340 set _listyle [_pop listyle] 1341 set _licount [_pop licount] 1342 _set_tag 1343 if {$_left == 0} { 1344 _entity_p 1345 } 1346} 1347 1348# ------------------------------------------------------------------ 1349# PRIVATE METHOD: _entity_dt 1350# 1351# definition term 1352# ------------------------------------------------------------------ 1353itcl::body iwidgets::Scrolledhtml::_entity_dt {} { 1354 set _left [expr {$_left2 - 3}] 1355 _set_tag 1356 _entity_p 1357} 1358 1359# ------------------------------------------------------------------ 1360# PRIVATE METHOD: _entity_dd 1361# 1362# definition definition 1363# ------------------------------------------------------------------ 1364itcl::body iwidgets::Scrolledhtml::_entity_dd {} { 1365 set _left $_left2 1366 _set_tag 1367 _entity_br 1368} 1369 1370# ------------------------------------------------------------------ 1371# PRIVATE METHOD: _entity_dfn 1372# 1373# display defining instance of a term 1374# ------------------------------------------------------------------ 1375itcl::body iwidgets::Scrolledhtml::_entity_dfn {} { 1376 _entity_i 1377 _entity_b 1378} 1379 1380# ------------------------------------------------------------------ 1381# PRIVATE METHOD: _entity_/dfn 1382# 1383# change state back from defining instance of term 1384# ------------------------------------------------------------------ 1385itcl::body iwidgets::Scrolledhtml::_entity_/dfn {} { 1386 _entity_/b 1387 _entity_/i 1388} 1389 1390# ------------------------------------------------------------------ 1391# PRIVATE METHOD: _entity_em 1392# 1393# display emphasized text 1394# ------------------------------------------------------------------ 1395itcl::body iwidgets::Scrolledhtml::_entity_em {} { 1396 _entity_i 1397} 1398 1399# ------------------------------------------------------------------ 1400# PRIVATE METHOD: _entity_/em 1401# 1402# change state back from emphasized text 1403# ------------------------------------------------------------------ 1404itcl::body iwidgets::Scrolledhtml::_entity_/em {} { 1405 _entity_/i 1406} 1407 1408# ------------------------------------------------------------------ 1409# PRIVATE METHOD: _entity_font 1410# 1411# set font size and color 1412# ------------------------------------------------------------------ 1413itcl::body iwidgets::Scrolledhtml::_entity_font {{args {}}} { 1414 _parse_fields ar $args 1415 _push pointsndx $_pointsndx 1416 _push color $_color 1417 if [info exists ar(size)] { 1418 if {![regexp {^[+-].*} $ar(size)]} { 1419 set _pointsndx $ar(size) 1420 } else { 1421 set _pointsndx [expr $_basefontsize $ar(size)] 1422 } 1423 if { $_pointsndx > 6 } { 1424 set _pointsndx 6 1425 } else { 1426 if { $_pointsndx < 0 } { 1427 set _pointsndx 0 1428 } 1429 } 1430 } 1431 if {[info exists ar(color)]} { 1432 set _color $ar(color) 1433 } 1434 _set_tag 1435} 1436 1437# ------------------------------------------------------------------ 1438# PRIVATE METHOD: _entity_/font 1439# 1440# close current font size 1441# ------------------------------------------------------------------ 1442itcl::body iwidgets::Scrolledhtml::_entity_/font {} { 1443 set _pointsndx [_pop pointsndx] 1444 set _color [_pop color] 1445 _set_tag 1446} 1447 1448# ------------------------------------------------------------------ 1449# PRIVATE METHOD: _entity_h1 1450# 1451# display header level 1. 1452# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? 1453# ------------------------------------------------------------------ 1454itcl::body iwidgets::Scrolledhtml::_entity_h1 {{args {}}} { 1455 _header 1 $args 1456} 1457 1458# ------------------------------------------------------------------ 1459# PRIVATE METHOD: _entity_/h1 1460# 1461# change state back from header 1 1462# ------------------------------------------------------------------ 1463itcl::body iwidgets::Scrolledhtml::_entity_/h1 {} { 1464 _/header 1 1465} 1466 1467# ------------------------------------------------------------------ 1468# PRIVATE METHOD: _entity_h2 1469# 1470# display header level 2 1471# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? 1472# ------------------------------------------------------------------ 1473itcl::body iwidgets::Scrolledhtml::_entity_h2 {{args {}}} { 1474 _header 2 $args 1475} 1476 1477# ------------------------------------------------------------------ 1478# PRIVATE METHOD: _entity_/h2 1479# 1480# change state back from header 2 1481# ------------------------------------------------------------------ 1482itcl::body iwidgets::Scrolledhtml::_entity_/h2 {} { 1483 _/header 2 1484} 1485 1486# ------------------------------------------------------------------ 1487# PRIVATE METHOD: _entity_h3 1488# 1489# display header level 3 1490# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? 1491# ------------------------------------------------------------------ 1492itcl::body iwidgets::Scrolledhtml::_entity_h3 {{args {}}} { 1493 _header 3 $args 1494} 1495 1496# ------------------------------------------------------------------ 1497# PRIVATE METHOD: _entity_/h3 1498# 1499# change state back from header 3 1500# ------------------------------------------------------------------ 1501itcl::body iwidgets::Scrolledhtml::_entity_/h3 {} { 1502 _/header 3 1503} 1504 1505# ------------------------------------------------------------------ 1506# PRIVATE METHOD: _entity_h4 1507# 1508# display header level 4 1509# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? 1510# ------------------------------------------------------------------ 1511itcl::body iwidgets::Scrolledhtml::_entity_h4 {{args {}}} { 1512 _header 4 $args 1513} 1514 1515# ------------------------------------------------------------------ 1516# PRIVATE METHOD: _entity_/h4 1517# 1518# change state back from header 4 1519# ------------------------------------------------------------------ 1520itcl::body iwidgets::Scrolledhtml::_entity_/h4 {} { 1521 _/header 4 1522} 1523 1524# ------------------------------------------------------------------ 1525# PRIVATE METHOD: _entity_h5 1526# 1527# display header level 5 1528# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? 1529# ------------------------------------------------------------------ 1530itcl::body iwidgets::Scrolledhtml::_entity_h5 {{args {}}} { 1531 _header 5 $args 1532} 1533 1534# ------------------------------------------------------------------ 1535# PRIVATE METHOD: _entity_/h5 1536# 1537# change state back from header 5 1538# ------------------------------------------------------------------ 1539itcl::body iwidgets::Scrolledhtml::_entity_/h5 {} { 1540 _/header 5 1541} 1542 1543# ------------------------------------------------------------------ 1544# PRIVATE METHOD: _entity_h6 1545# 1546# display header level 6 1547# ------------------------------------------------------------------ 1548itcl::body iwidgets::Scrolledhtml::_entity_h6 {{args {}}} { 1549 _header 6 $args 1550} 1551 1552# ------------------------------------------------------------------ 1553# PRIVATE METHOD: _entity_/h6 1554# 1555# change state back from header 6 1556# ------------------------------------------------------------------ 1557itcl::body iwidgets::Scrolledhtml::_entity_/h6 {} { 1558 _/header 6 1559} 1560 1561# ------------------------------------------------------------------ 1562# PRIVATE METHOD: _entity_hr 1563# 1564# Add a horizontal rule 1565# ------------------------------------------------------------------ 1566itcl::body iwidgets::Scrolledhtml::_entity_hr {{args {}}} { 1567 _parse_fields ar $args 1568 if [info exists ar(size)] { 1569 set font "-font -*-*-*-*-*-*-$ar(size)-*-*-*-*-*-*-*" 1570 } else { 1571 set font "-font -*-*-*-*-*-*-2-*-*-*-*-*-*-*" 1572 } 1573 if [info exists ar(width)] { 1574 } 1575 if [info exists ar(noshade)] { 1576 set relief "-relief flat" 1577 set background "-background black" 1578 } else { 1579 set relief "-relief sunken" 1580 set background "" 1581 } 1582# if [info exists ar(align)] { 1583# $_hottext tag config hr$_counter -justify $ar(align) 1584# set justify -justify $ar(align) 1585# } else { 1586# set justify "" 1587# } 1588 eval $_hottext tag config hr[incr _counter] $relief $background $font \ 1589 -borderwidth 2 1590 _entity_p 1591 $_hottext insert end " \n" hr$_counter 1592} 1593 1594# ------------------------------------------------------------------ 1595# PRIVATE METHOD: _entity_i 1596# 1597# display italicized text 1598# ------------------------------------------------------------------ 1599itcl::body iwidgets::Scrolledhtml::_entity_i {} { 1600 incr _textslant 1601 _set_tag 1602} 1603 1604# ------------------------------------------------------------------ 1605# PRIVATE METHOD: _entity_/i 1606# 1607# change state back from italicized text 1608# ------------------------------------------------------------------ 1609itcl::body iwidgets::Scrolledhtml::_entity_/i {} { 1610 incr _textslant -1 1611 _set_tag 1612} 1613 1614# ------------------------------------------------------------------ 1615# PRIVATE METHOD: _entity_img 1616# 1617# display an image. takes argument of the form img=<filename> 1618# ------------------------------------------------------------------ 1619itcl::body iwidgets::Scrolledhtml::_entity_img {{args {}}} { 1620 _parse_fields ar $args 1621 set alttext "<image>" 1622 1623 # 1624 # If proper argument exists 1625 # 1626 if [info exists ar(src)] { 1627 set imgframe $_hottext.img[incr _counter] 1628 # 1629 # if this is an anchor 1630 # 1631 if $_anchorcount { 1632 # create link colored border 1633 frame $imgframe -borderwidth 2 -background $_link 1634 bind $imgframe <Enter> \ 1635 [list $imgframe configure -background $_alink] 1636 bind $imgframe <Leave> \ 1637 [list $imgframe configure -background $_link] 1638 } else { 1639 # create plain frame 1640 frame $imgframe -borderwidth 0 -background $_color 1641 } 1642 1643 # 1644 # try to load image 1645 # 1646 if {[string index $ar(src) 0] == "/" || [string index $ar(src) 0] == "~"} { 1647 set file $ar(src) 1648 } else { 1649 set file $_cwd/$ar(src) 1650 } 1651 if [catch {set img [::image create photo -file $file]} err] { 1652 if {[info exists ar(width)] && [info exists ar(height)] } { 1653 # suggestions exist, so make frame appropriate size and add a border 1654 $imgframe configure -width $ar(width) -height $ar(height) -borderwidth 2 1655 pack propagate $imgframe false 1656 } 1657 1658 # 1659 # If alt text is specified, display that 1660 # 1661 if [info exists ar(alt)] { 1662 # add a border 1663 $imgframe configure -borderwidth 2 1664 set win $imgframe.text 1665 label $win -text "$ar(alt)" -background $_bgcolor \ 1666 -foreground $_color 1667 } else { 1668 # 1669 # use 'unknown image' 1670 set win $imgframe.image#auto 1671 # 1672 # make label containing image 1673 # 1674 label $win -image $_unknownimg -borderwidth 0 -background $_bgcolor 1675 } 1676 pack $win -fill both -expand true 1677 1678 } else { ;# no error loading image 1679 lappend _images $img 1680 set win $imgframe.$img 1681 1682 # 1683 # make label containing image 1684 # 1685 label $win -image $img -borderwidth 0 1686 } 1687 pack $win 1688 1689 # 1690 # set alignment 1691 # 1692 set align bottom 1693 if [info exists ar(align)] { 1694 switch $ar(align) { 1695 middle { 1696 set align center 1697 } 1698 right { 1699 set align center 1700 } 1701 default { 1702 set align [string tolower $ar(align)] 1703 } 1704 } 1705 } 1706 1707 # 1708 # create window in text to display image 1709 # 1710 $_hottext window create end -window \ 1711 $imgframe -align $align 1712 1713 # 1714 # set tag for window 1715 # 1716 $_hottext tag add $_tag $imgframe 1717 if $_anchorcount { 1718 set href [_peek href] 1719 set href_tag href[incr _counter] 1720 set tags [list $_tag $href_tag] 1721 if { $itk_option(-linkcommand)!= {} } { 1722 bind $win <1> [list uplevel #0 $itk_option(-linkcommand) $href] 1723 } 1724 } 1725 } 1726} 1727 1728# ------------------------------------------------------------------ 1729# PRIVATE METHOD: _entity_kbd 1730# 1731# Display keyboard input 1732# ------------------------------------------------------------------ 1733itcl::body iwidgets::Scrolledhtml::_entity_kbd {} { 1734 incr _textweight 1735 _entity_tt 1736 _set_tag 1737} 1738 1739# ------------------------------------------------------------------ 1740# PRIVATE METHOD: _entity_/kbd 1741# 1742# change state back from displaying keyboard input 1743# ------------------------------------------------------------------ 1744itcl::body iwidgets::Scrolledhtml::_entity_/kbd {} { 1745 _entity_/tt 1746 incr _textweight -1 1747 _set_tag 1748} 1749 1750# ------------------------------------------------------------------ 1751# PRIVATE METHOD: _entity_li 1752# 1753# begin new list entry 1754# ------------------------------------------------------------------ 1755itcl::body iwidgets::Scrolledhtml::_entity_li {{args {}}} { 1756 _parse_fields ar $args 1757 if [info exists ar(value)] { 1758 set _licount $ar(value) 1759 } 1760 _entity_br 1761 switch -exact $_listyle { 1762 bullet { 1763 set old_font $_font 1764 set _font symbol 1765 _set_tag 1766 $_hottext insert end "\xb7" $_tag 1767 set _font $old_font 1768 _set_tag 1769 } 1770 none { 1771 } 1772 picture { 1773 _entity_img src="$_lipic" width=4 height=4 align=middle 1774 } 1775 A { 1776 _entity_b 1777 $_hottext insert end [format "%c) " [expr {$_licount + 0x40}]] $_tag 1778 _entity_/b 1779 incr _licount 1780 } 1781 a { 1782 _entity_b 1783 $_hottext insert end [format "%c) " [expr {$_licount + 0x60}]] $_tag 1784 _entity_/b 1785 incr _licount 1786 } 1787 I { 1788 _entity_b 1789 $_hottext insert end "[::iwidgets::roman $_licount]) " $_tag 1790 _entity_/b 1791 incr _licount 1792 } 1793 i { 1794 _entity_b 1795 $_hottext insert end "[::iwidgets::roman $_licount lower])] " $_tag 1796 _entity_/b 1797 incr _licount 1798 } 1799 default { 1800 _entity_b 1801 $_hottext insert end "$_licount) " $_tag 1802 _entity_/b 1803 incr _licount 1804 } 1805 } 1806} 1807 1808# ------------------------------------------------------------------ 1809# PRIVATE METHOD: _entity_listing 1810# 1811# diplay code listing 1812# ------------------------------------------------------------------ 1813itcl::body iwidgets::Scrolledhtml::_entity_listing {} { 1814 _entity_pre 1815} 1816 1817# ------------------------------------------------------------------ 1818# PRIVATE METHOD: _entity_/listing 1819# 1820# end code listing 1821# ------------------------------------------------------------------ 1822itcl::body iwidgets::Scrolledhtml::_entity_/listing {} { 1823 _entity_/pre 1824} 1825 1826# ------------------------------------------------------------------ 1827# PRIVATE METHOD: _entity_menu 1828# 1829# diplay menu list 1830# ------------------------------------------------------------------ 1831itcl::body iwidgets::Scrolledhtml::_entity_menu {{args {}}} { 1832 _entity_ul plain $args 1833} 1834 1835# ------------------------------------------------------------------ 1836# PRIVATE METHOD: _entity_/menu 1837# 1838# end menu list 1839# ------------------------------------------------------------------ 1840itcl::body iwidgets::Scrolledhtml::_entity_/menu {} { 1841 _entity_/ul 1842} 1843 1844# ------------------------------------------------------------------ 1845# PRIVATE METHOD: _entity_ol 1846# 1847# begin ordered list 1848# ------------------------------------------------------------------ 1849itcl::body iwidgets::Scrolledhtml::_entity_ol {{args {}}} { 1850 _parse_fields ar $args 1851 if $_left { 1852 _entity_br 1853 } else { 1854 _entity_p 1855 } 1856 if {![info exists ar(type)]} { 1857 set ar(type) 1 1858 } 1859 _push licount $_licount 1860 if [info exists ar(start)] { 1861 set _licount $ar(start) 1862 } else { 1863 set _licount 1 1864 } 1865 _push left $_left 1866 _push left2 $_left2 1867 if {$_left2 == $_left } { 1868 incr _left2 [expr {$_indentincr+3}] 1869 } else { 1870 incr _left2 $_indentincr 1871 } 1872 incr _left $_indentincr 1873 _push listyle $_listyle 1874 set _listyle $ar(type) 1875 _set_tag 1876} 1877 1878# ------------------------------------------------------------------ 1879# PRIVATE METHOD: _entity_/ol 1880# 1881# end ordered list 1882# ------------------------------------------------------------------ 1883itcl::body iwidgets::Scrolledhtml::_entity_/ol {} { 1884 set _left [_pop left] 1885 set _left2 [_pop left2] 1886 set _listyle [_pop listyle] 1887 set _licount [_pop licount] 1888 _set_tag 1889 _entity_p 1890} 1891 1892# ------------------------------------------------------------------ 1893# PRIVATE METHOD: _entity_p 1894# 1895# paragraph break 1896# ------------------------------------------------------------------ 1897itcl::body iwidgets::Scrolledhtml::_entity_p {{args {}}} { 1898 _parse_fields ar $args 1899 if [info exists ar(align)] { 1900 _set_align $ar(align) 1901 } else { 1902 set _justify L 1903 } 1904 _set_tag 1905 if [info exists ar(id)] { 1906 set _anchor($ar(id)) [$itk_component(text) index end] 1907 } 1908 set x [$_hottext get end-3c] 1909 set y [$_hottext get end-2c] 1910 if {$x == "" && $y == ""} return 1911 if {$y == ""} { 1912 $_hottext insert end "\n\n" 1913 return 1914 } 1915 if {$x == "\n" && $y == "\n"} return 1916 if {$y == "\n"} { 1917 $_hottext insert end "\n" 1918 return 1919 } 1920 $_hottext insert end "\n\n" 1921} 1922 1923# ------------------------------------------------------------------ 1924# PRIVATE METHOD: _entity_pre 1925# 1926# display preformatted text 1927# ------------------------------------------------------------------ 1928itcl::body iwidgets::Scrolledhtml::_entity_pre {{args {}}} { 1929 _entity_tt 1930 _entity_br 1931 incr _pre 1932} 1933 1934# ------------------------------------------------------------------ 1935# PRIVATE METHOD: _entity_/pre 1936# 1937# change state back from preformatted text 1938# ------------------------------------------------------------------ 1939itcl::body iwidgets::Scrolledhtml::_entity_/pre {} { 1940 _entity_/tt 1941 set _pre 0 1942 _entity_p 1943} 1944 1945# ------------------------------------------------------------------ 1946# PRIVATE METHOD: _entity_samp 1947# 1948# display sample text. 1949# ------------------------------------------------------------------ 1950itcl::body iwidgets::Scrolledhtml::_entity_samp {} { 1951 _entity_kbd 1952} 1953 1954# ------------------------------------------------------------------ 1955# PRIVATE METHOD: _entity_/samp 1956# 1957# switch back to non-sample text 1958# ------------------------------------------------------------------ 1959itcl::body iwidgets::Scrolledhtml::_entity_/samp {} { 1960 _entity_/kbd 1961} 1962 1963# ------------------------------------------------------------------ 1964# PRIVATE METHOD: _entity_small 1965# 1966# Change current font to a smaller size 1967# ------------------------------------------------------------------ 1968itcl::body iwidgets::Scrolledhtml::_entity_small {} { 1969 _push pointsndx $_pointsndx 1970 if {[incr _pointsndx -2] < 0} { 1971 set _pointsndx 0 1972 } 1973 _set_tag 1974} 1975 1976# ------------------------------------------------------------------ 1977# PRIVATE METHOD: _entity_/small 1978# 1979# change current font back from smaller size 1980# ------------------------------------------------------------------ 1981itcl::body iwidgets::Scrolledhtml::_entity_/small {} { 1982 set _pointsndx [_pop pointsndx] 1983 _set_tag 1984} 1985 1986# ------------------------------------------------------------------ 1987# PRIVATE METHOD: _entity_sub 1988# 1989# display subscript 1990# ------------------------------------------------------------------ 1991itcl::body iwidgets::Scrolledhtml::_entity_sub {} { 1992 _push offset $_offset 1993 incr _offset -2 1994 _entity_small 1995} 1996 1997# ------------------------------------------------------------------ 1998# PRIVATE METHOD: _entity_/sub 1999# 2000# switch back to non-subscript 2001# ------------------------------------------------------------------ 2002itcl::body iwidgets::Scrolledhtml::_entity_/sub {} { 2003 set _offset [_pop offset] 2004 _entity_/small 2005} 2006 2007# ------------------------------------------------------------------ 2008# PRIVATE METHOD: _entity_sup 2009# 2010# display superscript 2011# ------------------------------------------------------------------ 2012itcl::body iwidgets::Scrolledhtml::_entity_sup {} { 2013 _push offset $_offset 2014 incr _offset 4 2015 _entity_small 2016} 2017 2018# ------------------------------------------------------------------ 2019# PRIVATE METHOD: _entity_/sup 2020# 2021# switch back to non-superscript 2022# ------------------------------------------------------------------ 2023itcl::body iwidgets::Scrolledhtml::_entity_/sup {} { 2024 set _offset [_pop offset] 2025 _entity_/small 2026} 2027 2028# ------------------------------------------------------------------ 2029# PRIVATE METHOD: _entity_strong 2030# 2031# display strong text. (i.e. make font bold) 2032# ------------------------------------------------------------------ 2033itcl::body iwidgets::Scrolledhtml::_entity_strong {} { 2034 incr _textweight 2035 _set_tag 2036} 2037 2038# ------------------------------------------------------------------ 2039# PRIVATE METHOD: _entity_/strong 2040# 2041# switch back to non-strong text 2042# ------------------------------------------------------------------ 2043itcl::body iwidgets::Scrolledhtml::_entity_/strong {} { 2044 incr _textweight -1 2045 _set_tag 2046} 2047 2048# ------------------------------------------------------------------ 2049# PRIVATE METHOD: _entity_table 2050# 2051# display a table. 2052# ------------------------------------------------------------------ 2053itcl::body iwidgets::Scrolledhtml::_entity_table {{args {}}} { 2054 _parse_fields ar $args 2055 _entity_p 2056 set _intable 1 2057 2058 _push row -1 2059 _push column 0 2060 _push hottext $_hottext 2061 _push justify $_justify 2062 _push justify L 2063 # push color information for master of table, then push info for table 2064 _push color $_color 2065 _push bgcolor $_bgcolor 2066 _push link $_link 2067 _push alink $_alink 2068 if [info exists ar(bgcolor)] { 2069 set _bgcolor $ar(bgcolor) 2070 } 2071 if [info exists ar(text)] { 2072 set _color $ar(text) 2073 } 2074 if [info exists ar(link)] { 2075 set _link $ar(link) 2076 } 2077 if [info exists ar(alink)] { 2078 set _alink $ar(alink) 2079 } 2080 _push color $_color 2081 _push bgcolor $_bgcolor 2082 _push link $_link 2083 _push alink $_alink 2084 # push fake first row to avoid using optional /tr tag 2085 # (This needs to set a real color - not the empty string 2086 # becaule later code will try to use those values.) 2087 _push color $_color 2088 _push bgcolor $_bgcolor 2089 _push link {} 2090 _push alink {} 2091 2092 if {[info exists ar(align)]} { 2093 _set_align $ar(align) 2094 _set_tag 2095 _append_text " " 2096 } 2097 set _justify L 2098 2099 if [info exists ar(id)] { 2100 set _anchor($ar(id)) [$itk_component(text) index end] 2101 } 2102 if [info exists ar(cellpadding)] { 2103 _push cellpadding $ar(cellpadding) 2104 } else { 2105 _push cellpadding 0 2106 } 2107 if [info exists ar(cellspacing)] { 2108 _push cellspacing $ar(cellspacing) 2109 } else { 2110 _push cellspacing 0 2111 } 2112 if {[info exists ar(border)]} { 2113 _push tableborder 1 2114 set relief raised 2115 if {$ar(border)==""} { 2116 set ar(border) 2 2117 } 2118 } else { 2119 _push tableborder 0 2120 set relief flat 2121 set ar(border) 2 2122 } 2123 _push table [set table $_hottext.table[incr _counter]] 2124 iwidgets::labeledwidget $table -foreground $_color -background $_bgcolor -labelpos n 2125 if {[info exists ar(title)]} { 2126 $table configure -labeltext $ar(title) 2127 } 2128 # 2129 # create window in text to display table 2130 # 2131 $_hottext window create end -window $table 2132 2133 set table [$table childsite] 2134 set _anchor($table) [$_hottext index "end - 1 line"] 2135 $table configure -borderwidth $ar(border) -relief $relief 2136 2137 if {[info exists ar(width)]} { 2138 _push tablewidth $ar(width) 2139 } else { 2140 _push tablewidth 0 2141 } 2142} 2143 2144# ------------------------------------------------------------------ 2145# PRIVATE METHOD: _entity_/table 2146# 2147# end table 2148# ------------------------------------------------------------------ 2149itcl::body iwidgets::Scrolledhtml::_entity_/table {} { 2150 if {$_intable} { 2151 _pop tableborder 2152 set table [[_pop table] childsite] 2153 _pop row 2154 _pop column 2155 _pop cellspacing 2156 _pop cellpadding 2157 # pop last row's defaults 2158 _pop color 2159 _pop bgcolor 2160 _pop link 2161 _pop alink 2162 # pop table defaults 2163 _pop color 2164 _pop bgcolor 2165 _pop link 2166 _pop alink 2167 # restore table master defaults 2168 set _color [_pop color] 2169 set _bgcolor [_pop bgcolor] 2170 set _link [_pop link] 2171 set _alink [_pop alink] 2172 foreach x [grid slaves $table] { 2173 set text [$x get 1.0 end] 2174 set tl [split $text \n] 2175 set max 0 2176 foreach l $tl { 2177 set len [string length $l] 2178 if {$len > $max} { 2179 set max $len 2180 } 2181 } 2182 if {$max > [$x cget -width]} { 2183 $x configure -width $max 2184 } 2185 if {[$x cget -height] == 1} { 2186 $x configure -height [lindex [split [$x index "end - 1 chars"] "."] 0] 2187 } 2188 } 2189 $_hottext configure -state disabled 2190 set _hottext [_pop hottext] 2191 $_hottext configure -state normal 2192 if {[set tablewidth [_pop tablewidth]]!="0"} { 2193 if {[string index $tablewidth \ 2194 [expr {[string length $tablewidth] -1}]] == "%"} { 2195 set multiplier [expr {[string trimright $tablewidth "%"] / 100.0}] 2196 set idletask [after idle [itcl::code "$this _fixtablewidth $_hottext $table $multiplier"]] 2197 } else { 2198 $table configure -width $tablewidth 2199 grid propagate $table 0 2200 } 2201 } 2202 _pop justify 2203 set _justify [_pop justify] 2204 _entity_br 2205 } 2206} 2207 2208# ------------------------------------------------------------------ 2209# PRIVATE METHOD: _entity_td 2210# 2211# start table data cell 2212# ------------------------------------------------------------------ 2213itcl::body iwidgets::Scrolledhtml::_entity_td {{args {}}} { 2214 if $_intable { 2215 _parse_fields ar $args 2216 set table [[_peek table] childsite] 2217 if {![info exists ar(colspan)]} { 2218 set ar(colspan) 1 2219 } 2220 if {![info exists ar(rowspan)]} { 2221 set ar(rowspan) 1 2222 } 2223 if {![info exists ar(width)]} { 2224 set ar(width) 10 2225 } 2226 if {![info exists ar(height)]} { 2227 set ar(height) 0 2228 } 2229 if [info exists ar(bgcolor)] { 2230 set _bgcolor $ar(bgcolor) 2231 } else { 2232 set _bgcolor [_peek bgcolor] 2233 } 2234 if [info exists ar(text)] { 2235 set _color $ar(text) 2236 } else { 2237 set _color [_peek color] 2238 } 2239 if [info exists ar(link)] { 2240 set _link $ar(link) 2241 } else { 2242 set _link [_peek link] 2243 } 2244 if [info exists ar(alink)] { 2245 set _alink $ar(alink) 2246 } else { 2247 set _alink [_peek alink] 2248 } 2249 $_hottext configure -state disabled 2250 set cellpadding [_peek cellpadding] 2251 set cellspacing [_peek cellspacing] 2252 set _hottext $table.cell[incr _counter] 2253 text $_hottext -relief flat -width $ar(width) -height $ar(height) \ 2254 -highlightthickness 0 -wrap word -cursor $itk_option(-cursor) \ 2255 -wrap word -cursor $itk_option(-cursor) \ 2256 -padx $cellpadding -pady $cellpadding 2257 if {$_color != ""} { 2258 $_hottext config -foreground $_color 2259 } 2260 if {$_bgcolor != ""} { 2261 $_hottext config -background $_bgcolor 2262 } 2263 if [info exists ar(nowrap)] { 2264 $_hottext configure -wrap none 2265 } 2266 if [_peek tableborder] { 2267 $_hottext configure -relief sunken 2268 } 2269 set row [_peek row] 2270 if {$row < 0} { 2271 set row 0 2272 } 2273 set column [_pop column] 2274 if {$column < 0} { 2275 set column 0 2276 } 2277 while {[grid slaves $table -row $row -column $column] != ""} { 2278 incr column 2279 } 2280 grid $_hottext -sticky nsew -row $row -column $column \ 2281 -columnspan $ar(colspan) -rowspan $ar(rowspan) \ 2282 -padx $cellspacing -pady $cellspacing 2283 grid columnconfigure $table $column -weight 1 2284 _push column [expr {$column + $ar(colspan)}] 2285 if [info exists ar(align)] { 2286 _set_align $ar(align) 2287 } else { 2288 set _justify [_peek justify] 2289 } 2290 _set_tag 2291 } 2292} 2293 2294# ------------------------------------------------------------------ 2295# PRIVATE METHOD: _entity_/td 2296# 2297# end table data cell 2298# ------------------------------------------------------------------ 2299itcl::body iwidgets::Scrolledhtml::_entity_/td {} { 2300} 2301 2302# ------------------------------------------------------------------ 2303# PRIVATE METHOD: _entity_th 2304# 2305# start table header 2306# ------------------------------------------------------------------ 2307itcl::body iwidgets::Scrolledhtml::_entity_th {{args {}}} { 2308 if $_intable { 2309 _parse_fields ar $args 2310 if [info exists ar(align)] { 2311 _entity_td $args 2312 } else { 2313 _entity_td align=center $args 2314 } 2315 _entity_b 2316 } 2317} 2318 2319# ------------------------------------------------------------------ 2320# PRIVATE METHOD: _entity_/th 2321# 2322# end table data cell 2323# ------------------------------------------------------------------ 2324itcl::body iwidgets::Scrolledhtml::_entity_/th {} { 2325 _entity_/td 2326} 2327 2328# ------------------------------------------------------------------ 2329# PRIVATE METHOD: _entity_title 2330# 2331# begin title of document 2332# ------------------------------------------------------------------ 2333itcl::body iwidgets::Scrolledhtml::_entity_title {} { 2334 set _intitle 1 2335} 2336 2337# ------------------------------------------------------------------ 2338# PRIVATE METHOD: _entity_/title 2339# 2340# end title 2341# ------------------------------------------------------------------ 2342itcl::body iwidgets::Scrolledhtml::_entity_/title {} { 2343 set _intitle 0 2344} 2345 2346# ------------------------------------------------------------------ 2347# PRIVATE METHOD: _entity_tr 2348# 2349# start table row 2350# ------------------------------------------------------------------ 2351itcl::body iwidgets::Scrolledhtml::_entity_tr {{args {}}} { 2352 if $_intable { 2353 _parse_fields ar $args 2354 _pop justify 2355 if [info exists ar(align)] { 2356 _set_align $ar(align) 2357 _push justify $_justify 2358 } else { 2359 _push justify L 2360 } 2361 # pop last row's colors 2362 _pop color 2363 _pop bgcolor 2364 _pop link 2365 _pop alink 2366 if [info exists ar(bgcolor)] { 2367 set _bgcolor $ar(bgcolor) 2368 } else { 2369 set _bgcolor [_peek bgcolor] 2370 } 2371 if [info exists ar(text)] { 2372 set _color $ar(text) 2373 } else { 2374 set _color [_peek color] 2375 } 2376 if [info exists ar(link)] { 2377 set _link $ar(link) 2378 } else { 2379 set _link [_peek link] 2380 } 2381 if [info exists ar(alink)] { 2382 set _alink $ar(alink) 2383 } else { 2384 set _alink [_peek alink] 2385 } 2386 # push this row's defaults 2387 _push color $_color 2388 _push bgcolor $_bgcolor 2389 _push link $_link 2390 _push alink $_alink 2391 $_hottext configure -state disabled 2392 _push row [expr {[_pop row] + 1}] 2393 _pop column 2394 _push column 0 2395 } 2396} 2397 2398# ------------------------------------------------------------------ 2399# PRIVATE METHOD: _entity_/tr 2400# 2401# end table row 2402# ------------------------------------------------------------------ 2403itcl::body iwidgets::Scrolledhtml::_entity_/tr {} { 2404} 2405 2406# ------------------------------------------------------------------ 2407# PRIVATE METHOD: _entity_tt 2408# 2409# Show typewriter text, using the font given by -fixedfont 2410# ------------------------------------------------------------------ 2411itcl::body iwidgets::Scrolledhtml::_entity_tt {} { 2412 _push font $_font 2413 set _font $itk_option(-fixedfont) 2414 set _verbatim 1 2415 _set_tag 2416} 2417 2418# ------------------------------------------------------------------ 2419# PRIVATE METHOD: _entity_/tt 2420# 2421# Change back to non-typewriter mode to display text 2422# ------------------------------------------------------------------ 2423itcl::body iwidgets::Scrolledhtml::_entity_/tt {} { 2424 set _font [_pop font] 2425 set _verbatim 0 2426 _set_tag 2427} 2428 2429# ------------------------------------------------------------------ 2430# PRIVATE METHOD: _entity_u 2431# 2432# display underlined text 2433# ------------------------------------------------------------------ 2434itcl::body iwidgets::Scrolledhtml::_entity_u {} { 2435 incr _underline 2436 _set_tag 2437} 2438 2439# ------------------------------------------------------------------ 2440# PRIVATE METHOD: _entity_/u 2441# 2442# change back from underlined text 2443# ------------------------------------------------------------------ 2444itcl::body iwidgets::Scrolledhtml::_entity_/u {} { 2445 incr _underline -1 2446 _set_tag 2447} 2448 2449# ------------------------------------------------------------------ 2450# PRIVATE METHOD: _entity_ul 2451# 2452# begin unordered list 2453# ------------------------------------------------------------------ 2454itcl::body iwidgets::Scrolledhtml::_entity_ul {{args {}}} { 2455 _parse_fields ar $args 2456 if $_left { 2457 _entity_br 2458 } else { 2459 _entity_p 2460 } 2461 if [info exists ar(id)] { 2462 set _anchor($ar(id)) [$itk_component(text) index end] 2463 } 2464 _push left $_left 2465 _push left2 $_left2 2466 if {$_left2 == $_left } { 2467 incr _left2 [expr {$_indentincr+3}] 2468 } else { 2469 incr _left2 $_indentincr 2470 } 2471 incr _left $_indentincr 2472 _push listyle $_listyle 2473 _push licount $_licount 2474 if [info exists ar(plain)] { 2475 set _listyle none 2476 } { 2477 set _listyle bullet 2478 } 2479 if [info exists ar(dingbat)] { 2480 set ar(src) $ar(dingbat) 2481 } 2482 _push lipic $_lipic 2483 if [info exists ar(src)] { 2484 set _listyle picture 2485 set _lipic $ar(src) 2486 } 2487 _set_tag 2488} 2489 2490# ------------------------------------------------------------------ 2491# PRIVATE METHOD: _entity_/ul 2492# 2493# end unordered list 2494# ------------------------------------------------------------------ 2495itcl::body iwidgets::Scrolledhtml::_entity_/ul {} { 2496 set _left [_pop left] 2497 set _left2 [_pop left2] 2498 set _listyle [_pop listyle] 2499 set _licount [_pop licount] 2500 set _lipic [_pop lipic] 2501 _set_tag 2502 _entity_p 2503} 2504 2505# ------------------------------------------------------------------ 2506# PRIVATE METHOD: _entity_var 2507# 2508# Display variable 2509# ------------------------------------------------------------------ 2510itcl::body iwidgets::Scrolledhtml::_entity_var {} { 2511 _entity_i 2512} 2513 2514# ------------------------------------------------------------------ 2515# PRIVATE METHOD: _entity_/var 2516# 2517# change state back from variable display 2518# ------------------------------------------------------------------ 2519itcl::body iwidgets::Scrolledhtml::_entity_/var {} { 2520 _entity_/i 2521} 2522