panedwindow.wgt

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

# $Id: panedwindow.wgt,v 1.14 2005/12/05 07:00:26 kenparkerjr 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.

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

if {[info tclversion] < 8.4} {

Class		Panedwindow
Lib		itcl

CreateCmd	::iwidgets::panedwindow
Icon            @vTcl::widgets::iwidgets::panedwindow::getIcon
DumpChildren	no
MegaWidget	yes
TreeChildrenCmd	{
		vTcl::widgets::iwidgets::panedwindow::treeChildrenCmd
		vTcl::widgets::iwidgets::panedwindow::treeChildrenChildsite
		}
DumpCmd		vTcl::widgets::iwidgets::panedwindow::dumpCmd
DumpInfoCmd	vTcl::widgets::iwidgets::panedwindow::dumpInfoCmd
InsertCmd	vTcl::widgets::iwidgets::panedwindow::insertCmd
DeleteSiteCmd   vTcl::widgets::iwidgets::panedwindow::deleteSiteCmd
TagsCmd         vTcl::widgets::iwidgets::panedwindow::tagsCmd

AdditionalClasses Pane

## Pane specific options
NewOption -minimum		"min size"		type

## Right-click menu
Function        "Edit Panes..."         vTcl::widgets::iwidgets::panedwindow::editCmd

###########################################################
## Special proc for setting up icons on the toolbar.
##
proc vTcl:Panedwindow:ToolBarSetup {} {

    vTcl:toolbar_add itcl Panedwindow \
	"vertical paned window" \
	icon_panedwindow.gif "-orient horizontal"

    vTcl:toolbar_add itcl Panedwindow \
    	"horizontal paned window" \
	../lib/Widgets/itcl/panedwindowhoriz.gif "-orient vertical"
}

namespace eval vTcl::widgets::iwidgets::panedwindow {

    proc getIcon {{w ""}} {
        if {[lempty $w]} {
            return [list icon_panedwindow.gif ../lib/Widgets/itcl/panedwindowhoriz.gif]
        }
        switch [$w cget -orient] {
            vertical {
                return ../lib/Widgets/itcl/panedwindowhoriz.gif
            }
            horizontal {
                return icon_panedwindow.gif
            }
        }
    }
}

##########################################################
## Pane editing support
NewOption       -_itcl_panedwindow_panes  "panes" combobox
ClassOption     -_itcl_panedwindow_panes
OptionConfigCmd -_itcl_panedwindow_panes    config     vTcl::widgets::iwidgets::panedwindow::configPanes
OptionConfigCmd -_itcl_panedwindow_panes    update     vTcl::widgets::iwidgets::panedwindow::updatePanes
OptionConfigCmd -_itcl_panedwindow_panes    get        vTcl::widgets::iwidgets::panedwindow::getPanes
OptionConfigCmd -_itcl_panedwindow_panes    select     vTcl::widgets::iwidgets::panedwindow::selectPane
OptionConfigCmd -_itcl_panedwindow_panes    edit       vTcl::itemEdit::edit
OptionConfigCmd -_itcl_panedwindow_panes    editArg    vTcl::widgets::iwidgets::panedwindow::edit

###########################################################
## Code for inserting, dumping the widget,
## showing panes in attributes editor
##
namespace eval vTcl::widgets::iwidgets::panedwindow {

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

    proc insertCmd {target} {
        $target add pane1
        $target add pane2
    }

    proc tagsCmd {target} {

        global vTcl

        # workaround for special binding tags in IWidgets
        set tags $vTcl(bindtags,$target)
        set special1 [lsearch -glob $tags pw-config-*]
        set special2 [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]
        }

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

    # All right, I explain it: -1 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 \#-1}} {

        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
        }
    }

    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 paneconfigure $i]
            set pairs [vTcl:get_subopts_special $conf $target]
            append result "$vTcl(tab)$basename add pane$i\n"
            append result "$vTcl(tab)$basename paneconfigure pane$i \\\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]
        }
        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]
        }
        return $result
    }

    proc getPanes {target} {
    }

    proc updatePanes {target var} {
        global vTcl

        ## there is a trace on var to update the combobox
        ## first item in the list is the current index
        set sites [$target childsite]
        set num_pages [llength $sites]
        set values 0
        for {set i 1} {$i <= $num_pages} {incr i} {
            lappend values "Pane $i"
        }

        ## this will trigger the trace
        set ::$var $values
    }

    proc configPanes {target var} {
    }

    proc selectPane {target index} {
    }
}

###########################################################
## Code for editing pages in paned window widgets
##
namespace eval vTcl::widgets::iwidgets::panedwindow::edit {

    proc getTitle {target} {
        return "Edit panes for $target"
    }

    proc getLabelOption {} {
        return -label
    }

    proc getItems {target} {
        ## first item in the list is the current index
        set sites [$target childsite]
        set current 0
        set values $current
        for {set i 1} {$i <= [llength $sites]} {incr i} {
            lappend values "Pane $i"
        }
        return $values
    }

    proc addItem {target} {
        set index 1
	set components [$target component]
	while {[lsearch -exact $components pane$index] != -1} {
	    incr index
	}
        $target add pane$index
	update
        after idle {vTcl:init_wtree}
        return "Pane $index"
    }

    proc removeItem {target index} {
        $target delete $index
        vTcl:init_wtree
    }

    proc itemConfigure {target index args} {
        if {$args == ""} {
            set options [$target paneconfigure $index]
            set result ""
            ## grrr: why do they return options from the widget here with
            ##       three items like {-width 15 10} ?? bug!!
            foreach option $options {
                ## only return valid options
                if {[llength $option] == 5} {
                    lappend result $option
                }
            }
            return $result
        } else {
            eval $target paneconfigure $index $args
        }
    }

    proc moveUpOrDown {target index direction} {
        error "Not implemented yet!"
    }
}

}; ## if {[info tclversion] < 8.4}