scrolledhtml.itk

windows下的GDB insight前端

# ------------------------------------------------------------------
# OPTION: -textbackground
#
# Set the default text background
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::textbackground {
  set _defaulttextbackground $itk_option(-textbackground)
}

# ------------------------------------------------------------------
# OPTION: -linkhighlight
#
# same as alink
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::linkhighlight {
  configure -alink $itk_option(-linkhighlight)
}

# ------------------------------------------------------------------
# OPTION: -unknownimage
#
# set image to use as substitute for images that aren't found
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::unknownimage {
   set oldimage $_unknownimg
   if {$itk_option(-unknownimage) != {}} {
      set uki $itk_option(-unknownimage)
      if [catch { set _unknownimg [::image create photo -file $uki] } err] {
         error "Couldn't create image $uki:\n$err\nUnknown image not found"
      }
   } else {
      set _unknownimg $_defUnknownImg
   }
   if {$oldimage != {} && $oldimage != $_defUnknownImg} {
      ::image delete $oldimage
   }
}

# ------------------------------------------------------------------
# OPTION: -update
#
# boolean indicating whether to update during rendering
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledhtml::update {
   switch -- $itk_option(-update) {
     0 {}
     1 {}
     true {
       configure -update 1
     }
     yes {
       configure -update 1
     }
     false {
       configure -update 0
     }
     yes {
       configure -update 0
     }
     default {
       error "invalid -update; must be boolean"
     }
   }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------
 
# ------------------------------------------------------------------
# METHOD: clear
#
# Clears the text out
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::clear {} {
    $itk_component(text) config -state normal
    $itk_component(text) delete 1.0 end
    foreach x $_images {
      ::image delete $x
    }
    set _images {}
    _setup
    $itk_component(text) config -state disabled
}

# ------------------------------------------------------------------
# METHOD import ?-link? filename?#anchorname?
#
# read html text from a file (import filename) if the keyword link is present, 
# pathname is relative to last page, otherwise it is relative to current 
# directory. This allows the user to use a linkcommand of 
# "<widgetname> import -link"
#
# if '#anchorname' is appended to the filename, the page is displayed starting
# at the anchor named 'anchorname' If an anchor is specified without a filename,
# the current page is assumed.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::import {args} {

  update idletasks

  set len [llength $args]
  if {$len != 1 && $len != 2} {
      error "wrong # args: should be \
              \"$itk_component(hull) import ?-link? filename\""
  }
  set linkname [lindex $args [expr {$len - 1}]]

  #
  # Seperate filename#anchorname
  #
  if ![regexp {(.*)#(.*)} $linkname dummy filename anchorname] {
    set filename $linkname
  }
  if {$filename!=""} {
    #
    # Check for -link option
    #
    switch -- $len {
      1 {
        #
        # open file & set cwd to that file's directory
        #
        set f [open $filename r]
        set _cwd [file dirname $filename]
      }
      2 {
        switch -- [lindex $args 0] {
          -link {
              #
              # got -link, so set path relative to current locale, if path
              # is a relative pathname
              #
              if {[string compare "." [file dirname $filename]] == 0} {
                set f [open $_cwd/$filename r]
              } else {
                if {[string index [file dirname $filename] 0] != "/" &&\
                    [string index [file dirname $filename] 0] != "~"} {
                  set f [open $_cwd/$filename r]
                  append _cwd /
                  append _cwd [file dirname $filename]
                } else {
                  set f [open $filename r]
                  set _cwd [file dirname $filename]
                }
              }
          }
          default {
            # got something other than -link
            error "invalid format: should be \
                  \"$itk_component(hull) import ?-link? filename\""
          }
        }
      }
    }
    set txt [read $f]
    close $f
    render $txt $_cwd
  }

  #
  # if an anchor was requested, move that anchor into view
  #
  if [ info exists anchorname] {
    if {$anchorname!=""} {
      if [info exists _anchor($anchorname)] {
        $itk_component(text) see end
        $itk_component(text) see $_anchor($anchorname)
      }
    } else {
      $itk_component(text) see 0.0
    }
  }
}

# ------------------------------------------------------------------
# METHOD: render text ?wd?
#
# Clear the text, then render html formatted text. Optional wd argument 
# sets the base directory for any links or images. 
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::render {html {wd .}} {

    update idletasks

    #
    # blank text and reset all state variables
    #
    clear
    set _cwd $wd

    #
    # make text writable
    #
    $itk_component(text) config -state normal
    set continuerendering 1
    _set_tag
    while {$continuerendering} {
	# normal state
	while {[set len [string length $html]]} {
	    # look for text up to the next <> element
	    if [regexp -indices "^\[^<\]+" $html match] {
		set text [string range $html 0 [lindex $match 1]]
		_append_text "$text"
		set html \
		    [string range $html [expr {[lindex $match 1]+1}] end]
	    }
	    # we're either at a <>, or at the eot
	    if [regexp -indices "^<((\[^>\"\]+|(\"\[^\"\]*\"))*)>" $html match entity] {
		regsub -all "\n" [string range $html [lindex $entity 0] \
			    [lindex $entity 1]] "" entity
		set cmd [string tolower [lindex $entity 0]]
		if {[info command _entity_$cmd]!=""} {
		  if {[catch {eval _entity_$cmd [lrange $entity 1 end]} bad]} {
		    if {$itk_option(-debug)} {
		      global errorInfo
		      puts stderr "render: _entity_$cmd [lrange $entity 1 end] = Error:$bad\n$errorInfo"
		    }
		  }
		}
		set html \
		    [string range $html [expr {[lindex $match 1]+1}] end]
	    }
	    if {$itk_option(-feedback) != {} } {
	      eval $itk_option(-feedback) $len
	    }
	    if $_verbatim break
	}
	# we reach here if html is empty, or _verbatim is 1
	if !$len break
	# _verbatim must be 1
	# append text until next tag is reached
	if [regexp -indices "<.*>" $html match] {
	    set text [string range $html 0 [expr {[lindex $match 0]-1}]]
	    set html [string range $html [expr {[lindex $match 0]}] end]
	} else {
	    set text $html
	    set html ""
	}
	_append_text "$text"
    }
    $itk_component(text) config -state disabled
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setup
#
# Reset all state variables to prepare for a new page.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_setup {} {
    set _font $itk_option(-fontname)
    set _left 0
    set _left2 0
    set _right 0
    set _justify L
    set _textweight 0
    set _textslant 0
    set _underline 0
    set _verbatim 0
    set _pre 0
    set _title {}
    set _intitle 0
    set _anchorcount 0
    set _intable 0
    set _hottext $itk_component(text)
    set _stack(font) {}
    set _stack(color) {}
    set _stack(bgcolor) {}
    set _stack(link) {}
    set _stack(alink) {}
    set _stack(justify) {}
    set _stack(listyle) {}
    set _stack(lipic) {}
    set _stack(href) {}
    set _stack(pointsndx) {}
    set _stack(left) {}
    set _stack(left2) {}
    set _stack(offset) {}
    set _stack(table) {}
    set _stack(tablewidth) {}
    set _stack(row) {}
    set _stack(column) {}
    set _stack(hottext) {}
    set _stack(tableborder) {}
    set _stack(cellpadding) {}
    set _stack(cellspacing) {}
    set _stack(licount) {}
    set _basefontsize 2
    set _pointsndx 2
    set _counter -1
    set _bgcolor $_defaulttextbackground
    set _color $itk_option(-foreground)
    set _link $itk_option(-link)
    set _alink $itk_option(-alink)
    config -textbackground $_bgcolor
    foreach x [array names _anchor] { unset _anchor($x) }
    $itk_component(text) tag config hr -relief sunken -borderwidth 2 \
            -font -*-*-*-*-*-*-$_rulerheight-*-*-*-*-*-*-*
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _definefont name foundry family weight slant registry
#
# define font information used to generate font value from font name
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_definefont \
            {name foundry family weight slant registry} {
    if {[lsearch -exact $_fontnames $name] == -1 } {
      lappend _fontnames $name
    }
    set _fontinfo($name) \
	[list $foundry $family $weight $slant $registry]
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _append_text text
#
# append text in the format described by the state variables
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledhtml::_append_text {text} {
    if {!$_intable && $itk_option(-update)} {update}
    if {[string first "&" $text] != -1} {
       regsub -nocase -all "&amp;" $text {\&} text
       regsub -nocase -all "&lt;" $text "<" text
       regsub -nocase -all "&gt;" $text ">" text
       regsub -nocase -all "&quot;" $text "\"" text
    }
    if !$_verbatim {
	if !$_pre {
            set text [string trim $text "\n\r"]
	    regsub -all "\[ \n\r\t\]+" $text " " text
	}
	if ![string length $text] return
    }
    if {!$_pre && !$_intitle} {
     	if {[catch {$_hottext get "end - 2c"} p]} {
     	    set p ""
     	}
	set n [string index $text 0]
        if {$n == " " && $p == " "} {
          set text [string range $text 1 end]
        }
 	if {[catch {$_hottext insert end $text $_tag}]} {
 	    set pht [winfo parent $_hottext]
 	    catch {$pht insert end $text $_tag}
 	}
	return
    }
    if {$_pre && !$_intitle} {
 	if {[catch {$_hottext insert end $text $_tag}]} {
 	    set pht [winfo parent $_hottext]
 	    catch {$pht insert end $text $_tag}
 	}
	return
    }
    append _title $text
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _set_tag
#
# generate a tag
# ------------------------------------------------------------------
# a tag is constructed as: font?B?I?U?Points-LeftLeft2RightColorJustify
itcl::body iwidgets::Scrolledhtml::_set_tag {} {
    set i -1
    foreach var {foundry family weight slant registry} {
	set $var [lindex $_fontinfo($_font) \
               [incr i]]
    }
    set x_font "-$foundry-$family-"
    set _tag $_font
    set args {}
    if {$_textweight > 0} {
	append _tag "B"
	append x_font [lindex $weight 1]-
    } else {
	append x_font [lindex $weight 0]-
    }
    if {$_textslant > 0} {
	append _tag "I"
	append x_font [lindex $slant 1]-
    } else {
	append x_font [lindex $slant 0]-
    }
    if {$_underline > 0} {
	append _tag "U"
	append args " -underline 1"
    }
    switch $_justify {
	L { append args " -justify left" }
	R { append args " -justify right" }
	C { append args " -justify center" }
    }
    append args " -offset $_offset"
        
    set pts [lindex [set [format "_%spoints" $itk_option(-fontsize)]] \
                  $_pointsndx]
    append _tag $_pointsndx - $_left \
	$_left2 $_right \
	$_color $_justify
    append x_font "normal-*-*-$pts-*-*-*-*-$registry-*"
    if $_anchorcount {
	set href [_peek href]
	set href_tag href[incr _counter]