Subversion Repositories or1k

# 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:

#      

      
      

         
32
         

         

         
#      
cell1
cell2
      
      

         
33
         

         

         
#      
cell3 w/ overlap
      
      

         
34
         

         

         
#      

#   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.1.1.1 2002-01-16 10:24:50 markom 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

# ------------------------------------------------------------------

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

  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 

  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

# ------------------------------------------------------------------

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 [code $this import -link]

  }

  set _initialized 1

}

# ------------------------------------------------------------------

#                        DESTRUCTOR

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

configbody iwidgets::Scrolledhtml::textbackground {

  set _defaulttextbackground $itk_option(-textbackground)

}

# ------------------------------------------------------------------

# OPTION: -linkhighlight

#

# same as alink

# ------------------------------------------------------------------

configbody iwidgets::Scrolledhtml::linkhighlight {

  configure -alink $itk_option(-linkhighlight)

}

# ------------------------------------------------------------------

# OPTION: -unknownimage

#

# set image to use as substitute for images that aren't found

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

configbody iwidgets::Scrolledhtml::update {

   switch -- $itk_option(-update) {

     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

# ------------------------------------------------------------------

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

# " 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.

# ------------------------------------------------------------------

body iwidgets::Scrolledhtml::import {args} {

  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]

g                  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.

# ------------------------------------------------------------------

body iwidgets::Scrolledhtml::render {html {wd .}} {

    #

    # 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]!=""} {

                    catch {eval _entity_$cmd [lrange $entity 1 end]}

                }

                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.

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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} {

        set p [$_hottext get "end - 2c"]

        set n [string index $text 0]

        if {$n == " " && $p == " "} {

          set text [string range $text 1 end]

        }

        $_hottext insert end $text $_tag

        return

    }

    if {$_pre && !$_intitle} {

        $_hottext 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

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  \

            [list $_hottext tag configure $href_tag \

                  -foreground $_alink]

        $_hottext tag bind $href_tag  \

            [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

# ------------------------------------------------------------------

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)

# ------------------------------------------------------------------

body iwidgets::Scrolledhtml::_push {instack value} {

    set _stack($instack) [linsert $_stack($instack) 0 $value]

}

# ------------------------------------------------------------------

# PRIVATE METHOD: _pop instack

#

# pop value from stack(instack)

# ------------------------------------------------------------------

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)

# ------------------------------------------------------------------

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")

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

body iwidgets::Scrolledhtml::_href_click {cmd href} {

  uplevel #0 $cmd $href

}

# ------------------------------------------------------------------

# PRIVATE METHOD: _set_align

#

# set text alignment

# ------------------------------------------------------------------