panedwindow.tcl

windows下的GDB insight前端

#
# Panedwindow  
# ----------------------------------------------------------------------
# Implements a very general panedwindow which allows for mixing resizable
# and non-resizable panes.  It also allows limits to be set on individual
# pane sizes, both minimum and maximum.
#
# The look of this widget is much like Window, instead of the Motif-like
# iwidget panedwindow.
# ----------------------------------------------------------------------

# Portions of this code are originally from the iwidget panedwindow which
# is Copyright (c) 1995 DSC Technologies Corporation 

itk::usual PanedWindow {
  keep -background -cursor
}

# ------------------------------------------------------------------
#                            PANEDWINDOW
# ------------------------------------------------------------------
itcl::class cyg::PanedWindow {
  inherit itk::Widget

  constructor {args} {}

  itk_option define -orient orient Orient horizontal
  itk_option define -sashwidth sashWidth SashWidth 10
  itk_option define -sashcolor sashColor SashColor gray

  public {
    method index {index}
    method childsite {args}
    method add {tag args}
    method insert {index tag args}
    method delete {index}
    method hide {index}
    method replace {pane1 pane2}
    method show {index}
    method paneconfigure {index args}
    method reset {}
  }

  private {
    method _eventHandler {width height}
    method _startDrag {num}
    method _endDrag {where num}
    method _configDrag {where num}
    method _handleDrag {where num}
    method _moveSash {where num {dir ""}}

    method _resizeArray {}
    method _setActivePanes {}
    method _calcPos {where num {dir ""}}
    method _makeSashes {}
    method _placeSash {i}
    method _placePanes {{start 0} {end end} {forget 0}}

    variable _initialized 0	;# flag set when widget is first configured
    variable _sashes {}		;# List of sashes.

    # Pane information
    variable _panes {}		;# List of panes.
    variable _activePanes {}	;# List of active panes.
    variable _where		;# Array of relative positions
    variable _ploc		;# Array of pixel positions
    variable _frac		;# Array of relative pane sizes
    variable _pixels		;# Array of sizes in pixels for non-resizable panes
    variable _max		;# Array of pane maximum locations
    variable _min		;# Array of pane minimum locations
    variable _pmin		;# Array of pane minimum size
    variable _pmax		;# Array of pane maximum size

    variable _dimension 0	;# width or height of window
    variable _dir "height"	;# resizable direction, "height" or "width"
    variable _rPixels

    variable _sashloc          ;# Array of dist of sash from above/left.

    variable _minsashmoved     ;# Lowest sash moved during dragging.
    variable _maxsashmoved     ;# Highest sash moved during dragging.

    variable _width 0		;# hull's width.
    variable _height 0		;# hull's height.
    variable _unique -1		;# Unique number for pane names.
  }
}

#
# Provide a lowercased access method for the PanedWindow class.
# 
proc ::cyg::panedwindow {pathName args} {
  uplevel ::cyg::PanedWindow $pathName $args
}

#
# Use option database to override default resources of base classes.
#
option add *PanedWindow.width 10 widgetDefault
option add *PanedWindow.height 10 widgetDefault

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::constructor {args} {
  itk_option add hull.width hull.height

  pack propagate $itk_component(hull) no
  
  bind pw-config-$this <Configure> [code $this _eventHandler %w %h]
  bindtags $itk_component(hull) \
    [linsert [bindtags $itk_component(hull)] 0 pw-config-$this]
  
  eval itk_initialize $args
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION: -orient
#
# Specifies the orientation of the sashes.  Once the paned window
# has been mapped, set the sash bindings and place the panes.
# ------------------------------------------------------------------
itcl::configbody cyg::PanedWindow::orient {
  #puts "orient $_initialized"
  if {$_initialized} {
    set orient $itk_option(-orient)
    if {$orient != "vertical" && $orient != "horizontal"} {
      error "bad orientation option \"$itk_option(-orient)\":\
	        should be horizontal or vertical"
    }
    if {[string compare $orient "vertical"]} {
      set _dimension $_height
      set _dir "height"
    } else {
      set _dimension $_width
      set _dir "width"
    }
    _resizeArray
    _makeSashes
    _placePanes 0 end 1
  }
}

# ------------------------------------------------------------------
# OPTION: -sashwidth
#
# Specifies the width of the sash.
# ------------------------------------------------------------------
itcl::configbody cyg::PanedWindow::sashwidth {
  set pixels [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
  set itk_option(-sashwidth) $pixels
  
  if {$_initialized} {
    # FIXME
    for {set i 1} {$i < [llength $_panes]} {incr i} {
      $itk_component(sash$i) configure \
	-width $itk_option(-sashwidth) -height $itk_option(-sashwidth) \
	-borderwidth 2
    }
    for {set i 1} {$i < [llength $_panes]} {incr i} {
      _placeSash $i
    }
  }
}

# ------------------------------------------------------------------
# OPTION: -sashcolor
#
# Specifies the color of the sash.
# ------------------------------------------------------------------
itcl::configbody cyg::PanedWindow::sashcolor {
  if {$_initialized} {
    for {set i 1} {$i < [llength $_panes]} {incr i} {
      $itk_component(sash$i) configure -background $itk_option(-sashcolor)
    }
  }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: index index
#
# Searches the panes in the paned window for the one with the 
# requested tag, numerical index, or keyword "end".  Returns the pane's 
# numerical index if found, otherwise error.
# ------------------------------------------------------------------    
itcl::body cyg::PanedWindow::index {index} {
  if {[llength $_panes] > 0} {
    if {[regexp {(^[0-9]+$)} $index]} {
      if {$index < [llength $_panes]} {
	return $index
      } else {
	error "PanedWindow index \"$index\" is out of range"
      }
    } elseif {$index == "end"} {
      return [expr [llength $_panes] - 1]
    } else {
      if {[set idx [lsearch $_panes $index]] != -1} {
	return $idx
      }
      error "bad PanedWindow index \"$index\": must be number, end,\
		    or pattern"
    }
  } else {
    error "PanedWindow \"$itk_component(hull)\" has no panes"
  }
}

# ------------------------------------------------------------------
# METHOD: childsite ?index?
#
# Given an index return the specifc childsite path name.  Invoked 
# without an index return a list of all the child site panes.  The 
# list is ordered from the near side (left/top).
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::childsite {args} {
  #puts "childsite $args ($_initialized)"
  
  if {[llength $args] == 0} {
    set children {}
    foreach pane $_panes {
      lappend children [$itk_component($pane) childSite]
    }
    return $children
  } else {
    set index [index [lindex $args 0]]
    return [$itk_component([lindex $_panes $index]) childSite]
  }
}


# ------------------------------------------------------------------
# METHOD: add tag ?option value option value ...?
#
# Add a new pane to the paned window to the far (right/bottom) side.
# The method takes additional options which are passed on to the 
# pane constructor.  These include -margin, and -minimum.  The path 
# of the pane is returned.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::add {tag args} {
  itk_component add $tag {
    eval cyg::Pane $itk_interior.pane[incr _unique] $args
  } {
    keep -background -cursor
  }
  
  lappend _panes $tag
  lappend _activePanes $tag
  reset  
  return $itk_component($tag)
}

# ------------------------------------------------------------------
# METHOD: insert index tag ?option value option value ...?
#
# Insert the specified pane in the paned window just before the one 
# given by index.  Any additional options which are passed on to the 
# pane constructor.  These include -margin, -minimum.  The path of 
# the pane is returned.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::insert {index tag args} {
  itk_component add $tag {
    eval cyg::Pane $itk_interior.pane[incr _unique] $args
  } {
    keep -background -cursor
  }
  
  set index [index $index]
  set _panes [linsert $_panes $index $tag]
  lappend _activePanes $tag  
  reset
  return $itk_component($tag)
}

# ------------------------------------------------------------------
# METHOD: delete index
#
# Delete the specified pane.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::delete {index} {
  set index [index $index]
  set tag [lindex $_panes $index]

  # remove the itk component
  destroy $itk_component($tag)
  # remove it from panes list
  set _panes [lreplace $_panes $index $index]  
  
  # remove its _frac value
  set ind [lsearch -exact $_activePanes $tag]
  if {$ind != -1 && [info exists _frac($ind)]} {
    unset _frac($ind)
  }
  
  # this will reset _activePane and resize things
  reset
}

# ------------------------------------------------------------------
# METHOD: hide index
#
# Remove the specified pane from the paned window. 
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::hide {index} {
  set index [index $index]
  set tag [lindex $_panes $index]
  
  if {[set idx [lsearch -exact $_activePanes $tag]] != -1} {
    set _activePanes [lreplace $_activePanes $idx $idx]
    if {[info exists _frac($idx)]} {unset _frac($idx)}
  }

  reset
}

itcl::body cyg::PanedWindow::replace {pane1 pane2} {
  set ind1 [lsearch -exact $_activePanes $pane1]
  if {$ind1 == -1} {
    error "$pane1 is not an active pane name."
  }
  set ind2 [lsearch -exact $_panes $pane2]
  if {$ind2 == -1} {
    error "Pane $pane2 does not exist."
  }
  set _activePanes [lreplace $_activePanes $ind1 $ind1 $pane2]
  _placePanes 0 $ind1 1
}

# ------------------------------------------------------------------
# METHOD: show index
#
# Display the specified pane in the paned window.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::show {index} {
  set index [index $index]
  set tag [lindex $_panes $index]
  
  if {[lsearch -exact $_activePanes $tag] == -1} {
    lappend _activePanes $tag
  }

  reset
}

# ------------------------------------------------------------------
# METHOD: paneconfigure index ?option? ?value option value ...?
#
# Configure a specified pane.  This method allows configuration of
# panes from the PanedWindow level.  The options may have any of the 
# values accepted by the add method.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::paneconfigure {index args} {
  set index [index $index]
  set tag [lindex $_panes $index]
  return [uplevel $itk_component($tag) configure $args]
}

# ------------------------------------------------------------------
# METHOD: reset
#
# Redisplay the panes based on the default percentages of the panes.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::reset {} {
  if {$_initialized && [llength $_panes]} {
    #puts RESET
    _setActivePanes
    _resizeArray
    _makeSashes
    _placePanes 0 end 1
  }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _setActivePanes
#
# Resets the active pane list.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::_setActivePanes {} {
  set _prevActivePanes $_activePanes
  set _activePanes {}
  
  foreach pane $_panes {
    if {[lsearch -exact $_prevActivePanes $pane] != -1} {
      lappend _activePanes $pane
    }
  }
}

# ------------------------------------------------------------------
# PROTECTED METHOD: _eventHandler
#
# Performs operations necessary following a configure event.  This
# includes placing the panes.
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::_eventHandler {width height} {
  #puts "Event $width $height"
  set _width $width
  set _height $height
  if {[string compare $itk_option(-orient) "vertical"]} {
    set _dimension $_height
    set _dir "height"
  } else {
    set _dimension $_width
    set _dir "width"
  }
  
  if {$_initialized} {
    _resizeArray
    _placePanes
  } else {
    set _initialized 1
    reset
  }
}

# ------------------------------------------------------------------
# PRIVATE METHOD: _resizeArray
#
# Recalculates the sizes and positions of all the panes.
# This is only done at startup, when the window size changes, when
# a new pane is added, or the orientation is changed.
#
# _frac($i) contains:
#		% of resizable space when pane$i is resizable
# _pixels($i) contains
#		pixels when pane$i is not resizable
#
# _where($i) contains the relative position of the top of pane$i
# ------------------------------------------------------------------
itcl::body cyg::PanedWindow::_resizeArray {} {
  set numpanes 0