textdisplay.itk

linux 下的源代码分析阅读器 red hat公司新版

# ----------------------------------------------------------------------
#  EXAMPLE: TextDisplay widget
# ----------------------------------------------------------------------
#  COURSE:  Object-Oriented Programming with [incr Tcl]
#  AUTHOR:  Michael J. McLennan, Bell Labs Innovations
# ======================================================================
#               Copyright (c) 1996  Lucent Technologies
# ======================================================================

option add *TextDisplay.width 3i widgetDefault
option add *TextDisplay.height 2i widgetDefault

option add *TextDisplay.scrollbar auto widgetDefault
option add *TextDisplay.wrap none widgetDefault
option add *TextDisplay.textBackground ivory widgetDefault

class TextDisplay {
    inherit itk::Widget

    constructor {args} {
        itk_option add hull.width hull.height

        itk_component add text {
            text $itk_interior.info -state disabled -width 1 -height 1 \
                -yscrollcommand [code $itk_interior.sbar set]
        } {
            usual
            keep -wrap -tabs
            rename -background -textbackground textBackground Background
        }
        pack $itk_component(text) -side left -expand yes -fill both

        itk_component add scrollbar {
            scrollbar $itk_interior.sbar \
                -command [code $itk_interior.info yview]
        }
        pack $itk_component(scrollbar) -side right -fill y

        eval itk_initialize $args

        pack propagate $itk_component(hull) 0

        fixScrollbar
        bind $itk_component(text) <Configure> [code $this fixScrollbar]

        $itk_component(text) tag configure bold \
            -font -*-courier-bold-r-normal--*-120-*

        $itk_component(text) tag configure italic \
            -font -*-courier-medium-o-normal--*-120-*
    }

    public method display {info}
    public method append {info}
    public method substitute {word newword}

    itk_option define -scrollbar scrollbar Scrollbar "on" {
        switch -- $itk_option(-scrollbar) {
            on - off - auto {
                fixScrollbar
            }
            default {
                error "bad value \"$itk_option(-scollbar)\""
            }
        }
    }

    protected method fixScrollbar {}
    private variable sbvisible 1
}

body TextDisplay::display {args} {
    $itk_component(text) configure -state normal
    $itk_component(text) delete 1.0 end
    eval $itk_component(text) insert 1.0 $args
    $itk_component(text) configure -state disabled
    fixScrollbar
}

body TextDisplay::append {args} {
    $itk_component(text) configure -state normal
    eval $itk_component(text) insert end $args
    $itk_component(text) configure -state disabled
    fixScrollbar
}

body TextDisplay::substitute {word newword} {
    $itk_component(text) configure -state normal

    set index 1.0
    while {1} {
        set index [$itk_component(text) search -count len $word $index]
        if {$index != ""} {
            $itk_component(text) delete $index "$index + $len chars"
            $itk_component(text) insert $index $newword
        } else {
            break
        }
    }
    $itk_component(text) configure -state disabled
    fixScrollbar
}

body TextDisplay::fixScrollbar {} {
    switch $itk_option(-scrollbar) {
        on  { set sbstate 1 }
        off { set sbstate 0 }

        auto {
            if {[$itk_component(text) bbox 1.0] == "" ||
                [$itk_component(text) bbox end-1char] == ""} {
                set sbstate 1
            } else {
                set sbstate 0
            }
        }
    }
    if {$sbstate != $sbvisible} {
        if {$sbstate} {
            pack $itk_component(scrollbar) -side right -fill y
        } else {
            pack forget $itk_component(scrollbar)
        }
        set sbvisible $sbstate
    }
}

usual TextDisplay {
    keep -background -cursor -foreground -font
    keep -activebackground -activerelief
    keep -highlightcolor -highlightthickness
    keep -insertbackground -insertborderwidth -insertwidth
    keep -insertontime -insertofftime
    keep -selectbackground -selectborderwidth -selectforeground
    keep -textbackground -troughcolor
}