scrollw.tcl

是TCL的另外一个编译（解释）器

# -----------------------------------------------------------------------------
#  scrollw.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: scrollw.tcl,v 1.4 2000/02/26 01:56:41 ericm Exp $
# -----------------------------------------------------------------------------
#  Index of commands:
#     - ScrolledWindow::create
#     - ScrolledWindow::getframe
#     - ScrolledWindow::setwidget
#     - ScrolledWindow::configure
#     - ScrolledWindow::cget
#     - ScrolledWindow::_set_hframe
#     - ScrolledWindow::_set_vscroll
#     - ScrolledWindow::_setData
#     - ScrolledWindow::_setSBSize
#     - ScrolledWindow::_realize
# -----------------------------------------------------------------------------

namespace eval ScrolledWindow {
    Widget::declare ScrolledWindow {
        {-background  TkResource ""   0 button}
        {-scrollbar   Enum       both 0 {none both vertical horizontal}}
        {-auto        Enum       both 0 {none both vertical horizontal}}
        {-sides       Enum       se   0 {ne en nw wn se es sw ws}}
        {-size        Int        0    1 "%d >= 0"}
        {-ipad        Int        1    1 "%d >= 0"}
        {-managed     Boolean    1    1}
        {-relief      TkResource flat 0 frame}
        {-borderwidth TkResource 0    0 frame}
        {-bg          Synonym    -background}
        {-bd          Synonym    -borderwidth}
    }

    Widget::addmap ScrolledWindow "" ._grid.f {-relief {} -borderwidth {}}

    proc ::ScrolledWindow {path args} {
        return [eval ScrolledWindow::create $path $args]
    }
    proc use {} {}
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::create
# -----------------------------------------------------------------------------
proc ScrolledWindow::create { path args } {
    upvar \#0 ScrolledWindow::$path data

    Widget::init ScrolledWindow $path $args

    set bg     [Widget::cget $path -background]
    set sbsize [Widget::cget $path -size]
    set ipad   [Widget::cget $path -ipad]
    set sw     [frame $path \
                    -relief flat -borderwidth 0 -background $bg \
                    -highlightthickness 0 -takefocus 0]
    set grid   [frame $path._grid \
                    -relief flat -borderwidth 0 -background $bg \
                    -highlightthickness 0 -takefocus 0]
    set fv     [frame $grid.vframe \
                    -relief flat -borderwidth 0 -background $bg \
                    -highlightthickness 0 -takefocus 0]
    set fh     [frame $grid.hframe \
                    -relief flat -borderwidth 0 -background $bg \
                    -highlightthickness 0 -takefocus 0]
    eval frame $grid.f -background $bg -highlightthickness 0 \
        [Widget::subcget $path ._grid.f]

    scrollbar $grid.hscroll \
        -highlightthickness 0 -takefocus 0 \
        -orient  horiz	\
        -relief  sunken	\
        -bg      $bg
    scrollbar $grid.vscroll \
        -highlightthickness 0 -takefocus 0 \
        -orient  vert  	\
        -relief  sunken	\
        -bg      $bg

    set data(realized) 0

    _setData $path \
        [Widget::cget $path -scrollbar] \
        [Widget::cget $path -auto] \
        [Widget::cget $path -sides]

    if {[Widget::cget $path -managed]} {
        set data(hsb,packed) $data(hsb,present)
        set data(vsb,packed) $data(vsb,present)
    } else {
        set data(hsb,packed) 0
        set data(vsb,packed) 0
    }
    if {$sbsize} {
        $grid.vscroll configure -width $sbsize
        $grid.hscroll configure -width $sbsize
    } else {
        set sbsize [$grid.vscroll cget -width]
    }
    set size [expr {$sbsize+$ipad}]

    $grid.vframe configure -width  $size
    $grid.hframe configure -height $size
    set vplaceopt [list -in $grid.vframe -x [expr {(1-$data(vsb,west))*$ipad}] -y 0 -width [expr {-$ipad}]]
    set hplaceopt [list -in $grid.hframe -x 0 -y [expr {(1-$data(hsb,north))*$ipad}] -height [expr {-$ipad}]]
    pack propagate $grid.vframe 0
    pack propagate $grid.hframe 0
    pack $grid.vscroll -in $grid.vframe
    pack $grid.hscroll -in $grid.hframe

    bind $grid.hscroll <Configure> \
        "ScrolledWindow::_setSBSize $grid.hscroll $size -relwidth 1.0 -relheight 1.0 $hplaceopt"
    bind $grid.vscroll <Configure> \
        "ScrolledWindow::_setSBSize $grid.vscroll $size -relwidth 1.0 -relheight 1.0 $vplaceopt"

    grid $grid.hframe \
        -column     [expr {$data(vsb,west)*$data(vsb,packed)}] \
        -row        [expr {1-$data(hsb,north)}]  \
        -columnspan [expr {2-$data(vsb,packed)}] \
        -sticky we
    grid $grid.vframe \
        -column  [expr {1-$data(vsb,west)}] \
        -row     [expr {$data(hsb,north)*$data(hsb,packed)}] \
        -rowspan [expr {2-$data(hsb,packed)}] \
        -sticky ns

    grid $grid.f \
        -column     [expr {$data(vsb,west)*$data(vsb,packed)}]  \
        -row        [expr {$data(hsb,north)*$data(hsb,packed)}] \
        -columnspan [expr {2-$data(vsb,packed)}] \
        -rowspan    [expr {2-$data(hsb,packed)}] \
        -sticky     nwse

    grid columnconfigure $grid $data(vsb,west)  -weight 1
    grid rowconfigure    $grid $data(hsb,north) -weight 1
    pack $grid -fill both -expand yes

    bind $grid <Configure> "ScrolledWindow::_realize $path"
    bind $grid <Destroy>   "ScrolledWindow::_destroy $path"
    raise $grid.f
    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval ScrolledWindow::\$cmd $path \$args\]"

    return $path
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::getframe
# -----------------------------------------------------------------------------
proc ScrolledWindow::getframe { path } {
    return $path
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::setwidget
# -----------------------------------------------------------------------------
proc ScrolledWindow::setwidget { path widget } {
    upvar \#0 ScrolledWindow::$path data

    set grid   $path._grid

    pack $widget -in $grid.f -fill both -expand yes

    $grid.hscroll configure -command "$widget xview"
    $grid.vscroll configure -command "$widget yview"
    $widget configure \
        -xscrollcommand "ScrolledWindow::_set_hscroll $path" \
        -yscrollcommand "ScrolledWindow::_set_vscroll $path"
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::configure
# -----------------------------------------------------------------------------
proc ScrolledWindow::configure { path args } {
    upvar \#0 ScrolledWindow::$path data

    set grid $path._grid
    set res [Widget::configure $path $args]
    if { [Widget::hasChanged $path -background bg] } {
        $path configure -background $bg
        $grid configure -background $bg
        $grid.f configure -background $bg
        catch {$grid.hscroll configure -background $bg}
        catch {$grid.vscroll configure -background $bg}
    }

    if {[Widget::hasChanged $path -scrollbar scrollbar] |
        [Widget::hasChanged $path -auto      auto]     |
        [Widget::hasChanged $path -sides     sides]} {
        _setData $path $scrollbar $auto $sides
        set hscroll [$grid.hscroll get]
        set vmin    [lindex $hscroll 0]
        set vmax    [lindex $hscroll 1]
        set data(hsb,packed) [expr {$data(hsb,present) &&
                                    (!$data(hsb,auto) || ($vmin != 0 || $vmax != 1))}]
        set vscroll [$grid.vscroll get]
        set vmin    [lindex $vscroll 0]
        set vmax    [lindex $vscroll 1]
        set data(vsb,packed) [expr {$data(vsb,present) &&
                                    (!$data(vsb,auto) || ($vmin != 0 || $vmax != 1))}]

        set ipad [Widget::cget $path -ipad]
        place configure $grid.vscroll \
            -x [expr {(1-$data(vsb,west))*$ipad}]
        place configure $grid.hscroll \
            -y [expr {(1-$data(hsb,north))*$ipad}]

        grid configure $grid.hframe \
            -column     [expr {$data(vsb,west)*$data(vsb,packed)}] \
            -row        [expr {1-$data(hsb,north)}]  \
            -columnspan [expr {2-$data(vsb,packed)}]
        grid configure $grid.vframe \
            -column  [expr {1-$data(vsb,west)}] \
            -row     [expr {$data(hsb,north)*$data(hsb,packed)}] \
            -rowspan [expr {2-$data(hsb,packed)}]
        grid configure $grid.f \
            -column     [expr {$data(vsb,west)*$data(vsb,packed)}] \
            -row        [expr {$data(hsb,north)*$data(hsb,packed)}] \
            -columnspan [expr {2-$data(vsb,packed)}] \
            -rowspan    [expr {2-$data(hsb,packed)}]
        grid columnconfigure $grid $data(vsb,west)             -weight 1
        grid columnconfigure $grid [expr {1-$data(vsb,west)}]  -weight 0
        grid rowconfigure    $grid $data(hsb,north)            -weight 1
        grid rowconfigure    $grid [expr {1-$data(hsb,north)}] -weight 0
    }
    return $res
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::cget
# -----------------------------------------------------------------------------
proc ScrolledWindow::cget { path option } {
    return [Widget::cget $path $option]
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::_destroy
# -----------------------------------------------------------------------------
proc ScrolledWindow::_destroy { path } {
    upvar \#0 ScrolledWindow::$path data

    unset data
    Widget::destroy $path
    rename $path {}
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::_set_hscroll
# -----------------------------------------------------------------------------
proc ScrolledWindow::_set_hscroll { path vmin vmax } {
    upvar \#0 ScrolledWindow::$path data

    if {$data(realized) && $data(hsb,present)} {
        set grid $path._grid
        if {$data(hsb,auto)} {
            if {$data(hsb,packed) && $vmin == 0 && $vmax == 1} {
                set data(hsb,packed) 0
                grid configure $grid.f $grid.vframe -row 0 -rowspan 2
            } elseif {!$data(hsb,packed) && ($vmin != 0 || $vmax != 1)} {
                set data(hsb,packed) 1
                grid configure $grid.f $grid.vframe -row $data(hsb,north) -rowspan 1
            }
        }
	update idletask
        $grid.hscroll set $vmin $vmax
    }
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::_set_vscroll
# -----------------------------------------------------------------------------
proc ScrolledWindow::_set_vscroll { path vmin vmax } {
    upvar \#0 ScrolledWindow::$path data

    if {$data(realized) && $data(vsb,present)} {
        set grid $path._grid
        if {$data(vsb,auto)} {
            if {$data(vsb,packed) && $vmin == 0 && $vmax == 1} {
                set data(vsb,packed) 0
                grid configure $grid.f $grid.hframe -column 0 -columnspan 2
            } elseif {!$data(vsb,packed) && ($vmin != 0 || $vmax != 1) } {
                set data(vsb,packed) 1
                grid configure $grid.f $grid.hframe -column $data(vsb,west) -columnspan 1
            }
        }
	update idletask
        $grid.vscroll set $vmin $vmax
    }
}


proc ScrolledWindow::_setData {path scrollbar auto sides} {
    upvar \#0 ScrolledWindow::$path data

    set sb    [lsearch {none horizontal vertical both} $scrollbar]
    set auto  [lsearch {none horizontal vertical both} $auto]
    set north [string match *n* $sides]
    set west  [string match *w* $sides]

    set data(hsb,present)  [expr {($sb & 1) != 0}]
    set data(hsb,auto)     [expr {($auto & 1) != 0}]
    set data(hsb,north)    $north

    set data(vsb,present)  [expr {($sb & 2) != 0}]
    set data(vsb,auto)     [expr {($auto & 2) != 0}]
    set data(vsb,west)     $west
}


proc ScrolledWindow::_setSBSize {sb size args} {
    $sb configure -width $size
    eval place $sb $args
}


# -----------------------------------------------------------------------------
#  Command ScrolledWindow::_realize
# -----------------------------------------------------------------------------
proc ScrolledWindow::_realize { path } {
    upvar \#0 ScrolledWindow::$path data

    set grid $path._grid
    bind $grid <Configure> {}
    set data(realized) 1
    place $grid -anchor nw -x 0 -y 0 -relwidth 1.0 -relheight 1.0
}