OpenCores
URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [libgui/] [library/] [menu.tcl] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# menu.tcl - Useful proc for dealing with menus.
2
# Copyright (C) 1997 Cygnus Solutions.
3
# Written by Tom Tromey <tromey@cygnus.com>.
4
 
5
# This proc computes the "desired width" of a menu.  It can be used to
6
# determine the minimum width for a toplevel whose -menu option is
7
# set.
8
proc compute_menu_width {menu} {
9
  set width 0
10
  set last [$menu index end]
11
  if {$last != "end"} then {
12
    # Start at borderwidth, but also preserve borderwidth on the
13
    # right.
14
    incr width [expr {2 * [$menu cget -borderwidth]}]
15
 
16
    set deffont [$menu cget -font]
17
    set abw [expr {2 * [$menu cget -activeborderwidth]}]
18
    for {set i 0} {$i <= $last} {incr i} {
19
      if {[catch {$menu entrycget $i -font} font]} then {
20
        continue
21
      }
22
      if {$font == ""} then {
23
        set font $deffont
24
      }
25
      incr width [font measure $font [$menu entrycget $i -label]]
26
      incr width $abw
27
      # "10" was chosen by reading tkUnixMenu.c.
28
      incr width 10
29
      # This is arbitrary.  Apparently I can't read tkUnixMenu.c well
30
      # enough to understand why the naive calculation above doesn't
31
      # work.
32
      incr width 2
33
    }
34
    # Another hack.
35
    incr width 2
36
  }
37
 
38
  return $width
39
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.