Subversion Repositories or1k

# canvas.tcl - Handy canvas-related commands.

# Copyright (C) 1997 Cygnus Solutions.

# Written by Tom Tromey <tromey@cygnus.com>.

# Set scroll region on canvas.

proc set_scroll_region {canvas} {

  set bbox [$canvas bbox all]

  if {[llength $bbox]} then {

    set sr [lreplace $bbox 0 1 0 0]

  } else {

    set sr {0 0 0 0}

  }

  # Don't include borders in the scrollregion.

  set delta [expr {2 * ([$canvas cget -borderwidth]

                        + [$canvas cget -highlightthickness])}]

  set ww [winfo width $canvas]

  if {[lindex $sr 2] < $ww} then {

    set sr [lreplace $sr 2 2 [expr {$ww - $delta}]]

  }

  set wh [winfo height $canvas]

  if {[lindex $sr 3] < $wh} then {

    set sr [lreplace $sr 3 3 [expr {$wh - $delta}]]

  }

  $canvas configure -scrollregion $sr

}