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