Version 6 of Docking framework

Updated 2008-11-05 12:30:45 by lars_h

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"
}