Version 2 of Docking framework

Updated 2008-11-05 10:48:38 by flame

Flame Searching the wiki I have not found any code implementing modern interface, which is sometimes called 'docking framework'. The idea is that user can configure the layout of the frames within a window, embed windows in tabs etc. like it is done in IDEs.

Here is some code I've written that implements this functionality based on two Tile widgets panedwindow and notebook. User can drag tabs from one notebook to another, or place tabs aside the existing notebook. Mid-button "undocks" tab into a separate window; closing that window tries to place tab back, if the notebook still exists, or adds the tab to some other notebook.


# DockingFramework # published under BSD license # package require Ttk

namespace eval DockingFramework {

# tabs variable tbs variable tbcnt 0

# find notebook, corresponding to path proc find_tbn {path} {

  variable tbs                        
  if {$path==""} { return $path }     
  # already a managed notebook?       
  if {[info exists tbs($path)]} {     
    return $path                      
  }                                   
  # managed notebooks have the form .toplevel.tbn#
  # pages within notebooks should also have the path .toplevel.page#
  set spath [split $path "."]                                       
  if {[winfo toplevel $path]=="."} {                                
    set path [join [lrange $path 0 1] "."]                          
  } else {                                                          
    set path [join [lrange $path 0 2] "."]                          
  }                                                                 
  # is it a managed notebook?                                       
  if {[info exists tbs($path)]} {                                   
    return $path                                                    
  }                                                                 
  # try to find notebook that manages this page                     
  foreach tb [array names tbs] {                                    
    if {[lsearch -exact [$tb tabs] $path]>=0} {                     
      return $tb                                                    
    }                                                               
  }                                                                 
  return {}                                                         

}

# added paned window of other direction, move a notebook there and create a new notebook proc embed_tbn {tbn anchor} {

  variable tbcnt                                                                        
  variable tbs                                                                          
  set pw $tbs($tbn)                                                                     
  if {$anchor=="w" || $anchor=="e"} {                                                   
    set orient "horizontal"                                                             
  } else {                                                                              
    set orient "vertical"                                                               
  }                                                                                     
  # create new paned window                                                             
  set npw [ttk::panedwindow $pw.pw$tbcnt -orient $orient]                               
  incr tbcnt                                                                            
  # move old notebook                                                                   
  set i [lsearch -exact [$pw panes] $tbn]                                               
  $pw forget $tbn                                                                       
  if {$i>=[llength [$pw panes]]} {                                                      
    $pw add $npw -weight 1                                                              
  } else {                                                                              
    $pw insert $i $npw -weight 1                                                        
  }                                                                                     
  # add new notebook                                                                    
  set ntb [ttk::notebook [winfo toplevel $pw].tb$tbcnt]                                 
  incr tbcnt                                                                            
  set tbs($tbn) $npw                                                                    
  set tbs($ntb) $npw                                                                    
  # make sure correct order                                                             
  if {$anchor=="s" || $anchor=="w"} {                                                   
    $npw add $ntb -weight 1                                                             
    $npw add $tbn -weight 1                                                             
  } else {                                                                              
    $npw add $tbn -weight 1                                                             
    $npw add $ntb -weight 1                                                             
  }                                                                                     
  return $ntb                                                                           

}

# add a new notebook to the side anchor of the notebook tbn proc add_tbn {tbn anchor} {

  variable tbcnt                                           
  variable tbs                                             

  set pw $tbs($tbn)
  set orient [$pw cget -orient]

  # if orientation of the uplevel panedwindow is consistent with anchor, just add the pane
  if {$orient=="horizontal" && ($anchor=="w" || $anchor=="e")} {                          
    set i [lsearch -exact [$pw panes] $tbn]                                               
    if {$anchor=="e"} { incr i }                                                          
    set tbn [ttk::notebook [winfo toplevel $pw].tb$tbcnt]                                 
    incr tbcnt                                                                            
    set tbs($tbn) $pw                                                                     
    if {$i>=[llength [$pw panes]]} {                                                      
      $pw add $tbn -weight 1                                                              
    } else {                                                                              
      $pw insert $i $tbn -weight 1                                                        
    }                                                                                     
  } elseif {$orient=="vertical" && ($anchor=="n" || $anchor=="s")} {                      
    set i [lsearch -exact [$pw panes] $tbn]                                               
    if {$anchor=="s"} { incr i}                                                           
    set tbn [ttk::notebook [winfo toplevel $pw].tb$tbcnt]                                 
    incr tbcnt                                                                            
    set tbs($tbn) $pw                                                                     
    if {$i>=[llength [$pw panes]]} {                                                      
      $pw add $tbn -weight 1                                                              
    } else {                                                                              
      $pw insert $i $tbn -weight 1                                                        
    }                                                                                     
  } else {                                                                                
    # orientation of the uplevel panedwindow is opposite to the anchor                    
    # need to add new panedwindow                                                         
    set tbn [embed_tbn $tbn $anchor]                                                      
  }                                                                                       
  return $tbn                                                                             

}

# update cursor to reflect the anchor proc make_cursor {cpath path x y} {

  set tb [find_tbn $path]            
  if {$tb==""} {                     
    $cpath configure -cursor {}      
    return "t"                       
  }                                  
  set w [winfo width $tb]            
  set h [winfo height $tb]           

  set x [expr $x-[winfo rootx $tb]]
  set y [expr $y-[winfo rooty $tb]]

  if {$x<0 || $y<0 || $x>=$w || $y>=$h || ($tb==$cpath && [$cpath identify $x $y]!="")} {
    set anchor {}                                                                        
  } elseif {$x>=[expr $w/3] && $x<=[expr $w*2/3] && $y>=[expr $h/3] && $y<=[expr $h*2/3]} {
    set anchor "t"                                                                         
  } else {                                                                                 
    # determine the closest side to the cursor                                             
    set side 1                                                                             
    set rdist [expr $w+$h]                                                                 
    foreach {x0 y0} {0 0 0 0 $w 0 0 $h} a {w n e s} {                                      
      set dist [expr abs($x-$x0)*$side+abs($y-$y0)*(1-$side)]                              
      set side [expr 1-$side]                                                              
      if {$dist<$rdist} {                                                                  
        set rdist $dist                                                                    
        set anchor $a                                                                      
      }                                                                                    
    }                                                                                      
  }                                                                                        
  array set cursors {                                                                      
    s bottom_side                                                                          
    w left_side                                                                            
    e right_side                                                                           
    n top_side                                                                             
    t cross                                                                                
    {} {}                                                                                  
  }                                                                                        
  $cpath configure -cursor $cursors($anchor)                                               
  return $anchor                                                                           

}

proc get_class {path} { return lindex [bingtags $path 1] }

proc _cleanup_tabs {srctab} {

  variable tbs               
  # if srctab is empty, then remove it
  if {[llength [$srctab tabs]]==0} {  
    destroy $srctab                   
    set pw $tbs($srctab)              
    unset tbs($srctab)                
    while {[llength [$pw panes]]==0} {
      if {[get_class $pw]!="TPanedwindow"} { break }
      set parent [winfo parent $pw]                 
      destroy $pw                                   
      set pw $parent                                
    }                                               
  }                                                 

}

proc move_tab {srctab dsttab} {

  variable tbs                 
  # move tab                   
  set f [$srctab select]       
  set o [$srctab tab $f]       
  $srctab forget $f            
  eval $dsttab add $f $o       
  raise $f                     
  $dsttab select $f            
  _cleanup_tabs $srctab        

}

variable c_path {} variable s_cursor {}

proc start_motion {path} {

  variable c_path         
  variable s_cursor       
  if {$path!=$c_path} {   
    set c_path [find_tbn $path]
    catch {$c_path configure -cursor $s_cursor}
    set s_cursor [$c_path cget -cursor]        
  }                                            

}

proc motion {x y} {

  variable c_path  
  if {$c_path!=""} {
    set path [winfo containing $x $y]
    if {$path==""} { return }        
    make_cursor $c_path $path $x $y  
  }                                  

}

proc end_motion {x y} {

  variable c_path      
  variable s_cursor    
  if {$c_path==""} { return }
  set path [winfo containing $x $y]
  set anchor [make_cursor $c_path $path $x $y]
  $c_path configure -cursor $s_cursor         
  set t [find_tbn $path]                      
  if {$t!=""} {                               
    if {$t==$c_path} {                        
      if {[$c_path identify [expr $x-[winfo rootx $c_path]] [expr $y-[winfo rooty $c_path]]]!=""} {
        set c_path {}                                                                              
        return                                                                                     
      }                                                                                            
    }                                                                                              
    if {$anchor!="t"} {                                                                            
      set tbn [add_tbn $t $anchor]                                                                 
      #label $tbn.lb -text "This is a notebook $tbn" -borderwidth 10 -relief groove                
      #$tbn add $tbn.lb -text "$tbn"                                                               
      move_tab $c_path $tbn                                                                        
    } elseif {$t!=$c_path} {                                                                       
      move_tab $c_path $t                                                                          
    }                                                                                              
  }                                                                                                
  set c_path {}                                                                                    

}

bind TNotebook <Button-1> +namespace code {start_motion %W} bind TNotebook <B1-Motion> +namespace code {motion %X %Y} bind TNotebook <ButtonRelease-1> +namespace code {end_motion %X %Y}

proc undock {srctab} {

  variable tbs        
  if {[llength [$srctab tabs]]==1 && [llength [array names tbs]]==1} { return }

  set f [$srctab select]
  set name [$srctab tab $f -text]
  set o [$srctab tab $f]         

  $srctab forget $f              
  _cleanup_tabs $srctab          

  wm manage $f
  catch {wm attributes $f -toolwindow 1}
  wm title $f $name                     
  wm protocol $f WM_DELETE_WINDOW [namespace code [list __dock $f]]
  wm deiconify $f                                                  
  label $f.__notebook_name__ -text [list $srctab $o]               

}

proc __dock {wnd} {

  variable tbs     
  set name [wm title $wnd]
  wm withdraw $wnd        
  wm forget $wnd          
  # try to find a notebook to place the window
  set d [$wnd.__notebook_name__ cget -text]   
  destroy $wnd.__notebook_name__              

  set dsttab [lindex $d 0]
  set o [lindex $d 1]     

  if {![winfo exists $dsttab]} {
    set dsttab [lindex [array names tbs] 0]
  }                                        
  eval $dsttab add $wnd $o                 
  raise $wnd                               
  $dsttab select $wnd                      

}

bind TNotebook <Button-2> namespace code {undock %W}

proc add_tab {path anchor args} {

  variable tbs                   
  # scan all tabs to find the most suitable
  set dsttab {}                            

  foreach tb [array names tbs] {
    set x [winfo rootx $tb]     
    set y [winfo rooty $tb]     
    set w [winfo width $tb]     
    set h [winfo height $tb]    
    switch $anchor {            
      n { set rel {$y < $_y} }  
      w { set rel {$x < $_x} }  
      s { set rel {$y > $_y} }  
      e { set rel {$x > $_x} }  
    }                           
    if {$dsttab==""} {          
      set dsttab $tb            
      set _x $x                 
      set _y $y                 
    } elseif { [expr $rel] } {  
      set dsttab $tb            
      set _x $x                 
      set _y $y                 
    }                           
  }                             
  eval [list $dsttab add $path] $args

}

proc remove_tab {path} {

  set tb [find_tbn $path]
  if {$tb==""} {         
    error -code "window $path is not managed by the framework"
  }                                                           
  $tb forget $path                                            
  _cleanup_tabs $tb                                           

}

proc activate_tab {path} {

  set tb [find_tbn $path]
  if {$tb==""} {
    error -code "window $path is not managed by the framework"
  }
  $tb select $path

}

proc hide_tab {path} {

  set tb [find_tbn $path]
  if {$tb==""} {
    error -code "window $path is not managed by the framework"
  }
  $tb hide $path

}

proc show_tab {path} {

  set tb [find_tbn $path]
  if {$tb==""} {
    error -code "window $path is not managed by the framework"
  }
  $tb add $path

}

}

pack ttk::panedwindow .pw -orient vertical -fill both -expand true .pw add ttk::notebook .nb -weight 1 set DockingFramework::tbs(.nb) .pw

for {set i 0} {$i<10} {incr i} {

  DockingFramework::add_tab [label .lb$i -text "notebook $i" -borderwidth 10] e -text "tab $i"

}



enter categories here