tabnotebook.wgt

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

# $Id: tabnotebook.wgt,v 1.14 2002/10/10 06:36:33 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		Tabnotebook
Lib		itcl

CreateCmd	::iwidgets::tabnotebook
Icon		icon_tabnotebook.gif
DumpChildren	no
MegaWidget	yes
ClassOption     -_itcl_notebook_pages
InsertCmd	vTcl::widgets::iwidgets::tabnotebook::insertCmd
SelectSiteCmd   vTcl::widgets::iwidgets::tabnotebook::selectSiteCmd
DeleteSiteCmd   vTcl::widgets::iwidgets::tabnotebook::deleteSiteCmd
TagsCmd         vTcl:lib_itcl:tagscmd
TreeChildrenCmd	{vTcl::widgets::iwidgets::tabnotebook::treeChildrenCmd
		 vTcl::widgets::iwidgets::tabnotebook::treeChildrenChildsite}
DumpCmd		vTcl::widgets::iwidgets::tabnotebook::dumpCmd
DumpInfoCmd	vTcl::widgets::iwidgets::tabnotebook::dumpInfoCmd
ResizeCmd       vTcl::widgets::iwidgets::tabnotebook::resizeCmd

#############################
## Right-click menu

Function        "Edit Pages..."         vTcl::widgets::iwidgets::tabnotebook::editCmd

AdditionalClasses Notebook Tabset Page

#############################
## for compatibility with 1.5
##
proc vTcl:widget:tabnotebook:treeChildrenChildsite {target} {
    return [vTcl::widgets::iwidgets::tabnotebook::treeChildrenChildsite $target]
}

namespace eval vTcl::widgets::iwidgets::tabnotebook {

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

    proc resizeCmd {target w h} {
        # need to find out why tabnotebook doesn't resize properly in vTcl
        $target configure -width $w -height $h
    }

    proc insertCmd {target} {
        $target add -label {Page 1}
        $target add -label {Page 2}
        $target add -label {Page 3}
        $target select 0
	foreach site [$target childsite] {
	    vTcl::widgets::iwidgets::notebooks::edit::saveBkgnd $site
	}
    }

    # All right, I explain it: -4 is the number of levels
    # in the window path between the megawidget and its
    # pages (childsites). This is used by the widget tree
    # to skip 4 levels (otherwise it would draw 4 vertical
    # lines)

    proc treeChildrenCmd {target {diff \#-4}} {
        set children ""
        set wantsdiff [expr {$diff != ""}]

        foreach site [$target childsite] {
            foreach child [vTcl:complete_widget_tree $site $wantsdiff] {
                lappend children $child$diff
            }
        }

        return $children
    }

    proc treeChildrenChildsite {target} {
        return [$target childsite]
    }

    proc deleteSiteCmd {target site} {
        set index [lsearch -exact [$target childsite] $site]

        if {$index != -1} {
            $target delete $index
            $target select 0
        }
    }

    proc selectSiteCmd {target site} {
        set index [lsearch -exact [$target childsite] $site]

        if {$index != -1} {
            $target select $index
        }
    }

    proc dumpCmd {target basename} {
        global vTcl

        set result [vTcl:dump_widget_opt $target $basename]
        set entries [$target childsite]
        set size    [llength $entries]
        for {set i 0} {$i < $size} {incr i} {
            set conf [$target pageconfigure $i]
            set pairs [vTcl:get_subopts_special $conf $target]
            append result "$vTcl(tab)$basename add \\\n"
            append result "[vTcl:clean_pairs $pairs]\n"
        }
        for {set i 0} {$i < $size} {incr i} {
            set page [lindex $entries $i]
            append result "$vTcl(tab)"
            set sitevariable "site_[llength [split $page .]]_$i"
            append result "set $sitevariable "
            append result "\[lindex \[$basename childsite\] $i\]\n"
            append result [vTcl:lib_itcl:dump_subwidgets $page \$$sitevariable]
        }
        append result "$vTcl(tab)$basename select 0\n"
        return $result
    }

    proc dumpInfoCmd {target basename} {
        global vTcl classes

        set result [vTcl:dump:widget_info $target $basename]
        set entries [$target childsite]
        set size    [llength $entries]
        for {set i 0} {$i < $size} {incr i} {
            set page [lindex $entries $i]
            append result "$vTcl(tab)"
            set sitevariable "site_[llength [split $page .]]_$i"
            append result "set $sitevariable "
            append result "\[lindex \[$basename childsite\] $i\]\n"
            append result [$classes(Frame,dumpInfoCmd) $page \$$sitevariable]
        }
        append result "$vTcl(tab)$basename select 0\n"
        return $result
    }
}