buttonbox.wgt

一个跨平台的TCL/TK可视开发环境类似VC. TCL/TK是一个跨平台的脚本语言.

# $Id: buttonbox.wgt,v 1.10 2002/10/10 06:36:31 cgavin Exp $

##############################################################################
#
# Visual TCL - A cross-platform application development environment
#
# Copyright (C) 2001 Christian Gavin
#
# Description file for [Incr Widgets]
#
# 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.

##############################################################################
#

Class		Buttonbox
Lib		itcl

CreateCmd	::iwidgets::buttonbox
Icon		icon_buttonbox.gif
DumpChildren	no
MegaWidget	yes
InsertCmd	vTcl::widgets::iwidgets::buttonbox::insertCmd
TagsCmd         vTcl::widgets::iwidgets::buttonbox::tagsCmd
DumpCmd		vTcl::widgets::iwidgets::buttonbox::dumpCmd
DefaultOptions	-padx 0 -pady 0
ClassOption     -_itcl_radiocheckboxes
GetImagesCmd    vTcl::widgets::iwidgets::boxes::getImagesCmd
GetFontsCmd     vTcl::widgets::iwidgets::boxes::getFontsCmd

Function    "Edit..."   vTcl::widgets::iwidgets::buttonbox::editCmd

AdditionalClasses Pushbutton

namespace eval vTcl::widgets::iwidgets::buttonbox {

    proc editCmd {} {
        vTcl::itemEdit::edit $::vTcl(w,widget) vTcl::widgets::iwidgets::boxes::edit
    }

    proc dumpCmd {target basename} {
        global vTcl
        set result [vTcl:dump_widget_opt $target $basename]
        set last -1
        catch {set last [$target index end]}

        for {set i 0} {$i <= $last} {incr i} {
            set conf [$target buttonconfigure $i]
            set pairs [vTcl:get_subopts_special $conf $target]

            append result "$vTcl(tab)$basename add but$i \\\n"
            append result "[vTcl:clean_pairs $pairs]\n"
        }

        return $result
    }

    proc insertCmd {target} {
        $target add ok     -text OK
        $target add cancel -text Cancel
        $target add help   -text Help

        vTcl::widgets::iwidgets::boxes::setDefaultValues $target \
            {-activebackground -activeforeground
            -background -disabledforeground
            -font -foreground -highlightbackground
            -highlightcolor -highlightthickness}
    }

    proc tagsCmd {target} {
        global vTcl

        # workaround for special binding tags in IWidgets
        set tags $vTcl(bindtags,$target)
        set special1 [lsearch -glob $tags bbox-config]
        set special2 [lsearch -glob $tags bbox-map]
        set special3 [lsearch -glob $tags itk-delete-*]

        set class [winfo class $target]
        set toplevel [winfo toplevel $target]
        set result ""

        if {$special1 != -1} {
            lappend result [lindex $tags $special1]
        }
        if {$special2 != -1} {
            lappend result [lindex $tags $special2]
        }
        if {$special3 != -1} {
            lappend result [lindex $tags $special3]
        }

        lappend result $target $class $toplevel all
        return $result
    }
}