Subversion Repositories or1k

# menu.tcl - Useful proc for dealing with menus.

# Copyright (C) 1997 Cygnus Solutions.

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

# This proc computes the "desired width" of a menu.  It can be used to

# determine the minimum width for a toplevel whose -menu option is

# set.

proc compute_menu_width {menu} {

  set width 0

  set last [$menu index end]

  if {$last != "end"} then {

    # Start at borderwidth, but also preserve borderwidth on the

    # right.

    incr width [expr {2 * [$menu cget -borderwidth]}]

    set deffont [$menu cget -font]

    set abw [expr {2 * [$menu cget -activeborderwidth]}]

    for {set i 0} {$i <= $last} {incr i} {

      if {[catch {$menu entrycget $i -font} font]} then {

        continue

      }

      if {$font == ""} then {

        set font $deffont

      }

      incr width [font measure $font [$menu entrycget $i -label]]

      incr width $abw

      # "10" was chosen by reading tkUnixMenu.c.

      incr width 10

      # This is arbitrary.  Apparently I can't read tkUnixMenu.c well

      # enough to understand why the naive calculation above doesn't

      # work.

      incr width 2

    }

    # Another hack.

    incr width 2

  }

  return $width

}