# menu.tcl -- Make TkDVI menu bars.
# Copyright © 1999 Anselm Lingnau.
# See file COPYING for conditions on use and distribution.
# $Id: menu.tcl,v 1.3 2000/07/05 08:47:36 lingnau Exp $
#
# This code borrows heavily from Brent Welch's book. Thanks Brent!

package provide tkdvi::menu 1.0

namespace eval tkdvi::menu {
    proc menubar {name {top {}}} {
	variable Menu
	set m [menu $name]
	foreach b [option get $m menulist {}] {
	    if [catch {menu $m.$b}] {
		menu $m.$b -font fixed
	    }
	    set label [option get $m.$b text {}]
	    set ul [string first & $label]
	    regsub {&} $label {} label
	    set cmd [list $m add cascade -label $label -menu $m.$b]
	    if [catch $cmd t] {
		eval $cmd {-font fixed}
	    }
	    if {$ul >= 0} {
		$m entryconfigure end -underline $ul
	    }
	    define $m.$b $top
	}
    }
    proc define {menu {top {}}} {
	variable Menu
	foreach e [option get $menu entrylist {}] {
	    if {$e == "-"} {
		$menu add separator
		continue
	    }
	    set onv 1
	    set offv 0
	    set l [option get $menu l_$e {}]
	    set ul [string first & $l]
	    regsub {&} $l {} l
	    set c [option get $menu c_$e {}]
	    set v [option get $menu v_$e {}]
	    set onv [option get $menu onv_$e {}]
	    set offv [option get $menu offv_$e {}]
	    set accel [option get $menu a_$e {}]
	    regsub -all {%T} $c $top c
	    regsub -all {%M} $c $menu c
	    regsub -all {%T} $v $top v
	    regsub -all {%M} $v $menu v
	    switch -- [option get $menu t_$e {}] {
		check {
		    $menu add checkbutton -label $l -variable $v
		    if {$c != {}} {
			$menu entryconfigure end -command $c
		    }
		    if {$onv != {}} {
			$menu entryconfigure end -onvalue $onv
		    }
		    if {$offv != {}} {
			$menu entryconfigure end -offvalue $offv
		    }
		}
		radio {
		    $menu add radiobutton -label $l -variable $v -value $e
		}
		cascade {
		    set sub [option get $menu m_$e {}]
		    set post [option get $menu p_$e {}]
		    if {$post != {}} {
			regsub -all {%T} $post $top post
			regsub -all {%S} $post $menu.$sub post
			set submenu [menu $menu.$sub -postcommand $post]
			$menu add cascade -label $l -menu $submenu
		    } elseif {[string length $sub] != 0} {
			set submenu [menu $menu.$sub]
			regsub -all {%S} $c $submenu c
			$menu add cascade -label $l -command $c -menu $submenu
			define $submenu $top
		    }
		}
		default {
		    $menu add command -label $l -command $c
		}
	    }
	    if {$ul >= 0} {
		$menu entryconfigure end -underline $ul
	    }
	    if {[string length $accel] > 0} {
		$menu entryconfigure end -accelerator $accel
	    }
	    set Menu($l) [list $menu [$menu index end]]
	}
    }
    proc finditem {title} {
	variable Menu
	set result {}
	foreach i [array names Menu $title] {
	    set result [concat $result $Menu($i)]
	}
	return $result
    }
}
