treebook widget

# treebook - Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
#	widget for creating 'preference dialogs' - a tabbed dialog where
#	the page selection is done using a treeview on the left of the page
#	area.
#

package require Tk 8.6 ;# just for png support atm, otherwise 8.5

namespace eval ttk::treebook {
    
    ttk::style theme settings default {
        ttk::style layout Treebook.TNotebook.Tab null
        
        ttk::style layout Treebook.Treeview {
            Treebook.Treeview.fill -sticky nswe -children {
                Treebook.Treeview.padding -sticky nswe
            }
        }
        ttk::style layout TNotebook {
            Notebook.padding -sticky news
        }
        ttk::style layout Treebook.Treeview.Item {
            Treebook.Treeitem.padding -sticky nswe -children {
                Treeitem.focus -side left -sticky {} -children {
                    Treeitem.image -side left -sticky news
                    Treeitem.text -side left -sticky {}
                }
            }
        }
    }
    foreach theme [ttk::style theme names] {
        ttk::style theme settings $theme {
            ttk::style configure Treebook.Treeview \
                -background [ttk::style configure . -background]
        }
    }
}

proc ttk::treebook {w args} {
    set w [ttk::treebook::Create $w]
    interp hide {} $w
    interp alias {} $w {} ::ttk::treebook::WidgetProc $w
    return $w
}

proc ttk::treebook::WidgetProc {self cmd args} {
    switch -- $cmd {
        cget {
            return [uplevel 1 [list [namespace origin Cget] $self] $args]
        }
        configure {
            return [uplevel 1 [list [namespace origin Configure] $self] $args]
        }
        add {
            return [uplevel 1 [list [namespace origin Add] $self] $args]
        }
        default {
            return [uplevel 1 [list [namespace origin Default] $self] $cmd $args]
        }
    }
    return
}

proc ttk::treebook::Default {self args} {
    if {[llength $args] == 0} {
        return $self
    }
    return [uplevel 1 [list $self.pw.notebook] $args]
}

proc ttk::treebook::Cget {self args} {
    if {[llength $args] != 2} {
        return -code error "wrong # args: should be \"$self cget item option\""
    }
    foreach {item option} $args break
    switch -exact -- $option {
        -parent {
            return [uplevel 1 [list $self.pw.tree parent $item]]
        } 
        -image - -text {
            return [uplevel 1 [list $self.pw.tree item $item $option]]
        }
        default {
            return -code error "unknown option \"$option\""
        }
    }
}

proc ttk::treebook::Create {self} {

    set self [ttk::frame $self -class Treebook]
    set outer [ttk::panedwindow $self.pw -orient horizontal]
    set tree [ttk::treeview $outer.tree -show {tree} -style Treebook.Treeview]
    set notebook [ttk::notebook $outer.notebook -style Treebook.TNotebook]
    
    $outer add $tree -weight 0
    $outer add $notebook -weight 1
    $outer sashpos 0 [expr {[winfo width $outer] / 4}]
    bind $tree <<TreeviewSelect>> [list [namespace origin Select] $self]
    bind $notebook <<NotebookTabChanged>> [list [namespace origin OnSelect] $self]
    bind $self.pw <Map> [list [namespace origin OnMap] $self]
    
    grid $outer -sticky news
    grid rowconfigure $self 0 -weight 1
    grid columnconfigure $self 0 -weight 1

    return $self
}

# add -text tablabel -image imagename -parent treeparent
proc ttk::treebook::Add {self window args} {
    set notebookargs {}
    set treeargs {}
    set label $window
    set parent {}
    foreach {key val} $args {
        switch -exact -- $key {
            -parent { set parent $val }
            -image { lappend treeargs -image $val}
            default {
                lappend notebookargs $key $val
            }
        }
    }
    set r [uplevel 1 [list $self.pw.notebook add $window] $notebookargs]
    set label [$self.pw.notebook tab $window -text]
    uplevel 1 [list $self.pw.tree insert $parent end \
                   -id $window -open true -text $label] $treeargs
    return $r
}

proc ttk::treebook::OnMap {self} {
    $self.pw sashpos 0 [expr {[winfo width $self.pw] / 4}]
    bind $self.pw <Map> {}
}

proc ttk::treebook::OnSelect {self} {
    event generate $self <<TreebookChanged>>
}

proc ttk::treebook::Select {self} {
    $self.pw.notebook select [$self.pw.tree selection]
}

proc Test {} {
    global p
    bind . <Control-F2> {console show}
    catch {
        image create photo tkchat -file /opt/tkchat/tkchat.vfs/bin/tkchat48.png
    }
    set p [ttk::treebook .p]
    ttk::labelframe .page0 -text "Stuff"
    ttk::labelframe .page1 -text "More stuff"
    ttk::labelframe .page2 -text "Extra stuff"
    ttk::frame .page3

    ttk::combobox .page0.theme -values [lsort [ttk::style theme names]] -state readonly
    ttk::button .page0.apply -text Apply \
        -command {ttk::style theme use [.page0.theme get]}
    grid .page0.theme .page0.apply -sticky ew

    text .page3.text -yscrollcommand {.page3.vs set} -height 6 -width 36
    ttk::scrollbar .page3.vs -command {.page3.text yview}
    grid .page3.text .page3.vs -sticky news
    grid columnconfigure .page3 0 -weight 1
    grid rowconfigure .page3 0 -weight 1

    $p add .page0 -text One -image [lindex [image names] 0] -padding 2
    $p add .page1 -text Two
    $p add .page2 -text Three
    $p add .page3 -text Subpage -parent .page0 -padding 2
    pack $p -fill both -expand 1

    bind $p <<TreebookChanged>> {.page3.text insert end "switched page\n" {}}
    return $p
}
if {!$tcl_interactive} {
    if {![winfo exists .p]} {
        set r [catch [linsert $argv 0 Test] err]
        if {!$r} {tkwait window .}
        if {$r} {tk_messageBox -icon error -message $err}
        exit $r
    }
}