libgui/library/canvas.tcl

   1 # canvas.tcl - Handy canvas-related commands.
   2 # Copyright (C) 1997 Cygnus Solutions.
   3 # Written by Tom Tromey <tromey@cygnus.com>.
   4
   5 # Set scroll region on canvas.
   6 proc set_scroll_region {canvas} {
   7   set bbox [$canvas bbox all]
   8   if {[llength $bbox]} then {
   9     set sr [lreplace $bbox 0 1 0 0]
  10   } else {
  11     set sr {0 0 0 0}
  12   }
  13
  14   # Don't include borders in the scrollregion.
  15   set delta [expr {2 * ([$canvas cget -borderwidth]
  16                         + [$canvas cget -highlightthickness])}]
  17
  18   set ww [winfo width $canvas]
  19   if {[lindex $sr 2] < $ww} then {
  20     set sr [lreplace $sr 2 2 [expr {$ww - $delta}]]
  21   }
  22
  23   set wh [winfo height $canvas]
  24   if {[lindex $sr 3] < $wh} then {
  25     set sr [lreplace $sr 3 3 [expr {$wh - $delta}]]
  26   }
  27
  28   $canvas configure -scrollregion $sr
  29 }