neingeist
/
arduinisten
Archived
1
0
Fork 0
Code Releases Activity
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '7141a64979'
${ noResults }
arduinisten/arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledhtml.itk

2522 lines
77 KiB
Plaintext
Raw Normal View History Unescape Escape

arduino-0018-windows
15 years ago
# Scrolledhtml
# ----------------------------------------------------------------------
# Implements a scrolled html text widget by inheritance from scrolledtext
# Import reads from an html file, while export still writes plain text
# Also provides a render command, to display html text passed in as an
# argument.
#
# This widget is HTML3.2 compliant, with the following exceptions:
# a) nothing requiring a connection to an HTTP server is supported
# b) some of the image alignments aren't supported, because they're not
# supported by the text widget
# c) the br attributes that go with the image alignments aren't implemented
# d) background images are not supported, because they're not supported
# by the text widget
# e) automatic table/table cell sizing doesn't work very well.
#
# WISH LIST:
# This section lists possible future enhancements.
#
# 1) size tables better using dlineinfo.
# 2) make images scroll smoothly off top like they do off bottom. (limitation
# of text widget?)
# 3) add ability to get non-local URLs
# a) support forms
# b) support imagemaps
# 4) keep track of visited links
# 5) add tclets support
#
# BUGS:
# Cells in a table can be caused to overlap. ex:
# <table border width="100%">
# <tr><td>cell1</td><td align=right rowspan=2>cell2</td></tr>
# <tr><td colspan=2>cell3 w/ overlap</td>
# </table>
# It hasn't been fixed because 1) it's a pain to fix, 2) the fix would slow
# tables down by a significant amount, and 3) netscape has the same
# bug, as of V3.01, and no one seems to care.
#
# In order to size tables properly, they must be visible, which causes an
# annoying jump from table to table through the document at render time.
#
# ----------------------------------------------------------------------
# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com
#
# @(#) $Id: scrolledhtml.itk,v 1.7 2002/02/16 05:11:08 mgbacke Exp $
# ----------------------------------------------------------------------
# Copyright (c) 1996 DSC Technologies Corporation
# ======================================================================
# Permission to use, copy, modify, distribute and license this software
# and its documentation for any purpose, and without fee or written
# agreement with DSC, is hereby granted, provided that the above copyright
# notice appears in all copies and that both the copyright notice and
# warranty disclaimer below appear in supporting documentation, and that
# the names of DSC Technologies Corporation or DSC Communications
# Corporation not be used in advertising or publicity pertaining to the
# software without specific, written prior permission.
#
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
# ======================================================================
# Acknowledgements:
#
# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
# tkhtml.tcl code from tk inspect. The original code is copyright 1995
# Lawrence Berkeley Laboratory.
#
# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that: (1) source code distributions
# retain the above copyright notice and this paragraph in its entirety, (2)
# distributions including binary code include the above copyright notice and
# this paragraph in its entirety in the documentation or other materials
# provided with the distribution, and (3) all advertising materials mentioning
# features or use of this software display the following acknowledgement:
# ``This product includes software developed by the University of California,
# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of
# the University nor the names of its contributors may be used to endorse
# or promote products derived from this software without specific prior
# written permission.
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This code is based on Angel Li's (angel@flipper.rsmas.miami.edu) HTML
#
# Default resources.
#
option add *Scrolledhtml.borderWidth 2 widgetDefault
option add *Scrolledhtml.relief sunken widgetDefault
option add *Scrolledhtml.scrollMargin 3 widgetDefault
option add *Scrolledhtml.width 500 widgetDefault
option add *Scrolledhtml.height 600 widgetDefault
option add *Scrolledhtml.visibleItems 80x24 widgetDefault
option add *Scrolledhtml.vscrollMode static widgetDefault
option add *Scrolledhtml.hscrollMode static widgetDefault
option add *Scrolledhtml.labelPos n widgetDefault
option add *Scrolledhtml.wrap word widgetDefault
#
# Usual options.
#
itk::usual Scrolledhtml {
keep -fontname -fontsize -fixedfont -link -alink -linkhighlight \
-activebackground -activerelief -background -borderwidth -cursor \
-elementborderwidth -foreground -highlightcolor -highlightthickness \
-insertbackground -insertborderwidth -insertofftime -insertontime \
-insertwidth -jump -labelfont -selectbackground -selectborderwidth \
-selectforeground -textbackground -textfont -troughcolor -unknownimage
}
# ------------------------------------------------------------------
# SCROLLEDHTML
# ------------------------------------------------------------------
itcl::class iwidgets::Scrolledhtml {
inherit iwidgets::Scrolledtext
constructor {args} {}
destructor {}
itk_option define -feedback feedBack FeedBack {}
itk_option define -linkcommand linkCommand LinkCommand {}
itk_option define -fontname fontname FontName times
itk_option define -fixedfont fixedFont FixedFont courier
itk_option define -fontsize fontSize FontSize medium
itk_option define -link link Link blue
itk_option define -alink alink ALink red
itk_option define -linkhighlight alink ALink red
itk_option define -unknownimage unknownimage File {}
itk_option define -textbackground textBackground Background {}
itk_option define -update update Update 1
itk_option define -debug debug Debug 0
public method import {args}
public method clear {}
public method render {html {wd .}}
public method title {} {return $_title}
public method pwd {} {return $_cwd}
protected method _setup {}
protected method _set_tag {}
protected method _reconfig_tags {}
protected method _append_text {text}
protected method _do {text}
protected method _definefont {name foundry family weight slant registry}
protected method _peek {instack}
protected method _push {instack value}
protected method _pop {instack}
protected method _parse_fields {array_var string}
protected method _href_click {cmd href}
protected method _set_align {align}
protected method _fixtablewidth {hottext table multiplier}
protected method _header {level args}
protected method _/header {level}
protected method _entity_a {args}
protected method _entity_/a {}
protected method _entity_address {}
protected method _entity_/address {}
protected method _entity_b {}
protected method _entity_/b {}
protected method _entity_base {{args {}}}
protected method _entity_basefont {{args {}}}
protected method _entity_big {}
protected method _entity_/big {}
protected method _entity_blockquote {}
protected method _entity_/blockquote {}
protected method _entity_body {{args {}}}
protected method _entity_/body {}
protected method _entity_br {{args {}}}
protected method _entity_center {}
protected method _entity_/center {}
protected method _entity_cite {}
protected method _entity_/cite {}
protected method _entity_code {}
protected method _entity_/code {}
protected method _entity_dir {{args {}}}
protected method _entity_/dir {}
protected method _entity_div {{args {}}}
protected method _entity_dl {{args {}}}
protected method _entity_/dl {}
protected method _entity_dt {}
protected method _entity_dd {}
protected method _entity_dfn {}
protected method _entity_/dfn {}
protected method _entity_em {}
protected method _entity_/em {}
protected method _entity_font {{args {}}}
protected method _entity_/font {}
protected method _entity_h1 {{args {}}}
protected method _entity_/h1 {}
protected method _entity_h2 {{args {}}}
protected method _entity_/h2 {}
protected method _entity_h3 {{args {}}}
protected method _entity_/h3 {}
protected method _entity_h4 {{args {}}}
protected method _entity_/h4 {}
protected method _entity_h5 {{args {}}}
protected method _entity_/h5 {}
protected method _entity_h6 {{args {}}}
protected method _entity_/h6 {}
protected method _entity_hr {{args {}}}
protected method _entity_i {}
protected method _entity_/i {}
protected method _entity_img {{args {}}}
protected method _entity_kbd {}
protected method _entity_/kbd {}
protected method _entity_li {{args {}}}
protected method _entity_listing {}
protected method _entity_/listing {}
protected method _entity_menu {{args {}}}
protected method _entity_/menu {}
protected method _entity_ol {{args {}}}
protected method _entity_/ol {}
protected method _entity_p {{args {}}}
protected method _entity_pre {{args {}}}
protected method _entity_/pre {}
protected method _entity_samp {}
protected method _entity_/samp {}
protected method _entity_small {}
protected method _entity_/small {}
protected method _entity_sub {}
protected method _entity_/sub {}
protected method _entity_sup {}
protected method _entity_/sup {}
protected method _entity_strong {}
protected method _entity_/strong {}
protected method _entity_table {{args {}}}
protected method _entity_/table {}
protected method _entity_td {{args {}}}
protected method _entity_/td {}
protected method _entity_th {{args {}}}
protected method _entity_/th {}
protected method _entity_title {}
protected method _entity_/title {}
protected method _entity_tr {{args {}}}
protected method _entity_/tr {}
protected method _entity_tt {}
protected method _entity_/tt {}
protected method _entity_u {}
protected method _entity_/u {}
protected method _entity_ul {{args {}}}
protected method _entity_/ul {}
protected method _entity_var {}
protected method _entity_/var {}
protected variable _title {} ;# The title of the html document
protected variable _licount 1 ;# list element count
protected variable _listyle bullet ;# list element style
protected variable _lipic {} ;# picture to use as bullet
protected variable _color black ;# current text color
protected variable _bgcolor #d9d9d9 ;# current background color
protected variable _link blue ;# current link color
protected variable _alink red ;# current highlight link color
protected variable _smallpoints "60 80 100 120 140 180 240" ;# font point
protected variable _mediumpoints "80 100 120 140 180 240 360" ;# sizes for
protected variable _largepoints "100 120 140 180 240 360 480" ;# various
protected variable _hugepoints "120 140 180 240 360 480 640" ;# fontsizes
protected variable _font times ;# name of current font
protected variable _rulerheight 6 ;#
protected variable _indentincr 4 ;# increment to indent by
protected variable _counter -1 ;# counter to give unique numbers
protected variable _left 0 ;# initial left margin
protected variable _left2 0 ;# subsequent left margin
protected variable _right 0 ;# right margin
protected variable _justify L ;# text justification
protected variable _offset 0 ;# text offset (super/subscript)
protected variable _textweight 0 ;# boldness of text
protected variable _textslant 0 ;# whether to use italics
protected variable _underline 0 ;# whether to use underline
protected variable _verbatim 0 ;# whether to skip formatting
protected variable _pre 0 ;# preformatted text
protected variable _intitle 0 ;# in <title>...</title>
protected variable _anchorcount 0 ;# number of anchors
protected variable _stack ;# array of stacks
protected variable _pointsndx 2 ;#
protected variable _fontnames ;# list of accepted font names
protected variable _fontinfo ;# array of font info given font name
protected variable _tag ;#
protected variable _tagl ;#
protected variable _tagfont ;#
protected variable _cwd . ;# base directory of current page
protected variable _anchor ;# array of indexes by anchorname
protected variable _defaulttextbackground;# default text background
protected variable _intable 0 ;# whether we are in a table now
protected variable _hottext ;# widget where text currently goes
protected variable _basefontsize 2 ;# as named
protected variable _unknownimg {} ;# name of unknown image
protected variable _images {} ;# list of images we created
protected variable _prevpos {} ;# temporary used for table updates
protected variable _prevtext {} ;# temporary used for table updates
private variable _initialized 0
private variable _defUnknownImg [::image create photo -data {
R0lGODdhHwAgAPQAAP///wAAAMzMzC9PT76+vvnTogCR/1WRVaoAVf//qvT09OKdcWlcx19f
X9/f339/f8vN/J2d/aq2qoKCggAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
ACwAAAAAHwAgAAAF/iAgjqRDnmiKmqOkqsTaToDjvudTttLjOITJbTQhGI+iQE0xMvZqQIDw
NAEiAcqRVdKAGh0NyVCkuyqZBEmwofgRrFIxSaI0JmuA9KTrthIicWMTAQ8xWHgSe15AVgcJ
eVMjDwECOkome22Mb0cHCzEPOiQPgwGXCjomakedA0VgY1IPDZcuP3l5YkcRDwMHqDQoEzq2
Pz8IQkK7Bw8HDg+xO26PCAgRDcpGswEK2Dh9ItUMDdirPYUKwTKMjwDV1gHlR2oCkSmcI9UE
BabYrGnQoolgBCGckX7yWJWDYaUMAYSRFECAwMXeiU1BHpKTB4CBR4+oBOb5By1UNgUfXj0C
8HaP079sBCCkZIAKWst/OGPOhNBNHQmXOeftJBASRVCcEiIojQDBwIOeRo+SpGXKFFGbP6Xi
nLWxEMsmWpEOC9XDYtigYtKSwsH2xdq2cEfRmFS1rt27eE09CAEAOw==
}]
}
#
# Provide a lowercased access method for the Scrolledhtml class.
#
proc ::iwidgets::scrolledhtml {pathName args} {
uplevel ::iwidgets::Scrolledhtml $pathName $args
}
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::constructor {args} {
# define the fonts we're going to use
set _fontnames ""
_definefont helvetica adobe helvetica "medium bold" "r o" iso8859
_definefont courier adobe courier "medium bold" "r o" iso8859
_definefont times adobe times "medium bold" "r i" iso8859
_definefont symbol adobe symbol "medium medium" "r r" adobe
$itk_component(text) configure -state disabled
eval itk_initialize $args
if {[lsearch -exact $args -linkcommand] == -1} {
configure -linkcommand [itcl::code $this import -link]
}
set _initialized 1
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::destructor {} {
foreach x $_images {
::image delete $x
}
if {$_unknownimg != $_defUnknownImg} {
::image delete $_unknownimg
}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -fontsize
#
# Set the general size of the font.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::fontsize {
switch $itk_option(-fontsize) {
small { }
medium { }
large { }
huge { }
default {
error "bad fontsize option\
\"$itk_option(-fontsize)\": should\
be small, medium, large, or huge"
}
}
_reconfig_tags
}
# ------------------------------------------------------------------
# OPTION: -fixedfont
#
# Set the fixed font name
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::fixedfont {
if {[lsearch -exact $_fontnames $itk_option(-fixedfont)] == -1} {
error "Invalid font name \"$itk_option(-fixedfont)\". Must be one of \
$_fontnames"
}
}
# ------------------------------------------------------------------
# OPTION: -fontname
#
# Set the default font name
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::fontname {
if {[lsearch -exact $_fontnames $itk_option(-fontname)] == -1} {
error "Invalid font name \"$itk_option(-fontname)\". Must be one of \
$_fontnames"
}
}
# ------------------------------------------------------------------
# OPTION: -textbackground
#
# Set the default text background
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::textbackground {
set _defaulttextbackground $itk_option(-textbackground)
}
# ------------------------------------------------------------------
# OPTION: -linkhighlight
#
# same as alink
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::linkhighlight {
configure -alink $itk_option(-linkhighlight)
}
# ------------------------------------------------------------------
# OPTION: -unknownimage
#
# set image to use as substitute for images that aren't found
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::unknownimage {
set oldimage $_unknownimg
if {$itk_option(-unknownimage) != {}} {
set uki $itk_option(-unknownimage)
if [catch { set _unknownimg [::image create photo -file $uki] } err] {
error "Couldn't create image $uki:\n$err\nUnknown image not found"
}
} else {
set _unknownimg $_defUnknownImg
}
if {$oldimage != {} && $oldimage != $_defUnknownImg} {
::image delete $oldimage
}
}
# ------------------------------------------------------------------
# OPTION: -update
#
# boolean indicating whether to update during rendering
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::update {
switch -- $itk_option(-update) {
0 {}
1 {}
true {
configure -update 1
}
yes {
configure -update 1
}
false {
configure -update 0
}
yes {
configure -update 0
}
default {
error "invalid -update; must be boolean"
}
}
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: clear
#
# Clears the text out
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::clear {} {
$itk_component(text) config -state normal
$itk_component(text) delete 1.0 end
foreach x $_images {
::image delete $x
}
set _images {}
_setup
$itk_component(text) config -state disabled
}
# ------------------------------------------------------------------
# METHOD import ?-link? filename?#anchorname?
#
# read html text from a file (import filename) if the keyword link is present,
# pathname is relative to last page, otherwise it is relative to current
# directory. This allows the user to use a linkcommand of
# "<widgetname> import -link"
#
# if '#anchorname' is appended to the filename, the page is displayed starting
# at the anchor named 'anchorname' If an anchor is specified without a filename,
# the current page is assumed.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::import {args} {
update idletasks
set len [llength $args]
if {$len != 1 && $len != 2} {
error "wrong # args: should be \
\"$itk_component(hull) import ?-link? filename\""
}
set linkname [lindex $args [expr {$len - 1}]]
#
# Seperate filename#anchorname
#
if ![regexp {(.*)#(.*)} $linkname dummy filename anchorname] {
set filename $linkname
}
if {$filename!=""} {
#
# Check for -link option
#
switch -- $len {
1 {
#
# open file & set cwd to that file's directory
#
set f [open $filename r]
set _cwd [file dirname $filename]
}
2 {
switch -- [lindex $args 0] {
-link {
#
# got -link, so set path relative to current locale, if path
# is a relative pathname
#
if {[string compare "." [file dirname $filename]] == 0} {
set f [open $_cwd/$filename r]
} else {
if {[string index [file dirname $filename] 0] != "/" &&\
[string index [file dirname $filename] 0] != "~"} {
set f [open $_cwd/$filename r]
append _cwd /
append _cwd [file dirname $filename]
} else {
set f [open $filename r]
set _cwd [file dirname $filename]
}
}
}
default {
# got something other than -link
error "invalid format: should be \
\"$itk_component(hull) import ?-link? filename\""
}
}
}
}
set txt [read $f]
close $f
render $txt $_cwd
}
#
# if an anchor was requested, move that anchor into view
#
if [ info exists anchorname] {
if {$anchorname!=""} {
if [info exists _anchor($anchorname)] {
$itk_component(text) see end
$itk_component(text) see $_anchor($anchorname)
}
} else {
$itk_component(text) see 0.0
}
}
}
# ------------------------------------------------------------------
# METHOD: render text ?wd?
#
# Clear the text, then render html formatted text. Optional wd argument
# sets the base directory for any links or images.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::render {html {wd .}} {
update idletasks
#
# blank text and reset all state variables
#
clear
set _cwd $wd
#
# make text writable
#
$itk_component(text) config -state normal
set continuerendering 1
_set_tag
while {$continuerendering} {
# normal state
while {[set len [string length $html]]} {
# look for text up to the next <> element
if [regexp -indices "^\[^<\]+" $html match] {
set text [string range $html 0 [lindex $match 1]]
_append_text "$text"
set html \
[string range $html [expr {[lindex $match 1]+1}] end]
}
# we're either at a <>, or at the eot
if [regexp -indices "^<((\[^>\"\]+|(\"\[^\"\]*\"))*)>" $html match entity] {
regsub -all "\n" [string range $html [lindex $entity 0] \
[lindex $entity 1]] "" entity
set cmd [string tolower [lindex $entity 0]]
if {[info command _entity_$cmd]!=""} {
if {[catch {eval _entity_$cmd [lrange $entity 1 end]} bad]} {
if {$itk_option(-debug)} {
global errorInfo
puts stderr "render: _entity_$cmd [lrange $entity 1 end] = Error:$bad\n$errorInfo"
}
}
}
set html \
[string range $html [expr {[lindex $match 1]+1}] end]
}
if {$itk_option(-feedback) != {} } {
eval $itk_option(-feedback) $len
}
if $_verbatim break
}
# we reach here if html is empty, or _verbatim is 1
if !$len break
# _verbatim must be 1
# append text until next tag is reached
if [regexp -indices "<.*>" $html match] {
set text [string range $html 0 [expr {[lindex $match 0]-1}]]
set html [string range $html [expr {[lindex $match 0]}] end]
} else {
set text $html
set html ""
}
_append_text "$text"
}
$itk_component(text) config -state disabled
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _setup
#
# Reset all state variables to prepare for a new page.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_setup {} {
set _font $itk_option(-fontname)
set _left 0
set _left2 0
set _right 0
set _justify L
set _textweight 0
set _textslant 0
set _underline 0
set _verbatim 0
set _pre 0
set _title {}
set _intitle 0
set _anchorcount 0
set _intable 0
set _hottext $itk_component(text)
set _stack(font) {}
set _stack(color) {}
set _stack(bgcolor) {}
set _stack(link) {}
set _stack(alink) {}
set _stack(justify) {}
set _stack(listyle) {}
set _stack(lipic) {}
set _stack(href) {}
set _stack(pointsndx) {}
set _stack(left) {}
set _stack(left2) {}
set _stack(offset) {}
set _stack(table) {}
set _stack(tablewidth) {}
set _stack(row) {}
set _stack(column) {}
set _stack(hottext) {}
set _stack(tableborder) {}
set _stack(cellpadding) {}
set _stack(cellspacing) {}
set _stack(licount) {}
set _basefontsize 2
set _pointsndx 2
set _counter -1
set _bgcolor $_defaulttextbackground
set _color $itk_option(-foreground)
set _link $itk_option(-link)
set _alink $itk_option(-alink)
config -textbackground $_bgcolor
foreach x [array names _anchor] { unset _anchor($x) }
$itk_component(text) tag config hr -relief sunken -borderwidth 2 \
-font -*-*-*-*-*-*-$_rulerheight-*-*-*-*-*-*-*
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _definefont name foundry family weight slant registry
#
# define font information used to generate font value from font name
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_definefont \
{name foundry family weight slant registry} {
if {[lsearch -exact $_fontnames $name] == -1 } {
lappend _fontnames $name
}
set _fontinfo($name) \
[list $foundry $family $weight $slant $registry]
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _append_text text
#
# append text in the format described by the state variables
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_append_text {text} {
if {!$_intable && $itk_option(-update)} {update}
if {[string first "&" $text] != -1} {
regsub -nocase -all "&amp;" $text {\&} text
regsub -nocase -all "&lt;" $text "<" text
regsub -nocase -all "&gt;" $text ">" text
regsub -nocase -all "&quot;" $text "\"" text
}
if !$_verbatim {
if !$_pre {
set text [string trim $text "\n\r"]
regsub -all "\[ \n\r\t\]+" $text " " text
}
if ![string length $text] return
}
if {!$_pre && !$_intitle} {
if {[catch {$_hottext get "end - 2c"} p]} {
set p ""
}
set n [string index $text 0]
if {$n == " " && $p == " "} {
set text [string range $text 1 end]
}
if {[catch {$_hottext insert end $text $_tag}]} {
set pht [winfo parent $_hottext]
catch {$pht insert end $text $_tag}
}
return
}
if {$_pre && !$_intitle} {
if {[catch {$_hottext insert end $text $_tag}]} {
set pht [winfo parent $_hottext]
catch {$pht insert end $text $_tag}
}
return
}
append _title $text
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _set_tag
#
# generate a tag
# ------------------------------------------------------------------
# a tag is constructed as: font?B?I?U?Points-LeftLeft2RightColorJustify
itcl::body iwidgets::Scrolledhtml::_set_tag {} {
set i -1
foreach var {foundry family weight slant registry} {
set $var [lindex $_fontinfo($_font) \
[incr i]]
}
set x_font "-$foundry-$family-"
set _tag $_font
set args {}
if {$_textweight > 0} {
append _tag "B"
append x_font [lindex $weight 1]-
} else {
append x_font [lindex $weight 0]-
}
if {$_textslant > 0} {
append _tag "I"
append x_font [lindex $slant 1]-
} else {
append x_font [lindex $slant 0]-
}
if {$_underline > 0} {
append _tag "U"
append args " -underline 1"
}
switch $_justify {
L { append args " -justify left" }
R { append args " -justify right" }
C { append args " -justify center" }
}
append args " -offset $_offset"
set pts [lindex [set [format "_%spoints" $itk_option(-fontsize)]] \
$_pointsndx]
append _tag $_pointsndx - $_left \
$_left2 $_right \
$_color $_justify
append x_font "normal-*-*-$pts-*-*-*-*-$registry-*"
if $_anchorcount {
set href [_peek href]
set href_tag href[incr _counter]
set tags [list $_tag $href_tag]
if { $itk_option(-linkcommand)!= {} } {
$_hottext tag bind $href_tag <1> \
[list uplevel #0 $itk_option(-linkcommand) $href]
}
$_hottext tag bind $href_tag <Enter> \
[list $_hottext tag configure $href_tag \
-foreground $_alink]
$_hottext tag bind $href_tag <Leave> \
[list $_hottext tag configure $href_tag \
-foreground $_color]
} else {
set tags $_tag
}
if {![info exists _tagl($_tag)]} {
set _tagfont($_tag) 1
eval $_hottext tag configure $_tag \
-foreground ${_color} \
-lmargin1 ${_left}m \
-lmargin2 ${_left2}m $args
if [catch {eval $_hottext tag configure $_tag \
-font $x_font} err] {
_definefont $_font * $family $weight $slant *
regsub \$foundry $x_font * x_font
regsub \$registry $x_font * x_font
catch {eval $_hottext tag configure $_tag -font $x_font}
}
}
if [info exists href_tag] {
$_hottext tag raise $href_tag $_tag
}
set _tag $tags
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _reconfig_tags
#
# reconfigure tags following a configuration change
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_reconfig_tags {} {
if $_initialized {
foreach tag [$itk_component(text) tag names] {
foreach efont $_fontnames {
if [regexp "${efont}(B?)(I?)(U?)(\[1-9\]\[0-9\]*)-" $tag t b i u points] {
set j -1
set _font $efont
foreach var {foundry family weight slant registry} {
set $var [lindex $_fontinfo($_font) [incr j]]
}
set x_font "-$foundry-$family-"
if {$b == "B"} {
append x_font [lindex $weight 1]-
} else {
append x_font [lindex $weight 0]-
}
if {$i == "I"} {
append x_font [lindex $slant 1]-
} else {
append x_font [lindex $slant 0]-
}
set pts [lindex [set [format \
"_%spoints" $itk_option(-fontsize)]] $points]
append x_font "normal-*-*-$pts-*-*-*-*-$registry-*"
$itk_component(text) tag config $tag -font $x_font
break
}
}
}
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _push instack value
#
# push value onto stack(instack)
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_push {instack value} {
set _stack($instack) [linsert $_stack($instack) 0 $value]
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _pop instack
#
# pop value from stack(instack)
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_pop {instack} {
if {$_stack($instack) == ""} {
error "popping empty _stack $instack"
}
set val [lindex $_stack($instack) 0]
set _stack($instack) [lrange $_stack($instack) 1 end]
return $val
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _peek instack
#
# peek at top value on stack(instack)
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_peek {instack} {
return [lindex $_stack($instack) 0]
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _parse_fields array_var string
#
# parse fields from a href or image tag. At the moment, doesn't support
# spaces in field values. (e.g. alt="not avaliable")
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_parse_fields {array_var string} {
upvar $array_var array
if {$string != "{}" } {
regsub -all "( *)=( *)" $string = string
regsub -all {\\\"} $string \" string
while {$string != ""} {
if ![regexp "^ *(\[^ \n\r=\]+)=\"(\[^\"\n\r\t\]*)(.*)" $string \
dummy field value newstring] {
if ![regexp "^ *(\[^ \n\r=\]+)=(\[^\n\r\t \]*)(.*)" $string \
dummy field value newstring] {
if ![regexp "^ *(\[^ \n\r\]+)(.*)" $string dummy field newstring] {
error "malformed command field; field = \"$string\""
continue
}
set value ""
}
}
set array([string tolower $field]) $value
set string "$newstring"
}
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _href_click
#
# process a click on an href
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_href_click {cmd href} {
uplevel #0 $cmd $href
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _set_align
#
# set text alignment
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_set_align {align} {
switch [string tolower $align] {
center {
set _justify C
}
left {
set _justify L
}
right {
set _justify R
}
default {}
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _fixtablewidth
#
# fix table width & height
# essentially, with nested tables the outer table must be configured before
# the inner table, but the idle tasks get queued up in the opposite order,
# so process later idle tasks before sizing yourself.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_fixtablewidth {hottext table multiplier} {
update idletasks
$hottext see $_anchor($table)
update idletasks
$table configure \
-width [expr {$multiplier * [winfo width $hottext] - \
2* [$hottext cget -padx] - \
2* [$hottext cget -borderwidth]} ] \
-height [winfo height $table]
grid propagate $table 0
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _header level
#
# generic entity to set state for <hn> tag
# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_header {level args} {
eval _parse_fields ar $args
_push justify $_justify
if [info exists ar(align)] {
_entity_p align=$ar(align)
} else {
_entity_p
}
if [info exists ar(src)] {
_entity_img src=$ar(src)
}
_push pointsndx $_pointsndx
set _pointsndx [expr {7-$level}]
incr _textweight
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _/header level
#
# generic entity to set state for </hn> tag
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_/header {level} {
set _justify [_pop justify]
set _pointsndx [_pop pointsndx]
incr _textweight -1
_set_tag
_entity_p
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_a
#
# add an anchor. Accepts arguments of the form ?href=filename#anchorpoint?
# ?name=anchorname?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_a {args} {
_parse_fields ar $args
_push color $_color
if [info exists ar(href)] {
_push href $ar(href)
incr _anchorcount
set _color $_link
_entity_u
} else {
_push href {}
}
if [info exists ar(name)] {
set _anchor($ar(name)) [$itk_component(text) index end]
}
if [info exists ar(id)] {
set _anchor($ar(id)) [$itk_component(text) index end]
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/a
#
# End anchor
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/a {} {
set href [_pop href]
if {$href != {}} {
incr _anchorcount -1
set _color [_pop color]
_entity_/u
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_address
#
# display an address
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_address {} {
_entity_br
_entity_i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/address
#
# change state back from address display
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/address {} {
_entity_/i
_entity_br
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_b
#
# Change current font to bold
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_b {} {
incr _textweight
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/b
#
# change current font back from bold
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/b {} {
incr _textweight -1
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_base
#
# set the cwd of the document
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_base {{args {}}} {
_parse_fields ar $args
if [info exists ar(href)] {
set _cwd [file dirname $ar(href)]
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_basefont
#
# set base font size
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_basefont {{args {}}} {
_parse_fields ar $args
if {[info exists ar(size)]} {
set _basefontsize $ar(size)
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_big
#
# Change current font to a bigger size
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_big {} {
_push pointsndx $_pointsndx
if {[incr _pointsndx 2] > 6} {
set _pointsndx 6
}
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/big
#
# change current font back from bigger size
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/big {} {
set _pointsndx [_pop pointsndx]
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_blockquote
#
# display a block quote
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_blockquote {} {
_entity_p
_push left $_left
incr _left $_indentincr
_push left2 $_left2
set _left2 $_left
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/blockquote
#
# change back from blockquote
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/blockquote {} {
_entity_p
set _left [_pop left]
set _left2 [_pop left2]
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_body
#
# begin body text. Takes argument of the form ?bgcolor=<color>? ?text=<color>?
# ?link=<color>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_body {{args {}}} {
_parse_fields ar $args
if [info exists ar(bgcolor)] {
set _bgcolor $ar(bgcolor)
set temp $itk_option(-textbackground)
config -textbackground $_bgcolor
set _defaulttextbackground $temp
}
if [info exists ar(text)] {
set _color $ar(text)
}
if [info exists ar(link)] {
set _link $ar(link)
}
if [info exists ar(alink)] {
set _alink $ar(alink)
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/body
#
# end body text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/body {} {
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_br
#
# line break
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_br {{args {}}} {
$_hottext insert end "\n"
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_center
#
# change justification to center
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_center {} {
_push justify $_justify
set _justify C
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/center
#
# change state back from center
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/center {} {
set _justify [_pop justify]
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_cite
#
# display citation
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_cite {} {
_entity_i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/cite
#
# change state back from citation
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/cite {} {
_entity_/i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_code
#
# display code listing
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_code {} {
_entity_pre
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/code
#
# end code listing
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/code {} {
_entity_/pre
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_dir
#
# display dir list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_dir {{args {}}} {
_entity_ul plain $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/dir
#
# end dir list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/dir {} {
_entity_/ul
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_div
#
# divide text. same as <p>
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_div {{args {}}} {
_entity_p $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_dl
#
# begin definition list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_dl {{args {}}} {
if {$_left == 0} {
_entity_p
}
_push left $_left
_push left2 $_left2
if {$_left2 == $_left } {
incr _left2 [expr {$_indentincr+3}]
} else {
incr _left2 $_indentincr
}
incr _left $_indentincr
_push listyle $_listyle
_push licount $_licount
set _listyle none
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/dl
#
# end definition list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/dl {} {
set _left [_pop left]
set _left2 [_pop left2]
set _listyle [_pop listyle]
set _licount [_pop licount]
_set_tag
if {$_left == 0} {
_entity_p
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_dt
#
# definition term
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_dt {} {
set _left [expr {$_left2 - 3}]
_set_tag
_entity_p
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_dd
#
# definition definition
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_dd {} {
set _left $_left2
_set_tag
_entity_br
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_dfn
#
# display defining instance of a term
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_dfn {} {
_entity_i
_entity_b
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/dfn
#
# change state back from defining instance of term
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/dfn {} {
_entity_/b
_entity_/i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_em
#
# display emphasized text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_em {} {
_entity_i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/em
#
# change state back from emphasized text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/em {} {
_entity_/i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_font
#
# set font size and color
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_font {{args {}}} {
_parse_fields ar $args
_push pointsndx $_pointsndx
_push color $_color
if [info exists ar(size)] {
if {![regexp {^[+-].*} $ar(size)]} {
set _pointsndx $ar(size)
} else {
set _pointsndx [expr {$_basefontsize $ar(size)}]
}
if { $_pointsndx > 6 } {
set _pointsndx 6
} else {
if { $_pointsndx < 0 } {
set _pointsndx 0
}
}
}
if {[info exists ar(color)]} {
set _color $ar(color)
}
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/font
#
# close current font size
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/font {} {
set _pointsndx [_pop pointsndx]
set _color [_pop color]
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_h1
#
# display header level 1.
# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_h1 {{args {}}} {
_header 1 $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/h1
#
# change state back from header 1
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/h1 {} {
_/header 1
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_h2
#
# display header level 2
# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_h2 {{args {}}} {
_header 2 $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/h2
#
# change state back from header 2
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/h2 {} {
_/header 2
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_h3
#
# display header level 3
# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_h3 {{args {}}} {
_header 3 $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/h3
#
# change state back from header 3
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/h3 {} {
_/header 3
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_h4
#
# display header level 4
# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_h4 {{args {}}} {
_header 4 $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/h4
#
# change state back from header 4
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/h4 {} {
_/header 4
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_h5
#
# display header level 5
# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_h5 {{args {}}} {
_header 5 $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/h5
#
# change state back from header 5
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/h5 {} {
_/header 5
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_h6
#
# display header level 6
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_h6 {{args {}}} {
_header 6 $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/h6
#
# change state back from header 6
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/h6 {} {
_/header 6
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_hr
#
# Add a horizontal rule
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_hr {{args {}}} {
_parse_fields ar $args
if [info exists ar(size)] {
set font "-font -*-*-*-*-*-*-$ar(size)-*-*-*-*-*-*-*"
} else {
set font "-font -*-*-*-*-*-*-2-*-*-*-*-*-*-*"
}
if [info exists ar(width)] {
}
if [info exists ar(noshade)] {
set relief "-relief flat"
set background "-background black"
} else {
set relief "-relief sunken"
set background ""
}
# if [info exists ar(align)] {
# $_hottext tag config hr$_counter -justify $ar(align)
# set justify -justify $ar(align)
# } else {
# set justify ""
# }
eval $_hottext tag config hr[incr _counter] $relief $background $font \
-borderwidth 2
_entity_p
$_hottext insert end " \n" hr$_counter
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_i
#
# display italicized text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_i {} {
incr _textslant
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/i
#
# change state back from italicized text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/i {} {
incr _textslant -1
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_img
#
# display an image. takes argument of the form img=<filename>
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_img {{args {}}} {
_parse_fields ar $args
set alttext "<image>"
#
# If proper argument exists
#
if [info exists ar(src)] {
set imgframe $_hottext.img[incr _counter]
#
# if this is an anchor
#
if $_anchorcount {
# create link colored border
frame $imgframe -borderwidth 2 -background $_link
bind $imgframe <Enter> \
[list $imgframe configure -background $_alink]
bind $imgframe <Leave> \
[list $imgframe configure -background $_link]
} else {
# create plain frame
frame $imgframe -borderwidth 0 -background $_color
}
#
# try to load image
#
if {[string index $ar(src) 0] == "/" || [string index $ar(src) 0] == "~"} {
set file $ar(src)
} else {
set file $_cwd/$ar(src)
}
if [catch {set img [::image create photo -file $file]} err] {
if {[info exists ar(width)] && [info exists ar(height)] } {
# suggestions exist, so make frame appropriate size and add a border
$imgframe configure -width $ar(width) -height $ar(height) -borderwidth 2
pack propagate $imgframe false
}
#
# If alt text is specified, display that
#
if [info exists ar(alt)] {
# add a border
$imgframe configure -borderwidth 2
set win $imgframe.text
label $win -text "$ar(alt)" -background $_bgcolor \
-foreground $_color
} else {
#
# use 'unknown image'
set win $imgframe.image#auto
#
# make label containing image
#
label $win -image $_unknownimg -borderwidth 0 -background $_bgcolor
}
pack $win -fill both -expand true
} else { ;# no error loading image
lappend _images $img
set win $imgframe.$img
#
# make label containing image
#
label $win -image $img -borderwidth 0
}
pack $win
#
# set alignment
#
set align bottom
if [info exists ar(align)] {
switch $ar(align) {
middle {
set align center
}
right {
set align center
}
default {
set align [string tolower $ar(align)]
}
}
}
#
# create window in text to display image
#
$_hottext window create end -window \
$imgframe -align $align
#
# set tag for window
#
$_hottext tag add $_tag $imgframe
if $_anchorcount {
set href [_peek href]
set href_tag href[incr _counter]
set tags [list $_tag $href_tag]
if { $itk_option(-linkcommand)!= {} } {
bind $win <1> [list uplevel #0 $itk_option(-linkcommand) $href]
}
}
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_kbd
#
# Display keyboard input
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_kbd {} {
incr _textweight
_entity_tt
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/kbd
#
# change state back from displaying keyboard input
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/kbd {} {
_entity_/tt
incr _textweight -1
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_li
#
# begin new list entry
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_li {{args {}}} {
_parse_fields ar $args
if [info exists ar(value)] {
set _licount $ar(value)
}
_entity_br
switch -exact $_listyle {
bullet {
set old_font $_font
set _font symbol
_set_tag
$_hottext insert end "\xb7" $_tag
set _font $old_font
_set_tag
}
none {
}
picture {
_entity_img src="$_lipic" width=4 height=4 align=middle
}
A {
_entity_b
$_hottext insert end [format "%c) " [expr {$_licount + 0x40}]] $_tag
_entity_/b
incr _licount
}
a {
_entity_b
$_hottext insert end [format "%c) " [expr {$_licount + 0x60}]] $_tag
_entity_/b
incr _licount
}
I {
_entity_b
$_hottext insert end "[::iwidgets::roman $_licount]) " $_tag
_entity_/b
incr _licount
}
i {
_entity_b
$_hottext insert end "[::iwidgets::roman $_licount lower])] " $_tag
_entity_/b
incr _licount
}
default {
_entity_b
$_hottext insert end "$_licount) " $_tag
_entity_/b
incr _licount
}
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_listing
#
# diplay code listing
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_listing {} {
_entity_pre
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/listing
#
# end code listing
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/listing {} {
_entity_/pre
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_menu
#
# diplay menu list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_menu {{args {}}} {
_entity_ul plain $args
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/menu
#
# end menu list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/menu {} {
_entity_/ul
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_ol
#
# begin ordered list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_ol {{args {}}} {
_parse_fields ar $args
if $_left {
_entity_br
} else {
_entity_p
}
if {![info exists ar(type)]} {
set ar(type) 1
}
_push licount $_licount
if [info exists ar(start)] {
set _licount $ar(start)
} else {
set _licount 1
}
_push left $_left
_push left2 $_left2
if {$_left2 == $_left } {
incr _left2 [expr {$_indentincr+3}]
} else {
incr _left2 $_indentincr
}
incr _left $_indentincr
_push listyle $_listyle
set _listyle $ar(type)
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/ol
#
# end ordered list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/ol {} {
set _left [_pop left]
set _left2 [_pop left2]
set _listyle [_pop listyle]
set _licount [_pop licount]
_set_tag
_entity_p
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_p
#
# paragraph break
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_p {{args {}}} {
_parse_fields ar $args
if [info exists ar(align)] {
_set_align $ar(align)
} else {
set _justify L
}
_set_tag
if [info exists ar(id)] {
set _anchor($ar(id)) [$itk_component(text) index end]
}
set x [$_hottext get end-3c]
set y [$_hottext get end-2c]
if {$x == "" && $y == ""} return
if {$y == ""} {
$_hottext insert end "\n\n"
return
}
if {$x == "\n" && $y == "\n"} return
if {$y == "\n"} {
$_hottext insert end "\n"
return
}
$_hottext insert end "\n\n"
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_pre
#
# display preformatted text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_pre {{args {}}} {
_entity_tt
_entity_br
incr _pre
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/pre
#
# change state back from preformatted text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/pre {} {
_entity_/tt
set _pre 0
_entity_p
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_samp
#
# display sample text.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_samp {} {
_entity_kbd
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/samp
#
# switch back to non-sample text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/samp {} {
_entity_/kbd
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_small
#
# Change current font to a smaller size
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_small {} {
_push pointsndx $_pointsndx
if {[incr _pointsndx -2] < 0} {
set _pointsndx 0
}
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/small
#
# change current font back from smaller size
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/small {} {
set _pointsndx [_pop pointsndx]
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_sub
#
# display subscript
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_sub {} {
_push offset $_offset
incr _offset -2
_entity_small
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/sub
#
# switch back to non-subscript
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/sub {} {
set _offset [_pop offset]
_entity_/small
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_sup
#
# display superscript
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_sup {} {
_push offset $_offset
incr _offset 4
_entity_small
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/sup
#
# switch back to non-superscript
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/sup {} {
set _offset [_pop offset]
_entity_/small
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_strong
#
# display strong text. (i.e. make font bold)
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_strong {} {
incr _textweight
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/strong
#
# switch back to non-strong text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/strong {} {
incr _textweight -1
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_table
#
# display a table.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_table {{args {}}} {
_parse_fields ar $args
_entity_p
set _intable 1
_push row -1
_push column 0
_push hottext $_hottext
_push justify $_justify
_push justify L
# push color information for master of table, then push info for table
_push color $_color
_push bgcolor $_bgcolor
_push link $_link
_push alink $_alink
if [info exists ar(bgcolor)] {
set _bgcolor $ar(bgcolor)
}
if [info exists ar(text)] {
set _color $ar(text)
}
if [info exists ar(link)] {
set _link $ar(link)
}
if [info exists ar(alink)] {
set _alink $ar(alink)
}
_push color $_color
_push bgcolor $_bgcolor
_push link $_link
_push alink $_alink
# push fake first row to avoid using optional /tr tag
# (This needs to set a real color - not the empty string
# becaule later code will try to use those values.)
_push color $_color
_push bgcolor $_bgcolor
_push link {}
_push alink {}
if {[info exists ar(align)]} {
_set_align $ar(align)
_set_tag
_append_text " "
}
set _justify L
if [info exists ar(id)] {
set _anchor($ar(id)) [$itk_component(text) index end]
}
if [info exists ar(cellpadding)] {
_push cellpadding $ar(cellpadding)
} else {
_push cellpadding 0
}
if [info exists ar(cellspacing)] {
_push cellspacing $ar(cellspacing)
} else {
_push cellspacing 0
}
if {[info exists ar(border)]} {
_push tableborder 1
set relief raised
if {$ar(border)==""} {
set ar(border) 2
}
} else {
_push tableborder 0
set relief flat
set ar(border) 2
}
_push table [set table $_hottext.table[incr _counter]]
iwidgets::labeledwidget $table -foreground $_color -background $_bgcolor -labelpos n
if {[info exists ar(title)]} {
$table configure -labeltext $ar(title)
}
#
# create window in text to display table
#
$_hottext window create end -window $table
set table [$table childsite]
set _anchor($table) [$_hottext index "end - 1 line"]
$table configure -borderwidth $ar(border) -relief $relief
if {[info exists ar(width)]} {
_push tablewidth $ar(width)
} else {
_push tablewidth 0
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/table
#
# end table
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/table {} {
if {$_intable} {
_pop tableborder
set table [[_pop table] childsite]
_pop row
_pop column
_pop cellspacing
_pop cellpadding
# pop last row's defaults
_pop color
_pop bgcolor
_pop link
_pop alink
# pop table defaults
_pop color
_pop bgcolor
_pop link
_pop alink
# restore table master defaults
set _color [_pop color]
set _bgcolor [_pop bgcolor]
set _link [_pop link]
set _alink [_pop alink]
foreach x [grid slaves $table] {
set text [$x get 1.0 end]
set tl [split $text \n]
set max 0
foreach l $tl {
set len [string length $l]
if {$len > $max} {
set max $len
}
}
if {$max > [$x cget -width]} {
$x configure -width $max
}
if {[$x cget -height] == 1} {
$x configure -height [lindex [split [$x index "end - 1 chars"] "."] 0]
}
}
$_hottext configure -state disabled
set _hottext [_pop hottext]
$_hottext configure -state normal
if {[set tablewidth [_pop tablewidth]]!="0"} {
if {[string index $tablewidth \
[expr {[string length $tablewidth] -1}]] == "%"} {
set multiplier [expr {[string trimright $tablewidth "%"] / 100.0}]
set idletask [after idle [itcl::code "$this _fixtablewidth $_hottext $table $multiplier"]]
} else {
$table configure -width $tablewidth
grid propagate $table 0
}
}
_pop justify
set _justify [_pop justify]
_entity_br
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_td
#
# start table data cell
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_td {{args {}}} {
if $_intable {
_parse_fields ar $args
set table [[_peek table] childsite]
if {![info exists ar(colspan)]} {
set ar(colspan) 1
}
if {![info exists ar(rowspan)]} {
set ar(rowspan) 1
}
if {![info exists ar(width)]} {
set ar(width) 10
}
if {![info exists ar(height)]} {
set ar(height) 0
}
if [info exists ar(bgcolor)] {
set _bgcolor $ar(bgcolor)
} else {
set _bgcolor [_peek bgcolor]
}
if [info exists ar(text)] {
set _color $ar(text)
} else {
set _color [_peek color]
}
if [info exists ar(link)] {
set _link $ar(link)
} else {
set _link [_peek link]
}
if [info exists ar(alink)] {
set _alink $ar(alink)
} else {
set _alink [_peek alink]
}
$_hottext configure -state disabled
set cellpadding [_peek cellpadding]
set cellspacing [_peek cellspacing]
set _hottext $table.cell[incr _counter]
text $_hottext -relief flat -width $ar(width) -height $ar(height) \
-highlightthickness 0 -wrap word -cursor $itk_option(-cursor) \
-wrap word -cursor $itk_option(-cursor) \
-padx $cellpadding -pady $cellpadding
if {$_color != ""} {
$_hottext config -foreground $_color
}
if {$_bgcolor != ""} {
$_hottext config -background $_bgcolor
}
if [info exists ar(nowrap)] {
$_hottext configure -wrap none
}
if [_peek tableborder] {
$_hottext configure -relief sunken
}
set row [_peek row]
if {$row < 0} {
set row 0
}
set column [_pop column]
if {$column < 0} {
set column 0
}
while {[grid slaves $table -row $row -column $column] != ""} {
incr column
}
grid $_hottext -sticky nsew -row $row -column $column \
-columnspan $ar(colspan) -rowspan $ar(rowspan) \
-padx $cellspacing -pady $cellspacing
grid columnconfigure $table $column -weight 1
_push column [expr {$column + $ar(colspan)}]
if [info exists ar(align)] {
_set_align $ar(align)
} else {
set _justify [_peek justify]
}
_set_tag
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/td
#
# end table data cell
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/td {} {
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_th
#
# start table header
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_th {{args {}}} {
if $_intable {
_parse_fields ar $args
if [info exists ar(align)] {
_entity_td $args
} else {
_entity_td align=center $args
}
_entity_b
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/th
#
# end table data cell
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/th {} {
_entity_/td
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_title
#
# begin title of document
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_title {} {
set _intitle 1
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/title
#
# end title
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/title {} {
set _intitle 0
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_tr
#
# start table row
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_tr {{args {}}} {
if $_intable {
_parse_fields ar $args
_pop justify
if [info exists ar(align)] {
_set_align $ar(align)
_push justify $_justify
} else {
_push justify L
}
# pop last row's colors
_pop color
_pop bgcolor
_pop link
_pop alink
if [info exists ar(bgcolor)] {
set _bgcolor $ar(bgcolor)
} else {
set _bgcolor [_peek bgcolor]
}
if [info exists ar(text)] {
set _color $ar(text)
} else {
set _color [_peek color]
}
if [info exists ar(link)] {
set _link $ar(link)
} else {
set _link [_peek link]
}
if [info exists ar(alink)] {
set _alink $ar(alink)
} else {
set _alink [_peek alink]
}
# push this row's defaults
_push color $_color
_push bgcolor $_bgcolor
_push link $_link
_push alink $_alink
$_hottext configure -state disabled
_push row [expr {[_pop row] + 1}]
_pop column
_push column 0
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/tr
#
# end table row
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/tr {} {
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_tt
#
# Show typewriter text, using the font given by -fixedfont
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_tt {} {
_push font $_font
set _font $itk_option(-fixedfont)
set _verbatim 1
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/tt
#
# Change back to non-typewriter mode to display text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/tt {} {
set _font [_pop font]
set _verbatim 0
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_u
#
# display underlined text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_u {} {
incr _underline
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/u
#
# change back from underlined text
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/u {} {
incr _underline -1
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_ul
#
# begin unordered list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_ul {{args {}}} {
_parse_fields ar $args
if $_left {
_entity_br
} else {
_entity_p
}
if [info exists ar(id)] {
set _anchor($ar(id)) [$itk_component(text) index end]
}
_push left $_left
_push left2 $_left2
if {$_left2 == $_left } {
incr _left2 [expr {$_indentincr+3}]
} else {
incr _left2 $_indentincr
}
incr _left $_indentincr
_push listyle $_listyle
_push licount $_licount
if [info exists ar(plain)] {
set _listyle none
} {
set _listyle bullet
}
if [info exists ar(dingbat)] {
set ar(src) $ar(dingbat)
}
_push lipic $_lipic
if [info exists ar(src)] {
set _listyle picture
set _lipic $ar(src)
}
_set_tag
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/ul
#
# end unordered list
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/ul {} {
set _left [_pop left]
set _left2 [_pop left2]
set _listyle [_pop listyle]
set _licount [_pop licount]
set _lipic [_pop lipic]
_set_tag
_entity_p
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_var
#
# Display variable
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_var {} {
_entity_i
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _entity_/var
#
# change state back from variable display
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_entity_/var {} {
_entity_/i
}