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.
2522 lines
77 KiB
Plaintext
2522 lines
77 KiB
Plaintext
# 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 "&" $text {\&} text
|
|
regsub -nocase -all "<" $text "<" text
|
|
regsub -nocase -all ">" $text ">" text
|
|
regsub -nocase -all """ $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
|
|
}
|