notebook.wgt

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

# $Id: notebook.wgt,v 1.16 2002/10/10 06:35:55 cgavin Exp $

##############################################################################
#
# Visual TCL - A cross-platform application development environment
#
# Copyright (C) 2001 Damon Courtney
#
# Description file for Bwidgets notebook
#
# 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		NoteBook
Lib		bwidget

Icon		icon_BwTabnotebook.gif
TreeLabel	BWidget Tabbed Notebook
CreateCmd	NoteBook
MegaWidget	yes
DefaultOptions	-width 300 -height 200
DefaultValues   -background -foreground -font
ClassOption     -_bwidgets_notebook_pages
InsertCmd       vTcl::widgets::bwidgets::notebook::insertCmd
DeleteCmd       vTcl::widgets::bwidgets::notebook::deleteCmd
TreeChildrenCmd	{vTcl::widgets::bwidgets::notebook::treeChildrenCmd
		 vTcl::widgets::bwidgets::notebook::treeChildrenChildsite}
SelectSiteCmd   vTcl::widgets::bwidgets::notebook::selectSiteCmd
DeleteSiteCmd   vTcl::widgets::bwidgets::notebook::deleteSiteCmd
DumpCmd         vTcl::widgets::bwidgets::notebook::dumpCmd
DumpInfoCmd     vTcl::widgets::bwidgets::notebook::dumpInfoCmd
GetImagesCmd    vTcl::widgets::bwidgets::notebook::getImagesCmd

## Tabbed notebook support
NewOption -_bwidgets_notebook_pages  "pages"  combobox
OptionConfigCmd -_bwidgets_notebook_pages     config     vTcl::widgets::bwidgets::config_pages
OptionConfigCmd -_bwidgets_notebook_pages     update     vTcl::widgets::bwidgets::update_pages
OptionConfigCmd -_bwidgets_notebook_pages     get        vTcl::widgets::bwidgets::get_pages
OptionConfigCmd -_bwidgets_notebook_pages     select     vTcl::widgets::bwidgets::select_page
OptionConfigCmd -_bwidgets_notebook_pages     edit       vTcl::itemEdit::edit
OptionConfigCmd -_bwidgets_notebook_pages     editArg    vTcl::widgets::bwidgets::notebook::edit

## Page-specific options
NewOption -createcmd		"create cmd"		command
NewOption -raisecmd		"raise cmd"		command
NewOption -leavecmd		"leave cmd"		command

## Right-click menu
Function        "Edit Pages..."  vTcl::widgets::bwidgets::notebook::editCmd

namespace eval ::vTcl::widgets::bwidgets::notebook::edit {

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

    proc getLabelOption {} {
        return -text
    }

    proc getItems {target} {
        ## first item in the list is the current index
        set pages [$target pages]
        set current [$target index [$target raise]]
        set values $current
        foreach page $pages {
            lappend values [$target itemcget $page -text]
        }
        return $values
    }

    proc addItem {target} {
        set pages [$target pages]
        set index 0
        ## repeat until we find an unused page number
        while {1} {
            incr index
            set newpage "page$index"
            if {[lsearch -exact $pages $newpage] == -1} break
        }
        $target insert end $newpage -text "New Page"
        $target raise $newpage
        vTcl:init_wtree
        return "New Page"
    }

    proc removeItem {target index} {
        set pages [$target pages]
        set page  [lindex $pages $index]
        $target delete $page
        vTcl:init_wtree
    }

    proc itemConfigure {target index args} {
        set pages [$target pages]
        set page [lindex $pages $index]
        if {$args == ""} {
            return [$target itemconfigure $page]
        } else {
            eval $target itemconfigure $page $args
        }
    }

    proc moveUpOrDown {target index direction} {
        set offset(up) -1
        set offset(down) 1
        set pages [$target pages]
        set length [llength $pages]
        set page [lindex $pages $index]
        $target move $page [expr ($index + $offset($direction)) % $length]
        vTcl:init_wtree
    }
}

namespace eval vTcl::widgets::bwidgets::notebook {

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

    proc deleteCmd {target} {
	bindtags $target "nothing"
        NoteBook::_destroy $target
	destroy $target
    }

    proc insertCmd {target} {
        $target insert end page1 -text {Page 1}
        $target insert end page2 -text {Page 2}
        $target insert end page3 -text {Page 3}
        $target raise page1
    }

    # All right, I explain it: 0 is the number of extra levels
    # in the window path between the megawidget and its
    # pages (childsites).

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

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

        return $children
    }

    proc treeChildrenChildsite {target} {
        set pages [$target pages]
        set sites ""
        foreach page $pages {
            lappend sites [$target getframe $page]
        }
        return $sites
    }

    proc selectSiteCmd {target site} {
        set pages [$target pages]
        foreach page $pages {
            if {[$target getframe $page] == $site} {
                $target raise $page
                break
            }
        }
    }

    proc deleteSiteCmd {target site} {
        set pages [$target pages]
        foreach page $pages {
            if {[$target getframe $page] == $site} {
                $target delete $page
                $target raise [$target pages 0]
                break
            }
        }
    }

    proc dumpCmd {target basename} {
        set result [vTcl:dump_widget_opt $target $basename]
        set pages [$target pages]
        foreach page $pages {
            set conf [$target itemconfigure $page]
            set pairs [vTcl:get_subopts_special $conf $target]
            append result "$::vTcl(tab)$basename insert end $page \\\n"
            append result "[vTcl:clean_pairs $pairs]\n"
        }
        set size  [llength $pages]
        for {set i 0} {$i < $size} {incr i} {
            set site [$target getframe [lindex $pages $i]]
            append result "$::vTcl(tab)"
            set sitevariable "site_[llength [split $site .]]_$i"
            append result "set $sitevariable "
            append result "\[$basename getframe [lindex $pages $i]\]\n"
            append result \
                [vTcl::widgets::bwidgets::dump_subwidgets $site \$$sitevariable]
        }
        append result "$::vTcl(tab)$basename raise [lindex $pages 0]\n"
        return $result
    }

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

    proc getImagesCmd {target} {
        set result {}
        set pages [$target pages]
        foreach page $pages {
            set image [$target itemcget $page -image]
            if {$image != ""} {
                lappend result $image
            }
        }
        return $result
    }
}