set rcsId {$Id: notebook.tcl,v 2.11 2002/08/09 18:58:02 jfontain Exp $}


class notebook {

    class page {

        proc page {this parentPath args} composite {
            [new frame $parentPath -background $widget::option(button,background) -relief raised -borderwidth 1] $args
        } {
            composite::manage $this [new label $parentPath -relief raised  -borderwidth 1 -padx 3 -pady 2] tab\
                [new frame $parentPath] patch
            composite::complete $this
            raise $this
            place $composite::($this,patch,path) -height 2                                                       ;# set patch height
        }

        proc ~page {this} {}

        proc options {this} {
            return [list\
                [list -command {} {}]\
                [list -font $widget::option(button,font) $widget::option(button,font)]\
                [list -taboffset 0 0]\
                [list -text {} {}]\
                [list -underline -1 -1]\
                [list -x 0]\
                [list -y 0]\
            ]
        }

        foreach option {-font -text -underline} {
            proc set$option {this value} "widget::configure \$composite::(\$this,tab) $option \$value"
        }

        proc set-command {this value} {
            bind $composite::($this,tab,path) <ButtonRelease-1> $value
        }

        proc set-text {this value} {
            set tab $composite::($this,tab)
            widget::configure $tab -text $value
            place $composite::($this,patch,path) -width [expr {[winfo reqwidth $composite::($this,tab,path)]-2}]     ;# resize patch
        }

        # set the distance between the left side of the page and the left side of the tab:
        proc set-taboffset {this value} {
            place $composite::($this,tab,path) -x [expr {$composite::($this,-x)+$value}]
            place $composite::($this,patch,path) -x [expr {$composite::($this,-x)+$value+1}]
        }

        proc set-x {this value} {
            place $widget::($this,path) -x $value
            set-taboffset $this $composite::($this,-taboffset)                                                     ;# reposition tab
        }

        proc set-y {this value} {
            place $composite::($this,tab,path) -y $value
            incr value [expr {[winfo reqheight $composite::($this,tab,path)]-2}]
            place $widget::($this,path) -y $value
            place $composite::($this,patch,path) -y [expr {$value-1}]
        }

        proc raise {this args} {
            eval ::raise $composite::($this,tab,path) $args
            ::raise $widget::($this,path) $composite::($this,tab,path)
            ::raise $composite::($this,patch,path) $widget::($this,path)
        }

        proc lower {this args} {
            eval ::lower $composite::($this,patch,path) $args
            ::lower $widget::($this,path) $composite::($this,patch,path)
            ::lower $composite::($this,tab,path) $widget::($this,path)
        }

        proc cover {this other} {
            raise $this $composite::($other,patch,path)                                               ;# use other page highest path
        }

        proc uncover {this other} {
            lower $this $composite::($other,tab,path)                                                  ;# use other page lowest path
        }

        proc tabWidth {this} {
             return [winfo reqwidth $composite::($this,tab,path)]
        }

        proc tabHeight {this} {
             return [expr {[winfo reqheight $composite::($this,tab,path)]-2}]
        }

        proc largeTab {this} {
            place $composite::($this,tab,path) -y [expr {$composite::($this,-y)-2}]
            $composite::($this,tab,path) configure -pady 2
        }

        proc normalTab {this} {
            place $composite::($this,tab,path) -y $composite::($this,-y)
            $composite::($this,tab,path) configure -pady 1
        }

    }

}

set ::notebook::(list) {}
# these should really be added to existing bindings instead of replacing them but it seems that recursive calls to focus do not work
bind all <Tab> {focus [notebook::focus [tk_focusNext %W] tk_focusNext]}
bind all <Shift-Tab> {focus [notebook::focus [tk_focusPrev %W] tk_focusPrev]}

class notebook {

    proc notebook {this parentPath args} composite {[new frame $parentPath] $args} {
        register $this
        set ($this,parent) $parentPath
        set ($this,columns) 5
        set ($this,nextOffset) 0
        set ($this,framesWidth) 0
        set ($this,framesHeight) 0
        set ($this,tabHeight) 0
        set ($this,tabsHeight) 0
        set ($this,columnOffsets) 0
        set ($this,lastRow) 0
        set ($this,pages) {}
        set ($this,frontRow) 0
        set ($this,active) 0
        composite::complete $this
    }

    proc ~notebook {this} {
        eval delete $($this,pages)
        unregister $this
    }

    proc register {this} {
        lappend (list) $this
    }

    proc unregister {this} {
        set index [lsearch -exact $(list) $this]
        set (list) [lreplace $(list) $index $index]
    }

    proc options {this} {                            ;# force initialization on columns offset so that pixel conversion always occur
        return [list\
            [list -command {} {}]\
            [list -columns 5 5]\
            [list -columnoffset 1c]\
            [list -expand 0 0]\
            [list -font $widget::option(button,font) $widget::option(button,font)]\
            [list -height 0 0]\
            [list -width 0 0]\
        ]
    }

    proc set-command {this value} {}

    proc set-height {this value} {
        if {$value<=0} {
            updateHeight $this
        } else {
            $widget::($this,path) configure -height $value
        }
    }

    proc set-width {this value} {
        if {$value<=0} {
            updateWidth $this
        } else {
            $widget::($this,path) configure -width $value
        }
    }

    proc set-columns {this value} {
        if {$composite::($this,complete)} {
            error {option -columns cannot be set dynamically}
        }
    }

    proc set-expand {this value} {
        if {$composite::($this,complete)} {
            error {option -expand cannot be set dynamically}
        }
    }

    proc set-columnoffset {this value} {
        if {$composite::($this,complete)} {
            error {option -columnoffset cannot be set dynamically}
        }
        # always convert to pixels for easier use and error checking
        set ($this,columnOffset) [winfo pixels $widget::($this,path) $value]
    }

    proc set-font {this value} {
        if {$composite::($this,complete)} {
            error {option -font cannot be set dynamically}
        }
    }

    proc newPage {this labelText} {
        if {[info exists ($this,selected)]} {
            error "new page cannot be added dynamically"
        }
        set page [new page $widget::($this,path) -text $labelText -font $composite::($this,-font)]

        # use a frame for clipping so that page border is not obscured when notebook is resized below child user widget requested
        # size
        set path $widget::([new frame $widget::($page,path)],path)
        place $path -relwidth 1 -relheight 1 -width -1 -height -1
        set ($this,pageFrame,$page) $path

        grid rowconfigure $path 0 -weight 1
        grid columnconfigure $path 0 -weight 1
        # place sub-widgets centered in a frame with their upper left corner always visible, thanks to the grid manager behavior:
        set path $widget::([new frame $path],path)
        if {$composite::($this,-expand)} {
            grid $path -sticky nwes
        } else {
            grid $path
        }
        bind $path <Configure> "notebook::update $this $path"
        set ($this,pageContainer,$page) $path

        if {[llength $($this,pages)]==0} {                                         ;# initialize a few things at first page creation
            # assume tabs height is constant
            set ($this,tabsHeight) [set ($this,tabHeight) [page::tabHeight $page]]
            set ($this,active) $page
        } else {                                                     ;# always place new page below the others and make it invisible
            page::uncover $page [lindex $($this,pages) end]
            place $($this,pageFrame,$page) -anchor se
        }
        widget::configure $page -command "notebook::select $this $page"
        lappend ($this,pages) $page
        placeNew $this $page
        return $path
    }

    proc placeNew {this page} {
        set row [expr {([llength $($this,pages)]-1)/$composite::($this,-columns)}]
        if {$row>$($this,lastRow)} {
            set ($this,lastRow) $row
            incr ($this,columnOffsets) $($this,columnOffset)
            incr ($this,tabsHeight) $($this,tabHeight) 
            for {set index 0} {$index<$row} {incr index} {                                               ;# reposition existing rows
                positionRow $this $index $index
            }
            set ($this,nextOffset) 0
            # make existing page frames follow notebook widget configuration according to number of rows and column offset
            for {set index 0} {$index<$row} {incr index} {
                foreach other $($this,rowPages,$index) {
                    place $widget::($other,path)\
                        -relwidth 1 -relheight 1 -width -$($this,columnOffsets) -height -$($this,tabsHeight)
                }
            }
            updateWidth $this                                   ;# make sure sizes are correct in case we get no configuration event
            updateHeight $this
        }
        place $widget::($page,path) -relwidth 1 -relheight 1 -width -$($this,columnOffsets) -height -$($this,tabsHeight)
        set ($this,rowPosition,$row) $row
        lappend ($this,rowPages,$row) $page                                     ;# store row pages in separate lists for fast access
        set ($this,pagePosition,$page) $row
        set ($this,row,$page) $row
        widget::configure $page -x [expr {$row*$($this,columnOffset)}] -taboffset $($this,nextOffset)
        incr ($this,nextOffset) [page::tabWidth $page]
        if {$($this,nextOffset)>$($this,framesWidth)} {                                            ;# make sure all tabs are visible
            set ($this,framesWidth) $($this,nextOffset)
            updateWidth $this
        }
    }

    proc updateWidth {this} {
        $widget::($this,path) configure -width [expr {$($this,framesWidth)+$($this,columnOffsets)}]
    }

    proc updateHeight {this} {
        $widget::($this,path) configure -height [expr {$($this,framesHeight)+$($this,tabsHeight)}]
    }

    proc update {this path} {
        # take the page border size into account,
        # add 1 pixel to sizes because placer fails to correctly center widgets with odd sizes
        set width [expr {[winfo reqwidth $path]+3}]
        if {$width>$($this,framesWidth)} {
            set ($this,framesWidth) $width
            updateWidth $this
        }
        set height [expr {[winfo reqheight $path]+3}]
        if {$height>$($this,framesHeight)} {
            set ($this,framesHeight) $height
            updateHeight $this
        }
    }

    proc select {this page} {
        set ($this,selected) {}
        if {$($this,pagePosition,$page)!=0} {
            set row $($this,frontRow)                                       ;# if not already in front, swap this row with front row
            positionRow $this $($this,frontRow) $($this,pagePosition,$page)
            positionRow $this $($this,row,$page) 0
            raiseRow $this $($this,row,$page)                                                   ;# make sure selected row is visible
            lowerRow $this $row
        }
        foreach item $($this,rowPages,$($this,row,$page)) {
            if {$item==$page} {page::largeTab $item} else {page::normalTab $item}
        }
        page::raise $page
        if {$($this,active)!=0} {
            place $($this,pageFrame,$($this,active)) -anchor se                                           ;# and make page invisible
        }
        place $($this,pageFrame,$page) -anchor nw                                                               ;# make page visible
        set ($this,active) $page
        if {[string length $composite::($this,-command)]>0} {
            # pass newPage{} returned path to command so that user code knows which page is concerned:
            uplevel #0 $composite::($this,-command) $($this,pageContainer,$page)
        }
    }

    proc positionRow {this index position} {
        if {$position==0} {
            set ($this,frontRow) $index
        }
        set ($this,rowPosition,$index) $position
        set y [expr {($($this,lastRow)-$position)*$($this,tabHeight)}]
        set x [expr {$position*$($this,columnOffset)}]
        foreach page $($this,rowPages,$index) {
            set ($this,pagePosition,$page) $position
            widget::configure $page -x $x -y $y
        }
    }

    proc raiseRow {this index} {
        foreach page [lsort -integer -decreasing $($this,rowPages,$index)] {
            page::raise $page
        }
    }

    proc lowerRow {this index} {
        set row $index
        # find last page of row in front of this one, which is guaranteed to be the lowest among its row pages
        set position [expr {$($this,rowPosition,$index)-1}]
        for {set index 0} {$($this,rowPosition,$index)!=$position} {incr index} {}
        set last [lindex $($this,rowPages,$index) end]
        foreach page [lsort -integer -decreasing $($this,rowPages,$row)] {
            page::uncover $page $last
        }
    }

    proc geometryManager {window} {
        set manager [winfo manager $window]
        if {[string length $manager]==0} {
            return {}
        }
        ### at this time canvas and text managers are not supported, due to the high complexity of finding the manager widget name
        switch $manager {
            grid -
            pack {
                array set data [$manager info $window]
                return $data(-in)
            }
            place {
                array set data [place info $window]
                if {[info exists data(-in)]} {
                    return $data(-in)
                } else {
                    return [winfo parent $window]
                }
            }
        }
    }

    # find whether window or one of his ancestors is managed geometry-wise by a notebook page
    proc managingPage {this window} {
        set toplevel [winfo toplevel $window]
        while {![string equal $window $toplevel]} {
            set manager [geometryManager $window]
            if {[string length $manager]==0} {
                return {}
            }
            foreach page $($this,pages) {
                if {[string equal $manager $widget::($page,path)]} {
                    return $page
                }
            }
            set window $manager                                                                                ;# up to next manager
        }
        return {}
    }

    proc focus {window next} {
        if {[string length $window]==0} {
            return {}
        }
        foreach book $(list) {
            if {![winfo exists $widget::($book,path)]} {                                             ;# book may have been destroyed
                unregister $book
                continue
            }
            set page [managingPage $book $window]
            if {[string length $page]>0} {                                                    ;# found page that manages this widget
                if {$page==$($book,active)} {
                    return $window                                                            ;# page in front, widget can get focus
                } else {
                    return [focus [$next $window] $next]                           ;# not in front, see if next widget can get focus
                }
            }
        }
        return $window                                      ;# widget is not managed by any notebook, therefore it can get the focus
    }

}
