Version 25 of Virtual Scrolling

Updated 2016-10-24 17:48:45 by bll

Virtual Scrolling

Last Update: 2016-10-24

bll 2014-8-23 This is a virtual scrolling solution that does not use a frame wrapper or canvas wrapper. The scrolling frame and scrolling canvas wrapper solutions are all quite memory intensive, as many rows of widgets are generally created ahead of time. Destroying the rows that are no longer displayed is not a solution, as destroying and creating new widgets is very slow. My initial try with a scrolling frame solution failed with more than a couple of thousand rows (due to the large amount of memory needed for the widget display), and I had the need to handle more than 30000 rows.

The code uses two callbacks, one to configure a row with the widgets, and one to populate the data. Each displayed row's widgets are configured with the configuration callback, and each row is populated with the populate callback. When the region is scrolled, the populated data is changed, and the widgets are left in place.

For basic scrolling areas, the configure callback is only executed on initialization and when the window is resized.

The 'reconfigure' and 'reconfWidget' procedures are used for complex displays (e.g. mixed headings and widgets) as in the example ('test2.tcl'). The 'grid forget' command is used to avoid slowness associated with destroying and creating new widgets. This requires some extra widget management.

The code handles multiple scrolling regions in a single window.

Row 0 is left available for a heading line (which is not scrolled).

Scrolling by dragging (moveto) is sped up by using a short delay before redisplaying.

A new set of data can be displayed by simply calling the 'display' procedure again.

--

It even works with a million entries (just change the number in 'test2.tcl'), which are built up within two seconds. Really good performance! HolgerJ, 2015-12-27

scrolldata.tcl:

#!/usr/bin/tclsh
#
# Copyright 2015-2016 Brad Lanam Walnut Creek CA USA
# MIT License
#

package require Tk 8.6
package require platform

package provide scrolldata 2.0

::oo::class create scrolldata {
  constructor { win sb confcallback popcallback displaymax {rowmult 1} } {
    my variable sdvars
    my variable sdslaves
    my variable sdslheight

    set genplat [platform::generic]
    set sdvars(os.windows) false
    set sdvars(os.macosx) false
    if { [regexp -nocase {^win} $genplat] } {
      set sdvars(os.windows) true
    }
    if { $::tcl_platform(os) eq "Darwin" } {
      set sdvars(os.macosx) true
    }

    set sdvars(window) $win
    set sdvars(window.sb) $sb
    set sdvars(conf.callback) $confcallback
    set sdvars(pop.callback) $popcallback
    set sdvars(dispmax) $displaymax
    set sdvars(listoffset) 0
    set sdvars(resize.afterid) {}
    set sdvars(first) 1
    set sdvars(first.resize) 1
    set sdvars(indisplay) 0
    set sdvars(inresize) 0
    set sdvars(scroll.afterid) {}
    set sdvars(mapped) 0
    set sdvars(rowmult) $rowmult ; # how many rows of data per line
    set sdvars(sp.afterid) {}
    set sdvars(binds.done) false

    # This is the default.
    # Done here as it makes the construction
    # of the scrolldata object easier for the user.
    # This can of course be overridden by the user.
    $sdvars(window.sb) configure -command [list [self] scroll]

    bind $sdvars(window) <Map> +[list [self] sd_domap $sdvars(window)]
    bind $sdvars(window.sb) <Map> +[list [self] sd_domap $sdvars(window.sb)]
    # no telling where the focus is in relation to the pointer,
    # so must bind to all.
    bind all <Prior> +[list [self] pageHandler -1]
    bind all <Next> +[list [self] pageHandler 1]
    bind all <<PrevLine>> +[list [self] arrowHandler -1]
    bind all <<NextLine>> +[list [self] arrowHandler 1]
  }

  method setScrollbar { } {
    my variable sdvars

    if { $sdvars(max) > 0 } {
      set l [expr {double($sdvars(listoffset))/double($sdvars(max))}]
      set h [expr {double($sdvars(listoffset)+$sdvars(dispmax)) / \
          double($sdvars(max))}]
    } else {
      set l 0.0
      set h 1.0
    }
    $sdvars(window.sb) set $l $h
    $sdvars(window.sb) set $l $h
  }

  method sd_scroll { } {
    my variable sdvars

    if { ! [winfo exists $sdvars(window)] } {
      return
    }
    set sdvars(scroll.afterid) {}
    # generate the leave and enter events for whatever's under the mouse pointer
    lassign [winfo pointerxy $sdvars(window)] x y
    set tw [winfo containing $x $y]
    if { $tw ne $sdvars(window) && $tw ne $sdvars(window.sb) } {
      event generate $tw <Leave>
    }
    my display $sdvars(max) $sdvars(listoffset)
    if { $tw ne $sdvars(window) && $tw ne $sdvars(window.sb) } {
      event generate $tw <Enter>
    }
  }

  method scroll { args } {
    my variable sdvars

    if { [llength $args] == 0 } {
      return
    }
    if { ! [info exists sdvars(max)] } {
      return
    }

    lassign $args cmd val type
    set rm $sdvars(rowmult)
    if { $cmd eq "scroll" && $type eq "pages" } {
      set offset [expr {(($sdvars(listoffset)+($val*$sdvars(dispmax)))/$rm)*$rm}]
    }
    if { $cmd eq "scroll" && $type eq "units" } {
      set offset [expr {$sdvars(listoffset)+($val*$rm)}]
    }
    if { $cmd eq "moveto" } {
      set offset [expr {int(floor(double($sdvars(max))*double($val)))/$rm*$rm}]
    }
    if { $offset > [expr {$sdvars(max)-$sdvars(dispmax)}] } {
      set offset [expr {$sdvars(max)-$sdvars(dispmax)}]
    }
    if { $offset < 0 } {
      set offset 0
    }

    set sdvars(listoffset) $offset
    my setScrollbar
    if { $cmd eq "moveto" } {
      if { $sdvars(scroll.afterid) ne {} } {
        after cancel $sdvars(scroll.afterid)
      }
      set sdvars(scroll.afterid) [after 1 [list [self] sd_scroll]]
    } else {
      my sd_scroll
    }
  }

  method scrollUnit { dir } {
    my setScrollbar
    my scroll scroll $dir units
  }

  method chkScroll { didx } {
    my variable sdvars

    set rc 0
    if { ! [info exists sdvars(max)] } {
      return $rc
    }
    my setScrollbar
    if { $sdvars(max) == 0 } {
      return $rc
    }
    set didx [expr {$didx*$sdvars(rowmult)}]
    set max [expr {double($sdvars(max))}]
    set val [expr {double($didx)/$max}]
    set low [expr {double($sdvars(listoffset))/$max}]
    set high [expr {double(($sdvars(listoffset)+$sdvars(dispmax)-1))/$max}]
    if { $val < $low || $val > $high } {
      my scroll moveto $val
      set rc 1
    }
    return $rc
  }

  method getdispmax { } {
    my variable sdvars

    return $sdvars(dispmax)
  }

  method sd_domap { wvar } {
    my variable sdvars

    incr sdvars(mapped)
    ###
    # could bindtags be used?...don't want to destroy
    # any user level bindings.
    bind $wvar <Map> {}
  }

  method resize { {nw 0} {nh 0} } {
    my variable sdvars

    if { $sdvars(first) } {
      return
    }
    if { $sdvars(mapped) != 2 } {
      return
    }
    if { $sdvars(inresize) } {
      return
    }
    if { $sdvars(indisplay) } {
      return
    }
    if { $sdvars(resize.afterid) ne {} } {
      after cancel $sdvars(resize.afterid)
    }
    set sdvars(resize.afterid) \
        [after 50 [list [self] sd_resize]]
  }

  method sd_resize { } {
    my variable sdvars
    my variable sdslaves
    my variable sdslheight

    if { ! [winfo exists $sdvars(window)] } {
      return
    }
    if { ! [winfo exists $sdvars(window.sb)] } {
      return
    }
    if { $sdvars(inresize) } {
      return
    }
    set sdvars(inresize) 1

    set odm $sdvars(dispmax)
    set h1 [winfo reqheight $sdvars(window)]
    set h2 [winfo height $sdvars(window)]
    set h $h2
    if { $h1 > $h2 } {
      set h [expr {min($h1,$h2)}]
    }
    if { $h1 < $h2 } {
      set h [expr {max($h1,$h2)}]
    }

    set c 0
    lassign [grid bbox $sdvars(window) 0 0 4 0] x y hw hh
    set currh 0
    for { set r 1 } { $r <= $sdvars(dispmax) } { incr r } {
      if { $sdvars(first.resize) } {
        set rh 0
        foreach {sw} $sdslaves($r) {
          set rh [expr {max($rh,[my _getSlaveHeight $sw $r])}]
        }
        set sdslheight($r) $rh
      } else {
        set rh $sdslheight($r)
      }
      incr c
      incr currh $rh
      if { ($currh + $hh) > $h } {
        # this will handle the situation where the window size is smaller...
        incr c -1
        break
      }
    }
    set sdvars(first.resize) 0
    set r $c
    if { $c > 0 } {
      set er [expr {int(($h - $hh) / ($currh / $c))}]
      if { $er > $r && [expr {$currh+$hh+($currh/$c)}] <= $h } {
        set r $er
      }
    }

    set sdvars(dispmax) $r

    if { $r != $odm || $r == 0 } {
      if { ($sdvars(max)-$sdvars(dispmax)) < $sdvars(listoffset) } {
        set sdvars(listoffset) \
            [expr {$sdvars(max)-$sdvars(dispmax)}]
        if { $sdvars(listoffset) < 0 } {
          set sdvars(listoffset) 0
        }
      }
      my display $sdvars(max) $sdvars(listoffset)
    }
    set sdvars(resize.afterid) {}
    set sdvars(inresize) 0

  }

  method reconfigure { r dataidx } {
    my variable sdslaves

    grid forget {*}$sdslaves($r)
    my _confRow $r $dataidx
    return $sdslaves($r)
  }

  method reconfigureAll { dataidx } {
    my variable sdvars
    my variable sdslaves

    for { set r 1 } { $r <= $sdvars(dispmax) } { incr r } {
      if { ! [info exists sdslaves($r)] } {
        break
      }
      grid forget {*}$sdslaves($r)
      my _confRow $r $dataidx
      incr dataidx
    }
  }

  method sd_stopPropagation { } {
    my variable sdvars

    if { ! $sdvars(first) } {
      return
    }
    if { $sdvars(mapped) != 2 } {
      after cancel $sdvars(sp.afterid)
      set vars(sp.afterid) [after 50 \
          [list [self] sd_stopPropagation]]
      return
    }
    set sdvars(indisplay) 0
    if { $sdvars(first) && [winfo exists $sdvars(window)] } {
      grid propagate $sdvars(window) off
      set sdvars(first) 0
    }
    # this seems to work, after idle does not.
    after 100 [list [self] sd_resize]
  }

  method _resetBinding { s } {
    set bt [bindtags $s]
    set idx [lsearch -exact $bt all]
    set bt [lreplace $bt $idx $idx]
    set bt [linsert $bt 0 all]
    bindtags $s $bt
  }

  method _confRow { r dataidx } {
    my variable sdslaves
    my variable sdvars
    my variable sdslheight

    set sdslaves($r) [$sdvars(conf.callback) $sdvars(window) $r $dataidx]
    set rh 0
    foreach {s} $sdslaves($r) {
      if { [winfo class $s] eq "TCombobox" } {
        my _resetBinding $s
        set popdown [ttk::combobox::PopdownWindow $s]
        my _resetBinding $popdown
      }
      set rh [expr {max($rh,[my _getSlaveHeight $s $r])}]
    }
    set sdslheight($r) $rh
  }

  method _getSlaveHeight { s r } {
    my variable sdvars

    set rh [winfo reqheight $s]
    if { $rh == 1 } {
      # some sort of container...get an estimate
      foreach {sc} [winfo children $s] {
        set rh [expr {max($rh,[winfo reqheight $sc])}]
      }
      # the assumption here is that the second row will be the
      # same height as the first.
      set rh [expr {$rh*$sdvars(rowmult)}]
    }
    return $rh
  }

  method _chkOffset { dmax offset dispmax } {
    if { $dmax - $offset + 1 < $dispmax } {
      set offset [expr {$dmax - $dispmax}]
      if { $offset < 0 } {
        set offset 0
      }
    }
    return $offset
  }

  method display { dmax {offset {}} } {
    my variable sdvars
    my variable sdslaves
    my variable sdslheight

    if { ! [winfo exists $sdvars(window)] } {
      return
    }
    set sdvars(indisplay) 1

    if { $offset eq {} } {
      set offset $sdvars(listoffset)
    }

    # removal of an item should not shrink the screen...
    if { $offset > 0 &&
        [info exists sdvars(max)] &&
        $dmax + 1 == $sdvars(max) &&
        $offset + $sdvars(dispmax) == $sdvars(max) } {
      incr offset -1
    }
    set offset [my _chkOffset $dmax $offset $sdvars(dispmax)]

    set r 1
    set sdvars(max) $dmax

    set dataidx $offset
    set maxh [winfo height $sdvars(window)]
    lassign [grid bbox $sdvars(window) 0 0 4 0] x y hw hh
    set currh $hh
    # if maxh is not 1, the window has a size,
    #   use the actual height of the window.
    # if maxh is 1, the window hasn't been sized yet,
    #   use the number of rows requested.
    set rh 0
    while { $dataidx < $sdvars(max) } {
      # check height based on height of previous row, so we don't
      # configure and remove a row.
      if { $maxh != 1 && [expr {$currh+$rh}] > $maxh } {
        break
      }
      if { ! [info exists sdslaves($r)] } {
        my _confRow $r $dataidx
      }
      set rh $sdslheight($r)
      incr currh $rh
      $sdvars(pop.callback) $sdvars(window) $r $dataidx $sdslaves($r)

      if { $maxh == 1 && $r >= $sdvars(dispmax) } {
        break
      }

      incr r 1
      incr dataidx
    }

    if { $maxh != 1 || $dataidx >= $sdvars(max) } {
      incr r -1
    }
    set r [expr {$r/$sdvars(rowmult)*$sdvars(rowmult)}]
    set sdvars(dispmax) $r
    set offset [my _chkOffset $dmax $offset $sdvars(dispmax)]
    set sdvars(listoffset) $offset

    # remove the grid items larger than the display
    set r [expr {$sdvars(dispmax)+1}]
    while { [info exists sdslaves($r)] } {
      # don't use remove here, as windows does really weird resizing thingies.
      grid forget {*}$sdslaves($r)
      unset sdslaves($r)
      unset sdslheight($r)
      incr r
    }

    my setScrollbar
    # after the first display, don't propagate changes any more
    # need time for window to display, otherwise resize will mangle it
    # this also turns off the indisplay flag
    if { $sdvars(first) } {
      after cancel $sdvars(sp.afterid)
      set sdvars(sp.afterid) [after idle \
          [list [self] sd_stopPropagation]]
    } else {
      set sdvars(indisplay) 0
    }
  }

  method curroffset { } {
    my variable sdvars

    return $sdvars(listoffset)
  }

  method reconfWidget { slv s cmd } {
    upvar $slv sl

    if { [winfo exists $s] } {
      lappend sl $s
    } else {
      lappend sl [{*}$cmd]
    }
  }

  method windowCheck { wz } {
    my variable sdvars

    if { $wz ne $sdvars(window) &&
        [winfo parent $wz] ne $sdvars(window) &&
        [winfo parent [winfo parent $wz]] ne $sdvars(window) } {
      return true
    }
    return false
  }

  method pageHandler { d } {
    variable sdvars

    if { ! [winfo exists $sdvars(window)] } {
      return -code ok
    }
    lassign [winfo pointerxy $sdvars(window)] x y
    set wz [winfo containing $x $y]
    if { [winfo class $wz] eq "TCombobox" } {
      return -code ok
    }
    if { [my windowCheck $wz] } {
      return -code ok
    }
    my scroll scroll $d pages
    return -code break
  }

  method arrowHandler { d } {
    variable sdvars

    if { ! [winfo exists $sdvars(window)] } {
      return -code ok
    }
    lassign [winfo pointerxy $sdvars(window)] x y
    set wz [winfo containing $x $y]
    if { ! [winfo exists $wz] } {
      return -code ok
    }
    if { [winfo class $wz] eq "TCombobox" } {
      return -code ok
    }
    if { [my windowCheck $wz] } {
      return -code ok
    }
    my scroll scroll $d units
    return -code break
  }

  method wheelHandler { wz d } {
    my variable sdvars

    if { [winfo class $wz] eq "TCombobox" } {
      return
    }
    if { [my windowCheck $wz] } {
      return
    }
    if { $sdvars(os.windows) } {
      set d [expr {int(-$d / 120)}]
    }
    if { $sdvars(os.macosx) } {
      set d [expr {int(-$d)}]
    }
    my scroll scroll $d units
    return
  }

  # not automatically bound as some scrolling areas have specific areas
  # where the wheel use is allowed.
  method bindWheel { p } {
    my variable sdvars

    bind all <MouseWheel> +[list {*}$p %W %D]
    if { ! $sdvars(os.windows) } {
      bind all <Button-4> +[list {*}$p %W -1]
      bind all <Button-5> +[list {*}$p %W 1]
    }
  }
}

testsd3.tcl

#!/usr/bin/tclsh
#
# This code is in the public domain.
# Originally written by Brad Lanam 2014-08-23

package require Tk 8.5

set ap [file join [file dirname [info script]] ../code]
if { $ap ni $::auto_path } {
  lappend ::auto_path $ap
}
unset ap

source scrolldata.tcl

variable vars

proc configureLine { w r didx } {
  variable vars

  # Quick and dirty method to differentiate heading from data.
  # I wouldn't recommend this for real.
  if { [regexp {^\d+$} $vars($didx)] } {
    $vars(sd$w) reconfWidget sl $w.l$r \
        [list ttk::label $w.l$r -width 5]
    $vars(sd$w) reconfWidget sl $w.e$r \
        [list ttk::entry $w.e$r -width 10]
    grid {*}$sl -in $w -row $r -padx 5 -sticky w
  } else {
    $vars(sd$w) reconfWidget sl $w.h$r \
        [list ttk::label $w.h$r]
    grid {*}$sl -in $w -row $r -padx 5 -sticky w -columnspan 2
  }
  return $sl
}

proc populateLine { w r didx winlist } {
  variable vars

  lassign $winlist lab ent
  set c [llength $winlist]
  if { [regexp {^\d+$} $vars($didx)] } {
    if { $c == 1 } {
      set winlist [$vars(sd$w) reconfigure $r $didx]
      lassign $winlist lab ent
    }
    $lab configure -text $vars($didx)
    $ent configure -textvariable vars($didx)
  } else {
    if { $c == 2 } {
      set winlist [$vars(sd$w) reconfigure $r $didx]
      lassign $winlist lab
    }
    $lab configure -text $vars($didx)
  }
}

set maxdisp 20
set max 100

set col 0
foreach {f} [list .l .r] {
  ttk::frame $f
  set lab [string trim $f .]
  set sbnm .sb$lab
  ttk::scrollbar $sbnm -style Vertical.TScrollbar -orient vertical
  grid $sbnm -in . -sticky ns -row 0 -column [expr {$col*2+1}]

  ttk::label .h1$lab -text Label
  ttk::label .h2$lab -text Entry
  grid .h1$lab .h2$lab -in $f -row 0

  # do this last so it shrinks first
  grid $f -in . -row 0 -column [expr {$col*2}] -sticky news
  grid columnconfigure . [expr {$col*2}] -weight 1
  grid rowconfigure . 0 -weight 1

  set c 0
  for { set i 0 } { $i < $max } { incr i } {
    if { [expr {$i%10}] == 0 } {
      set vars($c) "[expr {int($i/10)*10}] group"
      incr c
    }
    set vars($c) $i
    incr c
  }
  set max $c

  set vars(sd$f) [scrolldata new $f $sbnm configureLine populateLine $maxdisp]
  $vars(sd$f) display $max
  bind $f <Configure> [list $vars(sd$f) resize %w %h]
  $vars(sd$f) bindWheel [list $vars(sd$f) wheelHandler]

  incr col
}

testrowmultiplier.tcl

#!/usr/bin/tclsh
#
# This code is in the public domain.
# Originally written by Brad Lanam 2015-08-19

package require Tk 8.5

set ap [file join [file dirname [info script]] ../code]
if { $ap ni $::auto_path } {
  lappend ::auto_path $ap
}
unset ap

source scrolldata.tcl

variable vars

proc configureLine { w r didx } {
  variable vars

  if { $r % 2 == 1 } {
    $vars(sd) reconfWidget sl $w.l$r \
        [list ttk::label $w.l$r -width 5]
    grid {*}$sl -in $w -row $r -padx 5 -sticky w -column 0
  } else {
    $vars(sd) reconfWidget sl $w.e$r \
        [list ttk::entry $w.e$r -width 10]
    grid {*}$sl -in $w -row $r -padx 5 -sticky w -column 1
  }
  return $sl
}

proc populateLine { w r didx winlist } {
  variable vars

  lassign $winlist s
  set idx [expr {$didx/2}]
  if { $r % 2 == 1 } {
    $s configure -text $vars($idx)
  } else {
    $s configure -textvariable vars($idx)
  }
}

set maxdisp 20
set max 98

ttk::frame .f
ttk::scrollbar .sb -style Vertical.TScrollbar -orient vertical
grid .sb -in . -sticky ns -column 1 -row 0
set vars(sd) [scrolldata new .f .sb configureLine populateLine $maxdisp 2]

ttk::label .h1 -text Label
ttk::label .h2 -text Entry
grid .h1 .h2 -in .f -row 0

# do this last so it shrinks first
grid .f -in . -row 0 -sticky news
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1

for { set i 0 } { $i < $max } { incr i } {
  set vars($i) $i
}
$vars(sd) display [expr {$max*2}]
bind .f <Configure> [list $vars(sd) resize %w %h]
$vars(sd) bindWheel [list $vars(sd) wheelHandler]

bll 2016-10-24 Various bugfixes. Removed autoscroll. Rewrote to be an object.

bll 2016-5-1 Fix resize. Added autoscroll capability.

bll 2016-3-3 Generate Leave and Enter events for whatever widget is under the mouse pointer.

bll 2016-2-26 Use max of height,reqheight on resize.

bll 2016-2-21 Use reqheight on a resize.

bll 2016-2-16 Simplified and fixed chkScroll.

bll 2016-1-18 Fixed a problem with propagation being turned off too early.

bll 2015-10-19 Added a check for window existence.

bll 2015-10-13 Fixes for arrow key handling in conjunction with comboboxes.

bll 2015-08-19 Update with fixes for row multiplier and test script for row multiplier. Additional helper routines.

bll 2014-11-24 Fixes for strange windows behaviours and bug fixes in height/row comparisons.

bll 2014-11-21 Rewrite. It now works with windows that are already sized and as the original: do X number of rows for the initial display. Resizing works properly. It is more stable now, but a little bit slower.

bll 2014-11-20 Updated with changes that disallow the resize function until the first display has finished. Added mouse wheel binding routines. Adjusted test routines to make sure windows were children of the scrolling frame.

bll 2014-10-4 removed update, added mapped window checks, don't scroll if maximum is not set up yet.

See also: scrollbar and Scrolling widgets without a text or canvas wrapper.