http://wiki.tcl.tk/_repo/ulis/Scrolledframe.zip

The package edit

  if {[info exists ::scrolledframe::version]} { return }
  namespace eval ::scrolledframe \
  {
  # beginning of ::scrolledframe namespace definition

    namespace export scrolledframe

  # ==============================
  #
  # scrolledframe
  set version 0.9.1
  #
  # a scrolled frame
  #
  # (C) 2003, ulis
  #
  # NOL licence (No Obligation Licence)
  #
  # ==============================
  #
  # Hacked package, no documentation, sorry
  # See example at bottom
  #
  # ------------------------------
  # v 0.9.1
  #  automatic scroll on resize
  # ==============================

    package provide Scrolledframe $version

    # --------------
    #
    # create a scrolled frame
    #
    # --------------
    # parm1: widget name
    # parm2: options key/value list
    # --------------
    proc scrolledframe {w args} \
    {
      variable {}
      # create a scrolled frame
      frame $w
      # trap the reference
      rename $w ::scrolledframe::_$w
      # redirect to dispatch
      interp alias {} $w {} ::scrolledframe::dispatch $w
      # create scrollable internal frame
      frame $w.scrolled -highlightt 0 -padx 0 -pady 0
      # place it
      place $w.scrolled -in $w -x 0 -y 0
      # init internal data
      set ($w:vheight) 0
      set ($w:vwidth) 0
      set ($w:vtop) 0
      set ($w:vleft) 0
      set ($w:xscroll) ""
      set ($w:yscroll) ""
      # configure
      if {$args != ""} { uplevel 1 ::scrolledframe::config $w $args }
      # bind <Configure>
      bind $w <Configure> [namespace code [list vresize $w]]
      bind $w.scrolled <Configure> [namespace code [list resize $w]]
      # return widget ref
      return $w
    }

    # --------------
    #
    # dispatch the trapped command
    #
    # --------------
    # parm1: widget name
    # parm2: operation
    # parm2: operation args
    # --------------
    proc dispatch {w cmd args} \
    {
      variable {}
      switch -glob -- $cmd \
      {
        con*    { uplevel 1 [linsert $args 0 ::scrolledframe::config $w] }
        xvi*    { uplevel 1 [linsert $args 0 ::scrolledframe::xview  $w] }
        yvi*    { uplevel 1 [linsert $args 0 ::scrolledframe::yview  $w] }
        default { uplevel 1 [linsert $args 0 ::scrolledframe::_$w    $cmd] }
      }
    }

    # --------------
    # configure operation
    #
    # configure the widget
    # --------------
    # parm1: widget name
    # parm2: options
    # --------------
    proc config {w args} \
    {
      variable {}
      set options {}
      set flag 0
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          -xsc*   \
          {
            # new xscroll option
            set ($w:xscroll) $value
            set flag 1
          }
          -ysc*   \
          {
            # new yscroll option
            set ($w:yscroll) $value
            set flag 1
          }
          default { lappend options $key $value }
        }
      }
      # check if needed
      if {!$flag || $options != ""} \
      { 
        # call frame config
        uplevel 1 [linsert $options 0 ::scrolledframe::_$w config]
      }
    }

    # --------------
    # resize proc
    #
    # resize the scrolled region
    # --------------
    # parm1: widget name
    # --------------
    proc resize {w} \
    {
      variable {}
      # compute new height & width
      set ($w:vheight) [winfo reqheight $w.scrolled]
      set ($w:vwidth) [winfo reqwidth $w.scrolled]
      # resize the scroll bars
      vresize $w
    }

    # --------------
    # vresize proc
    #
    # resize the visible part
    # --------------
    # parm1: widget name
    # --------------
    proc vresize {w} \
    { 
      xview $w scroll 0 unit
      yview $w scroll 0 unit
      xset $w
      yset $w 
    }

    # --------------
    # xset proc
    #
    # resize the visible part
    # --------------
    # parm1: widget name
    # --------------
    proc xset {w} \
    {
      variable {}
      # call the xscroll command
      set cmd $($w:xscroll)
      if {$cmd != ""} { catch { eval $cmd [xview $w] } }
    }

    # --------------
    # yset proc
    #
    # resize the visible part
    # --------------
    # parm1: widget name
    # --------------
    proc yset {w} \
    {
      variable {}
      # call the yscroll command
      set cmd $($w:yscroll)
      if {$cmd != ""} { catch { eval $cmd [yview $w] } }
    }

    # -------------
    # xview
    #  
    # called on horizontal scrolling
    # -------------
    # parm1: widget path
    # parm2: optional moveto or scroll
    # parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
    # -------------
    # return: scrolling info if parm2 is empty
    # -------------

    proc xview {w {cmd ""} args} \
    {
      variable {}
      # check args
      set len [llength $args]
      switch -glob -- $cmd \
      {
        ""      {}
        mov*    \
        { if {$len != 1} { error "wrong # args: should be \"$w xview moveto fraction\"" } }
        scr*    \
        { if {$len != 2} { error "wrong # args: should be \"$w xview scroll count unit\"" } }
        default \
        { error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
      }
      # save old values
      set _vleft $($w:vleft)
      set _vwidth $($w:vwidth)
      set _width [winfo width $w]
      # compute new vleft
      set count ""
      switch $len \
      {
        0       \
        { 
          # return fractions
          if {$_vwidth == 0} { return {0 1} }
          set first [expr {double($_vleft) / $_vwidth}]
          set last [expr {double($_vleft + $_width) / $_vwidth}]
          if {$last > 1.0} { return {0 1} }
          return [list $first $last]
        }
        1       \
        { 
          # absolute movement
          set vleft [expr {int(double($args) * $_vwidth)}]
        }
        2       \
        { 
          # relative movement
          foreach {count unit} $args break
          if {[string match p* $unit]} { set count [expr {$count * 9}] }
          set vleft [expr {$_vleft + $count * 0.1 * $_width}]
        }
      }
      if {$vleft < 0} { set vleft 0 }
      if {$vleft + $_width > $_vwidth} { set vleft [expr {$_vwidth - $_width}] }
      if {$vleft != $_vleft || $count == 0} \
      {
        set ($w:vleft) $vleft
        xset $w
        place $w.scrolled -in $w -x [expr {-$vleft}]
      }
    }

    # -------------
    # yview
    #  
    # called on vertical scrolling
    # -------------
    # parm1: widget path
    # parm2: optional moveto or scroll
    # parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
    # -------------
    # return: scrolling info if parm2 is empty
    # -------------

    proc yview {w {cmd ""} args} \
    {
      variable {}
      # check args
      set len [llength $args]
      switch -glob -- $cmd \
      {
        ""      {}
        mov*    \
        { if {$len != 1} { error "wrong # args: should be \"$w yview moveto fraction\"" } }
        scr*    \
        { if {$len != 2} { error "wrong # args: should be \"$w yview scroll count unit\"" } }
        default \
        { error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
      }
      # save old values
      set _vtop $($w:vtop)
      set _vheight $($w:vheight)
      set _height [winfo height $w]
      # compute new vtop
      set count ""
      switch $len \
      {
        0       \
        { 
          # return fractions
          if {$_vheight == 0} { return {0 1} }
          set first [expr {double($_vtop) / $_vheight}]
          set last [expr {double($_vtop + $_height) / $_vheight}]
          if {$last > 1.0} { return {0 1} }
          return [list $first $last]
        }
        1       \
        { 
          # absolute movement
          set vtop [expr {int(double($args) * $_vheight)}]
        }
        2       \
        { 
          # relative movement
          foreach {count unit} $args break
          if {[string match p* $unit]} { set count [expr {$count * 9}] }
          set vtop [expr {$_vtop + $count * 0.1 * $_height}]
        }
      }
      if {$vtop < 0} { set vtop 0 }
      if {$vtop + $_height > $_vheight} { set vtop [expr {$_vheight - $_height}] }
      if {$vtop != $_vtop || $count == 0} \
      {
        set ($w:vtop) $vtop
        yset $w
        place $w.scrolled -in $w -y [expr {-$vtop}]
        puts "place $w.scrolled -in $w -y [expr {-$vtop}]"
      }
    }

  # end of ::scrolledframe namespace definition
  }

The demo edit

  # ==============================
  #
  # demo
  #
  # ==============================

    if {[catch {package require Scrolledframe}]} \
    {
      source [file join [file dirname [info script]] scrolledframe.tcl]
      package require Scrolledframe
    }
    namespace import ::scrolledframe::scrolledframe
    scrolledframe .sf -height 150 -width 100 \
        -xscroll {.hs set} -yscroll {.vs set}
    scrollbar .vs -command {.sf yview}
    scrollbar .hs -command {.sf xview} -orient horizontal
    grid .sf -row 0 -column 0 -sticky nsew
    grid .vs -row 0 -column 1 -sticky ns
    grid .hs -row 1 -column 0 -sticky ew
    grid rowconfigure . 0 -weight 1
    grid columnconfigure . 0 -weight 1
    set f .sf.scrolled
    foreach i {0 1 2 3 4 5 6 7 8 9} \
    { 
      label $f.l$i -text "Hi! I'm the scrolled label $i" -relief groove
      pack $f.l$i -padx 10 -pady 2
    }

Another demo edit

  # packages
  source ../Scrolledframe/scrolledframe.tcl
  namespace import ::scrolledframe::scrolledframe
  package require Tk
  # create widgets
  set bd 2
  set bd2 [expr {$bd * 2}]
  frame .f0 -bd 1 -relief groove
  frame .f1
  button .f1._A4 -text A4 -width 10 -command {size A4}
  button .f1._A3 -text A3 -width 10 -command {size A3}
  pack .f1._A4 .f1._A3 -padx 10 -pady 10 -side left
  scrolledframe .f2 -xscrollc {.hs set} -yscrollc {.vs set}
  canvas .f2.scrolled.c -bd 1 -relief ridge \
      -highlightt 0 -bg beige
  .f2.scrolled.c create text 0 0 -tags size
  pack .f2.scrolled.c
  scrollbar .vs -command {.f2 yview}
  scrollbar .hs -command {.f2 xview} -orient horizontal
  # place widgets
  grid .f0 -row 1 -column 0 -sticky nsew
  grid .f1 -row 0 -column 0 -columnspan 2
  grid .f2 -row 1 -column 0
  grid .vs -row 1 -column 1 -sticky ns
  grid .hs -row 2 -column 0 -sticky ew
  grid rowconfigure . 1 -weight 1
  grid columnconfigure . 0 -weight 1
  wm geometry . 300x400
  # sizing the canvas
  proc size {size} \
  { 
    switch $size \
    {
      A3    { set width 297; set height 420 }
      A4    { set width 210; set height 297 }
    }
    set c .f2.scrolled.c
    $c config -width $width -height $height 
    set bd [$c cget -bd]
    set bd*2 [expr {$bd * 2}]
    .f2 config -width [incr width ${bd*2}] -height [incr height ${bd*2}]
    $c coords size [expr {$width / 2}] [expr {$height / 2}]
    $c itemconfig size -text $size
  }
  # init
  size A4

See also edit

• Scrolled.frame
• scrolledframe

Wrapper edit

  # function to wrap the scrolledframe package
  proc scrollframe { fname args } {
    
    set parent [eval frame $fname $args]

    scrolledframe $parent.sf \
        -xscroll "$parent.hs set" -yscroll "$parent.vs set"
    scrollbar $parent.vs -command "$parent.sf yview"
    scrollbar $parent.hs -command "$parent.sf xview" -orient horizontal
    grid $parent.sf -row 0 -column 0 -sticky nsew
    grid $parent.vs -row 0 -column 1 -sticky ns
    grid $parent.hs -row 1 -column 0 -sticky ew
    grid rowconfigure $parent 0 -weight 1
    grid columnconfigure $parent 0 -weight 1
    return $parent.sf.scrolled
  }

 proc Scrolled_Frame { fname args } {
    set parent [eval frame $fname $args]
    scrolledframe $parent.sf -xscroll [list $parent.hs set] -yscroll [list $parent.vs set]
    foreach {arg1 arg2} $args {
        $parent.sf.scrolled configure $arg1 $arg2
    }
    scrollbar $parent.vs -command [list $parent.sf yview] -orient vertical
    scrollbar $parent.hs -command [list $parent.sf xview] -orient horizontal
    grid $parent.sf -row 0 -column 0 -sticky news
    grid $parent.vs -row 0 -column 1 -sticky ns
    grid $parent.hs -row 1 -column 0 -sticky ew
    grid rowconfigure $parent 0 -weight 1
    grid columnconfigure $parent 0 -weight 1
    return $parent.sf.scrolled
 }
 set blah [Scrolled_Frame .sf -bg #ffffff -relief sunken -bd 50]
 set blah2 [Scrolled_Frame .sf2]
 set blah3 [Scrolled_Frame .sf3 -bg #666666 -relief groove -bd 2]
 set x 0
 while {$x < 100} {
    label $blah.$x -text "This is a Scrolled Frame."
    grid $blah.$x -row $x -column $x -sticky news
    label $blah2.$x -text "This is also a Scrolled Frame."
    grid $blah2.$x -row $x -column $x -sticky news
    label $blah3.$x -text "You guessed it."
    grid $blah3.$x -row $x -column $x -sticky news
    incr x
 }
 pack .sf -fill both -expand true
 pack .sf2 -fill both -expand true
 pack .sf3 -fill both -expand true

The KJN optimized & enhanced version edit

  if {[info exists ::scrolledframe::version]} { return }
  namespace eval ::scrolledframe \
  {
  # beginning of ::scrolledframe namespace definition

    package require Tk 8.4
    namespace export scrolledframe

  # ==============================
  #
  # scrolledframe
  set version 0.9.1
  set (debug,place) 0
  #
  # a scrolled frame
  #
  # (C) 2003, ulis
  #
  # NOL licence (No Obligation Licence)
  #
  # Changes (C) 2004, KJN
  #
  # NOL licence (No Obligation Licence)
  # ==============================
  #
  # Hacked package, no documentation, sorry
  # See example at bottom
  #
  # ------------------------------
  # v 0.9.1
  #  automatic scroll on resize
  # ==============================

    package provide Scrolledframe $version

    # --------------
    #
    # create a scrolled frame
    #
    # --------------
    # parm1: widget name
    # parm2: options key/value list
    # --------------
    proc scrolledframe {w args} \
    {
      variable {}
      # create a scrolled frame
      frame $w
      # trap the reference
      rename $w ::scrolledframe::_$w
      # redirect to dispatch
      interp alias {} $w {} ::scrolledframe::dispatch $w
      # create scrollable internal frame
      frame $w.scrolled -highlightt 0 -padx 0 -pady 0
      # place it
      place $w.scrolled -in $w -x 0 -y 0
      if {$(debug,place)} { puts "place $w.scrolled -in $w -x 0 -y 0" } ;#DEBUG
      # init internal data
      set ($w:vheight) 0
      set ($w:vwidth) 0
      set ($w:vtop) 0
      set ($w:vleft) 0
      set ($w:xscroll) ""
      set ($w:yscroll) ""
      set ($w:width)    0
      set ($w:height)   0
      set ($w:fillx)    0
      set ($w:filly)    0
      # configure
      if {$args != ""} { uplevel 1 ::scrolledframe::config $w $args }
      # bind <Configure>
      bind $w <Configure> [namespace code [list resize $w]]
      bind $w.scrolled <Configure> [namespace code [list resize $w]]
      # return widget ref
      return $w
    }

    # --------------
    #
    # dispatch the trapped command
    #
    # --------------
    # parm1: widget name
    # parm2: operation
    # parm2: operation args
    # --------------
    proc dispatch {w cmd args} \
    {
      variable {}
      switch -glob -- $cmd \
      {
        con*    { uplevel 1 [linsert $args 0 ::scrolledframe::config $w] }
        xvi*    { uplevel 1 [linsert $args 0 ::scrolledframe::xview  $w] }
        yvi*    { uplevel 1 [linsert $args 0 ::scrolledframe::yview  $w] }
        default { uplevel 1 [linsert $args 0 ::scrolledframe::_$w    $cmd] }
      }
    }

    # --------------
    # configure operation
    #
    # configure the widget
    # --------------
    # parm1: widget name
    # parm2: options
    # --------------
    proc config {w args} \
    {
      variable {}
      set options {}
      set flag 0
      foreach {key value} $args \
      {
        switch -glob -- $key \
        {
          -fill   \
          {
            # new fill option: what should the scrolled object do if it is smaller than the viewing window?
            if {$value == "none"} {
               set ($w:fillx) 0
               set ($w:filly) 0
            } elseif {$value == "x"} {
               set ($w:fillx) 1
               set ($w:filly) 0
            } elseif {$value == "y"} {
               set ($w:fillx) 0
               set ($w:filly) 1
            } elseif {$value == "both"} {
               set ($w:fillx) 1
               set ($w:filly) 1
            } else {
               error "invalid value: should be \"$w configure -fill value\", where \"value\" is \"x\", \"y\", \"none\", or \"both\""
            }
            resize $w force
            set flag 1
          }
          -xsc*   \
          {
            # new xscroll option
            set ($w:xscroll) $value
            set flag 1
          }
          -ysc*   \
          {
            # new yscroll option
            set ($w:yscroll) $value
            set flag 1
          }
          default { lappend options $key $value }
        }
      }
      # check if needed
      if {!$flag || $options != ""} \
      {
        # call frame config
        uplevel 1 [linsert $options 0 ::scrolledframe::_$w config]
      }
    }

    # --------------
    # resize proc
    #
    # Update the scrollbars if necessary, in response to a change in either the viewing window
    # or the scrolled object. 
    # Replaces the old resize and the old vresize
    # A <Configure> call may mean any change to the viewing window or the scrolled object.
    # We only need to resize the scrollbars if the size of one of these objects has changed.
    # Usually the window sizes have not changed, and so the proc will not resize the scrollbars.
    # --------------
    # parm1: widget name
    # parm2: pass anything to force resize even if dimensions are unchanged
    # --------------
    proc resize {w args} \
    {
      variable {}
      set force [llength $args]

      set _vheight     $($w:vheight)
      set _vwidth      $($w:vwidth)
      # compute new height & width
      set ($w:vheight) [winfo reqheight $w.scrolled]
      set ($w:vwidth)  [winfo reqwidth  $w.scrolled]

      # The size may have changed, e.g. by manual resizing of the window
      set _height     $($w:height)
      set _width      $($w:width)
      set ($w:height) [winfo height $w] ;# gives the actual height of the viewing window
      set ($w:width)  [winfo width  $w] ;# gives the actual width of the viewing window


      if {$force || $($w:vheight) != $_vheight || $($w:height) != $_height} {
        # resize the vertical scroll bar
        yview $w scroll 0 unit
        # yset $w
      }

      if {$force || $($w:vwidth) != $_vwidth || $($w:width) != $_width} {
        # resize the horizontal scroll bar
        xview $w scroll 0 unit
        # xset $w
      }
    } ;# end proc resize


    # --------------
    # xset proc
    #
    # resize the visible part
    # --------------
    # parm1: widget name
    # --------------
    proc xset {w} \
    {
      variable {}
      # call the xscroll command
      set cmd $($w:xscroll)
      if {$cmd != ""} { catch { eval $cmd [xview $w] } }
    }

    # --------------
    # yset proc
    #
    # resize the visible part
    # --------------
    # parm1: widget name
    # --------------
    proc yset {w} \
    {
      variable {}
      # call the yscroll command
      set cmd $($w:yscroll)
      if {$cmd != ""} { catch { eval $cmd [yview $w] } }
    }

    # -------------
    # xview
    #
    # called on horizontal scrolling
    # -------------
    # parm1: widget path
    # parm2: optional moveto or scroll
    # parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
    # -------------
    # return: scrolling info if parm2 is empty
    # -------------
    proc xview {w {cmd ""} args} \
    {
      variable {}
      # check args
      set len [llength $args]
      switch -glob -- $cmd \
      {
        ""      {set args {}}
        mov*    \
        { if {$len != 1} { error "wrong # args: should be \"$w xview moveto fraction\"" } }
        scr*    \
        { if {$len != 2} { error "wrong # args: should be \"$w xview scroll count unit\"" } }
        default \
        { error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
      }
      # save old values:
      set _vleft $($w:vleft)
      set _vwidth $($w:vwidth)
      set _width  $($w:width)
      # compute new vleft
      set count ""
      switch $len \
      {
        0       \
        {
          # return fractions
          if {$_vwidth == 0} { return {0 1} }
          set first [expr {double($_vleft) / $_vwidth}]
          set last [expr {double($_vleft + $_width) / $_vwidth}]
          if {$last > 1.0} { return {0 1} }
          return [list $first $last]
        }
        1       \
        {
          # absolute movement
          set vleft [expr {int(double($args) * $_vwidth)}]
        }
        2       \
        {
          # relative movement
          foreach {count unit} $args break
          if {[string match p* $unit]} { set count [expr {$count * 9}] }
          set vleft [expr {$_vleft + $count * 0.1 * $_width}]
        }
      }
      if {$vleft + $_width > $_vwidth} { set vleft [expr {$_vwidth - $_width}] }
      if {$vleft < 0} { set vleft 0 }
      if {$vleft != $_vleft || $count == 0} \
      {
        set ($w:vleft) $vleft
        xset $w
        if {$($w:fillx) && ($_vwidth < $_width || $($w:xscroll) == "") } {
          # "scrolled object" is not scrolled, because it is too small or because no scrollbar was requested
          # fillx means that, in these cases, we must tell the object what its width should be
          place $w.scrolled -in $w -x [expr {-$vleft}] -width $_width
          if {$(debug,place)} { puts "place $w.scrolled -in $w -x [expr {-$vleft}] -width $_width" } ;#DEBUG
        } else {
          place $w.scrolled -in $w -x [expr {-$vleft}] -width {}
          if {$(debug,place)} { puts "place $w.scrolled -in $w -x [expr {-$vleft}] -width {}" } ;#DEBUG
        }

      }
    }

    # -------------
    # yview
    #
    # called on vertical scrolling
    # -------------
    # parm1: widget path
    # parm2: optional moveto or scroll
    # parm3: fraction if parm2 == moveto, count unit if parm2 == scroll
    # -------------
    # return: scrolling info if parm2 is empty
    # -------------
    proc yview {w {cmd ""} args} \
    {
      variable {}
      # check args
      set len [llength $args]
      switch -glob -- $cmd \
      {
        ""      {set args {}}
        mov*    \
        { if {$len != 1} { error "wrong # args: should be \"$w yview moveto fraction\"" } }
        scr*    \
        { if {$len != 2} { error "wrong # args: should be \"$w yview scroll count unit\"" } }
        default \
        { error "unknown operation \"$cmd\": should be empty, moveto or scroll" }
      }
      # save old values
      set _vtop $($w:vtop)
      set _vheight $($w:vheight)
  #    set _height [winfo height $w]
      set _height $($w:height)
      # compute new vtop
      set count ""
      switch $len \
      {
        0       \
        {
          # return fractions
          if {$_vheight == 0} { return {0 1} }
          set first [expr {double($_vtop) / $_vheight}]
          set last [expr {double($_vtop + $_height) / $_vheight}]
          if {$last > 1.0} { return {0 1} }
          return [list $first $last]
        }
        1       \
        {
          # absolute movement
          set vtop [expr {int(double($args) * $_vheight)}]
        }
        2       \
        {
          # relative movement
          foreach {count unit} $args break
          if {[string match p* $unit]} { set count [expr {$count * 9}] }
          set vtop [expr {$_vtop + $count * 0.1 * $_height}]
        }
      }
      if {$vtop + $_height > $_vheight} { set vtop [expr {$_vheight - $_height}] }
      if {$vtop < 0} { set vtop 0 }
      if {$vtop != $_vtop || $count == 0} \
      {
        set ($w:vtop) $vtop
        yset $w
        if {$($w:filly) && ($_vheight < $_height || $($w:yscroll) == "")} {
          # "scrolled object" is not scrolled, because it is too small or because no scrollbar was requested
          # filly means that, in these cases, we must tell the object what its height should be
          place $w.scrolled -in $w -y [expr {-$vtop}] -height $_height
          if {$(debug,place)} { puts "place $w.scrolled -in $w -y [expr {-$vtop}] -height $_height" } ;#DEBUG
        } else {
          place $w.scrolled -in $w -y [expr {-$vtop}] -height {}
          if {$(debug,place)} { puts "place $w.scrolled -in $w -y [expr {-$vtop}] -height {}" } ;#DEBUG
        }
      }
    }

  # end of ::scrolledframe namespace definition
  }

The KJN demo edit

  # ==============================
  #
  # demo
  #
  # ==============================

    if {[catch {package require Scrolledframe}]} \
    {
      source [file join [file dirname [info script]] sf9223.2.tcl]
      package require Scrolledframe
    }
    namespace import ::scrolledframe::scrolledframe

    scrolledframe .sf -height 150 -width 100 \
        -xscrollcommand {.hs set} -yscrollcommand {.vs set}  -fill both ;# try both, x, y or none
    scrollbar .vs -command {.sf yview}
    scrollbar .hs -command {.sf xview} -orient horizontal
    grid .sf -row 0 -column 0 -sticky nsew
    grid .vs -row 0 -column 1 -sticky ns
    grid .hs -row 1 -column 0 -sticky ew
    grid rowconfigure . 0 -weight 1
    grid columnconfigure . 0 -weight 1
    set f .sf.scrolled
  #  .sf configure -bg white

    foreach i {0 1 2 3 4 5 6 7 8 9} \
    {
      label $f.l$i -text "Hi! I'm the scrolled label $i" -relief groove
      pack $f.l$i -padx 10 -pady 2 -anchor nw -fill x
    }
    label $f.lf -text "Hi! I take up the slack!" -relief groove
    pack  $f.lf -in $f -padx 10 -pady 2 -anchor nw -fill both -expand 1

Scrollable frame, another implementation edit

    # sframe.tcl
    # Paul Walton
    # Create a ttk-compatible, scrollable frame widget.
    #   Usage:
    #       sframe new <path> ?-toplevel true?  ?-anchor nsew?
    #       -> <path>
    #
    #       sframe content <path>
    #       -> <path of child frame where the content should go>
    
    namespace eval ::sframe {
        namespace ensemble create
        namespace export *
    
        # Create a scrollable frame or window.
        proc new {path args} {
            # Use the ttk theme's background for the canvas and toplevel
            set bg [ttk::style lookup TFrame -background]
            if { [ttk::style theme use] eq "aqua" } {
                # Use a specific color on the aqua theme as 'ttk::style lookup' is not accurate.
                set bg "#e9e9e9"
            }
        
            # Create the main frame or toplevel.
            if { [dict exists $args -toplevel]  &&  [dict get $args -toplevel] } {
                toplevel $path  -bg $bg
            } else {
                ttk::frame $path
            }
            
            # Create a scrollable canvas with scrollbars which will always be the same size as the main frame.
            set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -yscrollcommand [list $path.scrolly set] -xscrollcommand [list $path.scrollx set]]
            ttk::scrollbar $path.scrolly -orient vertical   -command [list $canvas yview]
            ttk::scrollbar $path.scrollx -orient horizontal -command [list $canvas xview]
            
            # Create a container frame which will always be the same size as the canvas or content, whichever is greater. 
            # This allows the child content frame to be properly packed and also is a surefire way to use the proper ttk background.
            set container [ttk::frame $canvas.container]
            pack propagate $container 0
            
            # Create the content frame. Its size will be determined by its contents. This is useful for determining if the 
            # scrollbars need to be shown.
            set content [ttk::frame $container.content]
            
            # Pack the content frame and place the container as a canvas item.
            set anchor "n"
            if { [dict exists $args -anchor] } {
                set anchor [dict get $args -anchor]
            }
            pack $content -anchor $anchor
            $canvas create window 0 0 -window $container -anchor nw
            
            # Grid the scrollable canvas sans scrollbars within the main frame.
            grid $canvas   -row 0 -column 0 -sticky nsew
            grid rowconfigure    $path 0 -weight 1
            grid columnconfigure $path 0 -weight 1
            
            # Make adjustments when the sframe is resized or the contents change size.
            bind $path.canvas <Expose> [list [namespace current]::resize $path]
            
            # Mousewheel bindings for scrolling.
            bind [winfo toplevel $path] <MouseWheel>       [list +[namespace current] scroll $path yview %W %D]
            bind [winfo toplevel $path] <Shift-MouseWheel> [list +[namespace current] scroll $path xview %W %D]
            
            return $path
        }
    
    
        # Given the toplevel path of an sframe widget, return the path of the child frame suitable for content.
        proc content {path} {
            return $path.canvas.container.content
        }
    
    
        # Make adjustments when the the sframe is resized or the contents change size.
        proc resize {path} {
            set canvas    $path.canvas
            set container $canvas.container
            set content   $container.content
    
            # Set the size of the container. At a minimum use the same width & height as the canvas.
            set width  [winfo width $canvas]
            set height [winfo height $canvas]
            
            # If the requested width or height of the content frame is greater then use that width or height.
            if { [winfo reqwidth $content] > $width } {
                set width [winfo reqwidth $content]
            }
            if { [winfo reqheight $content] > $height } {
                set height [winfo reqheight $content]
            }
            $container configure  -width $width  -height $height
    
            # Configure the canvas's scroll region to match the height and width of the container.
            $canvas configure -scrollregion [list 0 0 $width $height]
    
            # Show or hide the scrollbars as necessary.
            # Horizontal scrolling.
            if { [winfo reqwidth $content] > [winfo width $canvas] } {
                grid $path.scrollx  -row 1 -column 0 -sticky ew
            } else {
                grid forget $path.scrollx
            }
            # Vertical scrolling.
            if { [winfo reqheight $content] > [winfo height $canvas] } {
                grid $path.scrolly  -row 0 -column 1 -sticky ns
            } else {
                grid forget $path.scrolly
            }
            return
        }
    
    
        # Handle mousewheel scrolling.    
        proc scroll {path view W D} {
            if { [winfo exists $path.canvas]  &&  [string match $path.canvas* $W] } {
                $path.canvas $view scroll [expr {-$D}] units
            }
            return
        }
    }

    # Generate some random content.
    for {set row 0} {$row < 100} {incr row} {
        for {set col 0} {$col < 100} {incr col} {
            append fuzz [string index {abcdefghijklmnopqrstuvwxyz0123456789} [expr {int(rand()*36)}]]
        }
        append fuzz \n
    }

    # Use the -toplevel option to create a scrollable toplevel window.
    sframe new .demo  -toplevel true  -anchor w

    # Retrieve the path where the scrollable contents go.
    set path [sframe content .demo]

    # Pack, grid, or place the contents of the scrollable frame.
    pack [ttk::label $path.randtext  -text $fuzz]

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References