Posted to tcl by emiliano at Wed Nov 17 21:42:08 GMT 2010view pretty
# needed only to move the original command namespace eval ::ttk::scrollableframe {} proc ::ttk::scrollableframe {w args} { frame $w -class TScrolledframe set c [canvas $w.canvas \ -borderwidth 0 \ -highlightthickness 0 \ -background [style lookup "." -background]] pack $c -expand 1 -fill both set f [frame $w.canvas.frame] $c create window {0 0} -window $f -anchor nw bind $c <<ThemeChanged>> { %W configure -background [ttk::style lookup . -background] } bind $f <Configure> [list $c configure -scrollregion {0 0 %w %h}] bind $c <Destroy> [list rename ::$w {}] set opts { -xscrollcommand -yscrollcommand -xscrollincrement -yscrollincrement } dict set map getframe [list ::apply {{f} {return $f}} $f] dict set map xview [list ::apply {{c args} {$c xview {*}$args}} $c] dict set map yview [list ::apply {{c args} {$c yview {*}$args}} $c] dict set map cget [list ::apply {{c opts option} { if {$option ni $opts} { return -code error "unknown option \"$option\"" } $c cget $option }} $c $opts] dict set map configure [list ::apply {{c opts args} { switch -- [llength $args] { 0 { set result [list] set conflist [$c configure] foreach option $opts { lappend result [lsearch -inline $conflist ${option}*] } return $result } 1 { set option [lindex $args 0] if {$option in $opts} { return [$c configure $option] } else { return -code error "unknown option \"$option\"" } } default { dict for {option value} $args { if {$option in $opts} { $c configure $option $value } else { return -code error "unknown option \"$option\"" } } } } }} $c $opts] dict set map see [list ::apply {{c widget {vert top} {horz left}} { scan [winfo geometry $widget] "%dx%d+%d+%d" w h xo yo lassign [$c cget -scrollregion] -> -> Xo Yo if {$vert eq "bottom"} { set yo [expr {$yo - [winfo height $c] + $h}] } if {$horz eq "right"} { set xo [expr {$xo - [winfo width $c] + $w}] } set yfrac [expr {double($yo) / $Yo}] set xfrac [expr {double($xo) / $Xo}] $c xview moveto $xfrac $c yview moveto $yfrac }} $c] rename ::$w ::ttk::scrolledframe::$w namespace ensemble create \ -command ::$w \ -map $map ::$w configure {*}$args return $w } # needed only to move the original command namespace eval ::ttk::scrolledwindow {} proc ::ttk::scrolledwindow {w} { frame $w -class TScrolledwindow scrollbar $w.sy -orient vertical scrollbar $w.sx -orient horizontal grid $w.sy -row 0 -column 1 -sticky ns grid $w.sx -row 1 -column 0 -sticky ew grid columnconfigure $w 0 -weight 1 grid rowconfigure $w 0 -weight 1 grid remove $w.sx $w.sy bind $w.sy <Destroy> [list rename ::$w {}] set lambdaterm {{scrollbar from to} { if {$from == 0.0 && $to == 1.0} { grid remove $scrollbar } else { grid $scrollbar } $scrollbar set $from $to }} dict set map setwidget [list ::apply {{w lambdaterm widget} { set old [grid slaves $w -row 0 -column 0] if {$old ne ""} { grid forget $old } grid $widget -in $w -sticky news -row 0 -column 0 $widget configure \ -xscrollcommand [list apply $lambdaterm $w.sx] \ -yscrollcommand [list apply $lambdaterm $w.sy] $w.sx configure -command [list $widget xview] $w.sy configure -command [list $widget yview] }} $w $lambdaterm] rename ::$w ::ttk::scrolledwindow::$w namespace ensemble create \ -command ::$w \ -map $map return $w }