# $Id: menubutton.wgt,v 1.12 2003/07/28 05:06:08 cgavin Exp $

##############################################################################
#
# Visual TCL - A cross-platform application development environment
#
# Copyright (C) 2001 Damon Courtney
#
# Description file for Tk Widget
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##############################################################################

# Rozen Not too surprising, I started from ../menubutton.wgt
# Rationalized with tile,

Class       TMenubutton
Lib     ttk

CreateCmd   ttk::menubutton
TtkWidget       yes

Icon        icon_menubutton.gif
DefaultOptions  -text TMenubutton

ClassOption     -_tooltip

DoubleClickCmd  vTcl:edit_target_menu
InsertCmd   vTcl::widgets::ttk::menubutton::insertCmd
DumpCmd         vTcl::widgets::ttk::menubutton::dumpCmd
DumpInfoCmd     vTcl::widgets::ttk::menubutton::dumpInfoCmd
TreeLabel   @vTcl::widgets::ttk::menubutton::getWidgetTreeLabel

Function    "Edit Menu..."     vTcl::widgets::ttk::menubutton::editMenu
Function    "Set Tooltip"   vTcl::widgets::ttk::menubutton::setTooltip
Function    "Remove Image"  vTcl::widgets::core::menubutton::remove_image

namespace eval vTcl::widgets::ttk::menubutton {

    proc setTooltip {} {
        global vTcl
        vTcl:set_tooltip $vTcl(w,widget)
    }

    proc editMenu {} {
        global vTcl
        set vTcl(w,opt,-menu) [$vTcl(w,widget) cget -menu]
        vTcl:edit_target_menu $vTcl(w,widget)
        vTcl:prop:save_opt $vTcl(w,widget) -menu vTcl(w,opt,-menu)
    }

    proc remove_image {} {
        global vTcl
        vTcl:remove_image $vTcl(w,widget)
    }
	
    proc insertCmd {target} {
		# Creates a menu and links it to the menubutton.
        global vTcl
        menu $target.m -tearoff 0 -font $vTcl(pr,gui_font_menu)
        $target conf -menu $target.m
        vTcl:widget:register_widget $target.m
        foreach def {-activebackground -activeforeground
                     -background -foreground} {
            vTcl:prop:default_opt $target.m $def vTcl(w,opt,$def)
        }
        $target configure -takefocus ""
    }

    proc getWidgetTreeLabel {target} {
        append ret "TMenu - " [$target cget -text]
        return $ret
    }

    proc dumpCmd {target basename} {
        global vTcl basenames classes
        # create an indirect basename
		if {!$vTcl(copy)} {	;# Normal path
			incr vTcl(mb_count)
			set result [vTcl:dump_widget_opt $target $basename]
			set child [$target cget -menu]
			if {$child == ""} {
				## the menubutton is empty, don't bother
				return $result
			}
			if {![winfo exists $child]} {
				## menu assigned to menu button doesn't exist...
				return $result
			}
			set class [vTcl:get_class $child]	
			append result [$classes($class,dumpCmd) $child \
							   [vTcl:base_name $child]]
			set geometry [vTcl:dump_widget_geom $child $basename] 
			incr vTcl(num,index)
		}
	# Skipping copy of menubutton. Other spot in menubutton.wgt and
	# tmenubutton.wgt in dumpCmd. See  vTcl:dump_widget_geom.
		
		if {$vTcl(copy)} {

			::vTcl::MessageBox -title "Error copying " \
				  -message \
          "Copy-and-paste of menubuttons not supported. Widget skipped." \
                  -icon warning \
                  -type ok
			return
			
			set vTcl(last_widget_name) [vTcl:new_widget_name  mbm ""]
			set result [vTcl:dump_widget_opt $target $basename]
			set child [$target cget -menu]
			if {$child == ""} {
				## the menubutton is empty, don't bother
				return $result
			}
			if {![winfo exists $child]} {
				## menu assigned to menu button doesn't exist...
				return $result
			}
			set class [vTcl:get_class $child]
			set base_name \${base}$vTcl(last_widget_name)
			# Command below is vTcl::widgets::core::menu::dumpCmd.
			append result [$classes($class,dumpCmd) $child $base_name]
			set geometry ""
		}  ;# End of copy
	return $result
}


    proc dumpInfoCmd {target basename} {
        global vTcl classes
        set result [vTcl:dump:widget_info $target $basename]

        set child [$target cget -menu]
        if {$child == ""} {
            ## the menubutton is empty, don't bother
            return $result
    }

        if {![winfo exists $child]} {
            ## menu assigned to menu button doesn't exist...
            return $result
        }

        set class [vTcl:get_class $child]
        append result [$classes($class,dumpInfoCmd) $child \
                           [vTcl:base_name $child]]
        return $result
    }
}
