URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [hierarchy.itk] - Rev 578
Go to most recent revision | Compare with Previous | Blame | View Log
# Hierarchy# ----------------------------------------------------------------------# Hierarchical data viewer. Manages a list of nodes that can be# expanded or collapsed. Individual nodes can be highlighted.# Clicking with the right mouse button on any item brings up a# special item menu. Clicking on the background area brings up# a different popup menu.# ----------------------------------------------------------------------# AUTHOR: Michael J. McLennan# Bell Labs Innovations for Lucent Technologies# mmclennan@lucent.com## Mark L. Ulferts# DSC Communications# mulferts@austin.dsccc.com## RCS: $Id: hierarchy.itk,v 1.1.1.1 2002-01-16 10:24:50 markom Exp $# ----------------------------------------------------------------------# Copyright (c) 1996 Lucent Technologies# ======================================================================# Permission to use, copy, modify, and distribute this software and its# documentation for any purpose and without fee is hereby granted,# provided that the above copyright notice appear in all copies and that# both that the copyright notice and warranty disclaimer appear in# supporting documentation, and that the names of Lucent Technologies# any of their entities not be used in advertising or publicity# pertaining to distribution of the software without specific, written# prior permission.## Lucent Technologies disclaims all warranties with regard to this# software, including all implied warranties of merchantability and# fitness. In no event shall Lucent Technologies be liable for any# special, indirect or consequential damages or any damages whatsoever# resulting from loss of use, data or profits, whether in an action of# contract, negligence or other tortuous action, arising out of or in# connection with the use or performance of this software.## ----------------------------------------------------------------------# Copyright (c) 1996 DSC Technologies Corporation# ======================================================================# Permission to use, copy, modify, distribute and license this software# and its documentation for any purpose, and without fee or written# agreement with DSC, is hereby granted, provided that the above copyright# notice appears in all copies and that both the copyright notice and# warranty disclaimer below appear in supporting documentation, and that# the names of DSC Technologies Corporation or DSC Communications# Corporation not be used in advertising or publicity pertaining to the# software without specific, written prior permission.## DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS# SOFTWARE.# ======================================================================## Usual options.#itk::usual Hierarchy {keep -cursor -textfont -fontkeep -background -foreground -textbackgroundkeep -selectbackground -selectforeground}# ------------------------------------------------------------------# HIERARCHY# ------------------------------------------------------------------class iwidgets::Hierarchy {inherit iwidgets::Scrolledwidgetconstructor {args} {}destructor {}itk_option define -alwaysquery alwaysQuery AlwaysQuery 0itk_option define -closedicon closedIcon Icon {}itk_option define -expanded expanded Expanded 0itk_option define -filter filter Filter 0itk_option define -font font Font \-*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*itk_option define -height height Height 0itk_option define -iconcommand iconCommand Command {}itk_option define -markbackground markBackground Foreground #a0a0a0itk_option define -markforeground markForeground Background Blackitk_option define -nodeicon nodeIcon Icon {}itk_option define -openicon openIcon Icon {}itk_option define -querycommand queryCommand Command {}itk_option define -selectcommand selectCommand Command {}itk_option define -selectbackground selectBackground Foreground #c3c3c3itk_option define -selectforeground selectForeground Background Blackitk_option define -visibleitems visibleItems VisibleItems 80x24itk_option define -width width Width 0public method clear {}public method collapse {node}public method current {}public method draw {{when -now}}public method expand {node}public method mark {op args}public method prune {node}public method refresh {node}public method selection {op args}public method toggle {node}public method bbox {index}public method compare {index1 op index2}public method debug {args} {eval $args}public method delete {first {last {}}}public method dlineinfo {index}public method dump {args}public method get {index1 {index2 {}}}public method index {index}public method insert {args}public method scan {option args}public method search {args}public method see {index}public method tag {op args}public method window {option args}public method xview {args}public method yview {args}protected method _contents {uid}protected method _iconSelect {node icon}protected method _post {x y}protected method _drawLevel {node indent}protected method _select {x y}protected method _deselectSubNodes {uid}protected method _deleteNodeInfo {uid}protected method _getParent {uid}protected method _getHeritage {uid}protected method _isInternalTag {tag}private variable _filterCode "" ;# Compact view flag.private variable _hcounter 0 ;# Counter for hierarchy iconsprivate variable _icons ;# Array of user icons by uidprivate variable _images ;# Array of our icons by uidprivate variable _indents ;# Array of indentation by uidprivate variable _marked ;# Array of marked nodes by uidprivate variable _markers "" ;# List of markers for level being drawnprivate variable _nodes ;# List of subnodes by uidprivate variable _pending "" ;# Pending draw flagprivate variable _posted "" ;# List of tags at posted menu positionprivate variable _selected ;# Array of selected nodes by uidprivate variable _tags ;# Array of user tags by uidprivate variable _text ;# Array of displayed text by uidprivate variable _states ;# Array of selection state by uidprivate variable _ucounter 0 ;# Counter for user icons}## Provide a lowercased access method for the Hierarchy class.#proc ::iwidgets::hierarchy {pathName args} {uplevel ::iwidgets::Hierarchy $pathName $args}## Use option database to override default resources of base classes.#option add *Hierarchy.menuCursor arrow widgetDefaultoption add *Hierarchy.labelPos n widgetDefaultoption add *Hierarchy.tabs 30 widgetDefault# ------------------------------------------------------------------# CONSTRUCTOR# ------------------------------------------------------------------body iwidgets::Hierarchy::constructor {args} {itk_option remove iwidgets::Labeledwidget::state## Our -width and -height options are slightly different than# those implemented by our base class, so we're going to# remove them and redefine our own.#itk_option remove iwidgets::Scrolledwidget::widthitk_option remove iwidgets::Scrolledwidget::height## Create a clipping frame which will provide the border for# relief display.#itk_component add clipper {frame $itk_interior.clipper} {usualkeep -borderwidth -relief -highlightthickness -highlightcolorrename -highlightbackground -background background Background}grid $itk_component(clipper) -row 0 -column 0 -sticky nsewgrid rowconfigure $_interior 0 -weight 1grid columnconfigure $_interior 0 -weight 1## Create a text widget for displaying our hierarchy.#itk_component add list {text $itk_component(clipper).list -wrap none -cursor center_ptr \-state disabled -width 1 -height 1 \-xscrollcommand \[code $this _scrollWidget $itk_interior.horizsb] \-yscrollcommand \[code $this _scrollWidget $itk_interior.vertsb] \-borderwidth 0 -highlightthickness 0} {usualkeep -spacing1 -spacing2 -spacing3 -tabsrename -font -textfont textFont Fontrename -background -textbackground textBackground Backgroundignore -highlightthickness -highlightcolorignore -insertbackground -insertborderwidthignore -insertontime -insertofftime -insertwidthignore -selectborderwidthignore -borderwidth}grid $itk_component(list) -row 0 -column 0 -sticky nsewgrid rowconfigure $itk_component(clipper) 0 -weight 1grid columnconfigure $itk_component(clipper) 0 -weight 1## Configure the command on the vertical scroll bar in the base class.#$itk_component(vertsb) configure \-command [code $itk_component(list) yview]## Configure the command on the horizontal scroll bar in the base class.#$itk_component(horizsb) configure \-command [code $itk_component(list) xview]## Configure our text component's tab settings for twenty levels.#set tabs ""for {set i 1} {$i < 20} {incr i} {lappend tabs [expr $i*12+4]}$itk_component(list) configure -tabs $tabs## Add popup menus that can be configured by the user to add# new functionality.#itk_component add itemMenu {menu $itk_component(list).itemmenu -tearoff 0} {usualignore -tearoffrename -cursor -menucursor menuCursor Cursor}itk_component add bgMenu {menu $itk_component(list).bgmenu -tearoff 0} {usualignore -tearoffrename -cursor -menucursor menuCursor Cursor}## Adjust the bind tags to remove the class bindings. Also, add# bindings for mouse button 1 to do selection and button 3 to# display a popup.#bindtags $itk_component(list) [list $itk_component(list) . all]bind $itk_component(list) <ButtonPress-1> \[code $this _select %x %y]bind $itk_component(list) <ButtonPress-3> \[code $this _post %x %y]## Initialize the widget based on the command line options.#eval itk_initialize $args}# ------------------------------------------------------------------# DESTRUCTOR# ------------------------------------------------------------------body iwidgets::Hierarchy::destructor {} {if {$_pending != ""} {after cancel $_pending}}# ------------------------------------------------------------------# OPTIONS# ------------------------------------------------------------------# ------------------------------------------------------------------# OPTION: -font## Font used for text in the list.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::font {$itk_component(list) tag configure info \-font $itk_option(-font) -spacing1 6}# ------------------------------------------------------------------# OPTION: -selectbackground## Background color scheme for selected nodes.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::selectbackground {$itk_component(list) tag configure hilite \-background $itk_option(-selectbackground)}# ------------------------------------------------------------------# OPTION: -selectforeground## Foreground color scheme for selected nodes.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::selectforeground {$itk_component(list) tag configure hilite \-foreground $itk_option(-selectforeground)}# ------------------------------------------------------------------# OPTION: -markbackground## Background color scheme for marked nodes.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::markbackground {$itk_component(list) tag configure lowlite \-background $itk_option(-markbackground)}# ------------------------------------------------------------------# OPTION: -markforeground## Foreground color scheme for marked nodes.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::markforeground {$itk_component(list) tag configure lowlite \-foreground $itk_option(-markforeground)}# ------------------------------------------------------------------# OPTION: -querycommand## Command executed to query the contents of each node. If this# command contains "%n", it is replaced with the name of the desired# node. In its simpilest form it should return the children of the# given node as a list which will be depicted in the display.## Since the names of the children are used as tags in the underlying# text widget, each child must be unique in the hierarchy. Due to# the unique requirement, the nodes shall be reffered to as uids# or uid in the singular sense.## {uid [uid ...]}## where uid is a unique id and primary key for the hierarchy entry## Should the unique requirement pose a problem, the list returned# can take on another more extended form which enables the# association of text to be displayed with the uids. The uid must# still be unique, but the text does not have to obey the unique# rule. In addition, the format also allows the specification of# additional tags to be used on the same entry in the hierarchy# as the uid and additional icons to be displayed just before# the node. The tags and icons are considered to be the property of# the user in that the hierarchy widget will not depend on any of# their values.## {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}## where uid is a unique id and primary key for the hierarchy entry# text is the text to be displayed for this uid# tags is a list of user tags to be applied to the entry# icons is a list of icons to be displayed in front of the text## The hierarchy widget does a look ahead from each node to determine# if the node has a children. This can be cost some performace with# large hierarchies. User's can avoid this by providing a hint in# the user tags. A tag of "leaf" or "branch" tells the hierarchy# widget the information it needs to know thereby avoiding the look# ahead operation.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::querycommand {cleardraw -eventually}# ------------------------------------------------------------------# OPTION: -selectcommand## Command executed to select an item in the list. If this command# contains "%n", it is replaced with the name of the selected node.# If it contains a "%s", it is replaced with a boolean indicator of# the node's current selection status, where a value of 1 denotes# that the node is currently selected and 0 that it is not.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::selectcommand {}# ------------------------------------------------------------------# OPTION: -iconcommand## Command executed upon selection of user icons. If this command# contains "%n", it is replaced with the name of the node the icon# belongs to. Should it contain "%i" then the icon name is# substituted.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::iconcommand {}# ------------------------------------------------------------------# OPTION: -alwaysquery## Boolean flag which tells the hierarchy widget weather or not# each refresh of the display should be via a new query using# the -querycommand option or use the values previous found the# last time the query was made.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::alwaysquery {}# ------------------------------------------------------------------# OPTION: -filter## When true only the branch nodes and selected items are displayed.# This gives a compact view of important items.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::filter {switch -- $itk_option(-filter) {1 - true - yes - on {set newCode {set display [info exists _selected($child)]}}0 - false - no - off {set newCode {set display 1}}default {error "bad filter option \"$itk_option(-filter)\":\should be boolean"}}if {$newCode != $_filterCode} {set _filterCode $newCodedraw -eventually}}# ------------------------------------------------------------------# OPTION: -expanded## When true, the hierarchy will be completely expanded when it# is first displayed. A fresh display can be triggered by# resetting the -querycommand option.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::expanded {switch -- $itk_option(-expanded) {1 - true - yes - on {;# okay}0 - false - no - off {;# okay}default {error "bad expanded option \"$itk_option(-expanded)\":\should be boolean"}}}# ------------------------------------------------------------------# OPTION: -openicon## Specifies the open icon image to be used in the hierarchy. Should# one not be provided, then one will be generated, pixmap if# possible, bitmap otherwise.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::openicon {if {$itk_option(-openicon) == {}} {if {[lsearch [image names] openFolder] == -1} {if {[lsearch [image types] pixmap] != -1} {image create pixmap openFolder -data {/* XPM */static char * dir_opened [] = {"16 16 4 1",/* colors */". c grey85 m white g4 grey90","b c black m black g4 black","y c yellow m white g4 grey80","g c grey70 m white g4 grey70",/* pixels */"................","................","................","..bbbb..........",".bggggb.........","bggggggbbbbbbb..","bggggggggggggb..","bgbbbbbbbbbbbbbb","bgbyyyyyyyyyyybb","bbyyyyyyyyyyyyb.","bbyyyyyyyyyyybb.","byyyyyyyyyyyyb..","bbbbbbbbbbbbbb..","................","................","................"};}} else {image create bitmap openFolder -data {#define open_width 16#define open_height 16static char open_bits[] = {0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00,0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0,0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};}}set itk_option(-openicon) openFolder}} else {if {[lsearch [image names] $itk_option(-openicon)] == -1} {error "bad openicon option \"$itk_option(-openicon)\":\should be an existing image"}}}# ------------------------------------------------------------------# OPTION: -closedicon## Specifies the closed icon image to be used in the hierarchy.# Should one not be provided, then one will be generated, pixmap if# possible, bitmap otherwise.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::closedicon {if {$itk_option(-closedicon) == {}} {if {[lsearch [image names] closedFolder] == -1} {if {[lsearch [image types] pixmap] != -1} {image create pixmap closedFolder -data {/* XPM */static char *dir_closed[] = {"16 16 3 1",". c grey85 m white g4 grey90","b c black m black g4 black","y c yellow m white g4 grey80","................","................","................","..bbbb..........",".byyyyb.........","bbbbbbbbbbbbbb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","bbbbbbbbbbbbbb..","................","................","................"};}} else {image create bitmap closedFolder -data {#define closed_width 16#define closed_height 16static char closed_bits[] = {0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00,0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};}}set itk_option(-closedicon) closedFolder}} else {if {[lsearch [image names] $itk_option(-closedicon)] == -1} {error "bad closedicon option \"$itk_option(-closedicon)\":\should be an existing image"}}}# ------------------------------------------------------------------# OPTION: -nodeicon## Specifies the node icon image to be used in the hierarchy. Should# one not be provided, then one will be generated, pixmap if# possible, bitmap otherwise.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::nodeicon {if {$itk_option(-nodeicon) == {}} {if {[lsearch [image names] nodeFolder] == -1} {if {[lsearch [image types] pixmap] != -1} {image create pixmap nodeFolder -data {/* XPM */static char *dir_node[] = {"16 16 3 1",". c grey85 m white g4 grey90","b c black m black g4 black","y c yellow m white g4 grey80","................","................","................","...bbbbbbbbbbb..","..bybyyyyyyyyb..",".byybyyyyyyyyb..","byyybyyyyyyyyb..","bbbbbyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","byyyyyyyyyyyyb..","bbbbbbbbbbbbbb..","................","................","................"};}} else {image create bitmap nodeFolder -data {#define node_width 16#define node_height 16static char node_bits[] = {0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40,0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40,0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};}}set itk_option(-nodeicon) nodeFolder}} else {if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {error "bad nodeicon option \"$itk_option(-nodeicon)\":\should be an existing image"}}}# ------------------------------------------------------------------# OPTION: -width## Specifies the width of the hierarchy widget as an entire unit.# The value may be specified in any of the forms acceptable to# Tk_GetPixels. Any additional space needed to display the other# components such as labels, margins, and scrollbars force the text# to be compressed. A value of zero along with the same value for# the height causes the value given for the visibleitems option# to be applied which administers geometry constraints in a different# manner.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::width {if {$itk_option(-width) != 0} {set shell [lindex [grid info $itk_component(clipper)] 1]## Due to a bug in the tk4.2 grid, we have to check the# propagation before setting it. Setting it to the same# value it already is will cause it to toggle.#if {[grid propagate $shell]} {grid propagate $shell no}$itk_component(list) configure -width 1$shell configure \-width [winfo pixels $shell $itk_option(-width)]} else {configure -visibleitems $itk_option(-visibleitems)}}# ------------------------------------------------------------------# OPTION: -height## Specifies the height of the hierarchy widget as an entire unit.# The value may be specified in any of the forms acceptable to# Tk_GetPixels. Any additional space needed to display the other# components such as labels, margins, and scrollbars force the text# to be compressed. A value of zero along with the same value for# the width causes the value given for the visibleitems option# to be applied which administers geometry constraints in a different# manner.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::height {if {$itk_option(-height) != 0} {set shell [lindex [grid info $itk_component(clipper)] 1]## Due to a bug in the tk4.2 grid, we have to check the# propagation before setting it. Setting it to the same# value it already is will cause it to toggle.#if {[grid propagate $shell]} {grid propagate $shell no}$itk_component(list) configure -height 1$shell configure \-height [winfo pixels $shell $itk_option(-height)]} else {configure -visibleitems $itk_option(-visibleitems)}}# ------------------------------------------------------------------# OPTION: -visibleitems## Specified the widthxheight in characters and lines for the text.# This option is only administered if the width and height options# are both set to zero, otherwise they take precedence. With the# visibleitems option engaged, geometry constraints are maintained# only on the text. The size of the other components such as# labels, margins, and scroll bars, are additive and independent,# effecting the overall size of the scrolled text. In contrast,# should the width and height options have non zero values, they# are applied to the scrolled text as a whole. The text is# compressed or expanded to maintain the geometry constraints.# ------------------------------------------------------------------configbody iwidgets::Hierarchy::visibleitems {if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {if {($itk_option(-width) == 0) && \($itk_option(-height) == 0)} {set chars [lindex [split $itk_option(-visibleitems) x] 0]set lines [lindex [split $itk_option(-visibleitems) x] 1]set shell [lindex [grid info $itk_component(clipper)] 1]## Due to a bug in the tk4.2 grid, we have to check the# propagation before setting it. Setting it to the same# value it already is will cause it to toggle.#if {! [grid propagate $shell]} {grid propagate $shell yes}$itk_component(list) configure -width $chars -height $lines}} else {error "bad visibleitems option\\"$itk_option(-visibleitems)\": should be\widthxheight"}}# ------------------------------------------------------------------# PUBLIC METHODS# ------------------------------------------------------------------# ----------------------------------------------------------------------# PUBLIC METHOD: clear## Removes all items from the display including all tags and icons.# The display will remain empty until the -filter or -querycommand# options are set.# ----------------------------------------------------------------------body iwidgets::Hierarchy::clear {} {$itk_component(list) configure -state normal -cursor watch$itk_component(list) delete 1.0 end$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)catch {unset _nodes}catch {unset _text}catch {unset _tags}catch {unset _icons}catch {unset _states}catch {unset _images}catch {unset _indents}return}# ----------------------------------------------------------------------# PUBLIC METHOD: selection option ?uid uid...?## Handles all operations controlling selections in the hierarchy.# Selections may be cleared, added, removed, or queried. The add and# remove options accept a series of unique ids.# ----------------------------------------------------------------------body iwidgets::Hierarchy::selection {op args} {switch -- $op {clear {$itk_component(list) tag remove hilite 1.0 endcatch {unset _selected}return}add {foreach node $args {set _selected($node) 1catch {$itk_component(list) tag add hilite \"$node.first" "$node.last"}}}remove {foreach node $args {catch {unset _selected($node)$itk_component(list) tag remove hilite \"$node.first" "$node.last"}}}get {return [array names _selected]}default {error "bad selection operation \"$op\":\should be add, remove, clear or get"}}}# ----------------------------------------------------------------------# PUBLIC METHOD: mark option ?arg arg...?## Handles all operations controlling marks in the hierarchy. Marks may# be cleared, added, removed, or queried. The add and remove options# accept a series of unique ids.# ----------------------------------------------------------------------body iwidgets::Hierarchy::mark {op args} {switch -- $op {clear {$itk_component(list) tag remove lowlite 1.0 endcatch {unset _marked}return}add {foreach node $args {set _marked($node) 1catch {$itk_component(list) tag add lowlite \"$node.first" "$node.last"}}}remove {foreach node $args {catch {unset _marked($node)$itk_component(list) tag remove lowlite \"$node.first" "$node.last"}}}get {return [array names _marked]}default {error "bad mark operation \"$op\":\should be add, remove, clear or get"}}}# ----------------------------------------------------------------------# PUBLIC METHOD: current## Returns the node that was most recently selected by the right mouse# button when the item menu was posted. Usually used by the code# in the item menu to figure out what item is being manipulated.# ----------------------------------------------------------------------body iwidgets::Hierarchy::current {} {return $_posted}# ----------------------------------------------------------------------# PUBLIC METHOD: expand node## Expands the hierarchy beneath the specified node. Since this can take# a moment for large hierarchies, the cursor will be changed to a watch# during the expansion.# ----------------------------------------------------------------------body iwidgets::Hierarchy::expand {node} {if {! [info exists _states($node)]} {error "bad expand node argument: \"$node\", the node doesn't exist"}if {!$_states($node) && \(([lsearch $_tags($node) branch] != -1) || \([llength [_contents $node]] > 0))} {$itk_component(list) configure -state normal -cursor watchupdate## Get the indentation level for the node.#set indent $_indents($node)set _markers ""$itk_component(list) mark set insert "$node:start"_drawLevel $node $indent## Following the draw, all our markers need adjusting.#foreach {name index} $_markers {$itk_component(list) mark set $name $index}## Set the image to be the open icon, denote the new state,# and set the cursor back to normal along with the state.#$_images($node) configure -image $itk_option(-openicon)set _states($node) 1$itk_component(list) configure -state disabled \-cursor $itk_option(-cursor)}}# ----------------------------------------------------------------------# PUBLIC METHOD: collapse node## Collapses the hierarchy beneath the specified node. Since this can# take a moment for large hierarchies, the cursor will be changed to a# watch during the expansion.# ----------------------------------------------------------------------body iwidgets::Hierarchy::collapse {node} {if {! [info exists _states($node)]} {error "bad collapse node argument: \"$node\", the node doesn't exist"}if {[info exists _states($node)] && $_states($node) && \(([lsearch $_tags($node) branch] != -1) || \([llength [_contents $node]] > 0))} {$itk_component(list) configure -state normal -cursor watchupdate_deselectSubNodes $node$itk_component(list) delete "$node:start" "$node:end"catch {$_images($node) configure -image $itk_option(-closedicon)}set _states($node) 0$itk_component(list) configure -state disabled \-cursor $itk_option(-cursor)}}# ----------------------------------------------------------------------# PUBLIC METHOD: toggle node## Toggles the hierarchy beneath the specified node. If the hierarchy# is currently expanded, then it is collapsed, and vice-versa.# ----------------------------------------------------------------------body iwidgets::Hierarchy::toggle {node} {if {! [info exists _states($node)]} {error "bad toggle node argument: \"$node\", the node doesn't exist"}if {$_states($node)} {collapse $node} else {expand $node}}# ----------------------------------------------------------------------# PUBLIC METHOD: prune node## Removes a particular node from the hierarchy.# ----------------------------------------------------------------------body iwidgets::Hierarchy::prune {node} {## While we're working, change the state and cursor so we can# edit the text and give a busy visual clue.#$itk_component(list) configure -state normal -cursor watch## Recursively delete all the subnode information from our internal# arrays and remove all the tags.#_deleteNodeInfo $node## If the mark $node:end exists then the node has decendents so# so we'll remove from the mark $node:start to $node:end in order# to delete all the subnodes below it in the text.#if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {$itk_component(list) delete $node:start $node:end$itk_component(list) mark unset $node:end}## Next we need to remove the node itself. Using the ranges for# its tag we'll remove it from line start to the end plus one# character which takes us to the start of the next node.#foreach {start end} [$itk_component(list) tag ranges $node] {$itk_component(list) delete "$start linestart" "$end + 1 char"}## Delete the tag for this node.#$itk_component(list) tag delete $node## The node must be removed from the list of subnodes for its parent.# We don't really have a clean way to do upwards referencing, so# the dirty way will have to do. We'll cycle through each node# and if this node is in its list of subnodes, we'll remove it.#foreach uid [array names _nodes] {if {[set index [lsearch $_nodes($uid) $node]] != -1} {set _nodes($uid) [lreplace $_nodes($uid) $index $index]}}## We're done, so change the state and cursor back to their# original values.#$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)}# ----------------------------------------------------------------------# PUBLIC METHOD: draw ?when?## Performs a complete draw of the entire hierarchy.# ----------------------------------------------------------------------body iwidgets::Hierarchy::draw {{when -now}} {if {$when == "-eventually"} {if {$_pending == ""} {set _pending [after idle [code $this draw -now]]}return} elseif {$when != "-now"} {error "bad when option \"$when\": should be -eventually or -now"}$itk_component(list) configure -state normal -cursor watchupdate$itk_component(list) delete 1.0 endcatch {unset _images}set _markers ""_drawLevel "" ""foreach {name index} $_markers {$itk_component(list) mark set $name $index}$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)set _pending ""}# ----------------------------------------------------------------------# PUBLIC METHOD: refresh node## Performs a redraw of a specific node. If that node is currently# not visible, then no action is taken.# ----------------------------------------------------------------------body iwidgets::Hierarchy::refresh {node} {if {! [info exists _nodes($node)]} {error "bad refresh node argument: \"$node\", the node doesn't exist"}if {! $_states($node)} {return}foreach parent [_getHeritage $node] {if {! $_states($parent)} {return}}$itk_component(list) configure -state normal -cursor watch$itk_component(list) delete $node:start $node:endset _markers ""$itk_component(list) mark set insert "$node:start"set indent $_indents($node)_drawLevel $node $indentforeach {name index} $_markers {$itk_component(list) mark set $name $index}$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)}# ------------------------------------------------------------------# THIN WRAPPED TEXT METHODS:## The following methods are thin wraps of standard text methods.# Consult the Tk text man pages for functionallity and argument# documentation.# ------------------------------------------------------------------# ------------------------------------------------------------------# PUBLIC METHOD: bbox index## Returns four element list describing the bounding box for the list# item at index# ------------------------------------------------------------------body iwidgets::Hierarchy::bbox {index} {return [$itk_component(list) bbox $index]}# ------------------------------------------------------------------# PUBLIC METHOD compare index1 op index2## Compare indices according to relational operator.# ------------------------------------------------------------------body iwidgets::Hierarchy::compare {index1 op index2} {return [$itk_component(list) compare $index1 $op $index2]}# ------------------------------------------------------------------# PUBLIC METHOD delete first ?last?## Delete a range of characters from the text.# ------------------------------------------------------------------body iwidgets::Hierarchy::delete {first {last {}}} {$itk_component(list) configure -state normal -cursor watch$itk_component(list) delete $first $last$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)}# ------------------------------------------------------------------# PUBLIC METHOD dump ?switches? index1 ?index2?## Returns information about the contents of the text widget from# index1 to index2.# ------------------------------------------------------------------body iwidgets::Hierarchy::dump {args} {return [eval $itk_component(list) dump $args]}# ------------------------------------------------------------------# PUBLIC METHOD dlineinfo index## Returns a five element list describing the area occupied by the# display line containing index.# ------------------------------------------------------------------body iwidgets::Hierarchy::dlineinfo {index} {return [$itk_component(list) dlineinfo $index]}# ------------------------------------------------------------------# PUBLIC METHOD get index1 ?index2?## Return text from start index to end index.# ------------------------------------------------------------------body iwidgets::Hierarchy::get {index1 {index2 {}}} {return [$itk_component(list) get $index1 $index2]}# ------------------------------------------------------------------# PUBLIC METHOD index index## Return position corresponding to index.# ------------------------------------------------------------------body iwidgets::Hierarchy::index {index} {return [$itk_component(list) index $index]}# ------------------------------------------------------------------# PUBLIC METHOD insert index chars ?tagList?## Insert text at index.# ------------------------------------------------------------------body iwidgets::Hierarchy::insert {args} {$itk_component(list) configure -state normal -cursor watcheval $itk_component(list) insert $args$itk_component(list) configure -state disabled -cursor $itk_option(-cursor)}# ------------------------------------------------------------------# PUBLIC METHOD scan option args## Implements scanning on texts.# ------------------------------------------------------------------body iwidgets::Hierarchy::scan {option args} {eval $itk_component(list) scan $option $args}# ------------------------------------------------------------------# PUBLIC METHOD search ?switches? pattern index ?varName?## Searches the text for characters matching a pattern.# ------------------------------------------------------------------body iwidgets::Hierarchy::search {args} {return [eval $itk_component(list) search $args]}# ------------------------------------------------------------------# PUBLIC METHOD see index## Adjusts the view in the window so the character at index is# visible.# ------------------------------------------------------------------body iwidgets::Hierarchy::see {index} {$itk_component(list) see $index}# ------------------------------------------------------------------# PUBLIC METHOD tag option ?arg arg ...?## Manipulate tags dependent on options.# ------------------------------------------------------------------body iwidgets::Hierarchy::tag {op args} {return [eval $itk_component(list) tag $op $args]}# ------------------------------------------------------------------# PUBLIC METHOD window option ?arg arg ...?## Manipulate embedded windows.# ------------------------------------------------------------------body iwidgets::Hierarchy::window {option args} {return [eval $itk_component(list) window $option $args]}# ----------------------------------------------------------------------# PUBLIC METHOD: xview args## Thin wrap of the text widget's xview command.# ----------------------------------------------------------------------body iwidgets::Hierarchy::xview {args} {return [eval itk_component(list) xview $args]}# ----------------------------------------------------------------------# PUBLIC METHOD: yview args## Thin wrap of the text widget's yview command.# ----------------------------------------------------------------------body iwidgets::Hierarchy::yview {args} {return [eval $itk_component(list) yview $args]}# ------------------------------------------------------------------# PROTECTED METHODS# ------------------------------------------------------------------# ----------------------------------------------------------------------# PROTECTED METHOD: _drawLevel node indent## Used internally by draw to draw one level of the hierarchy.# Draws all of the nodes under node, using the indent string to# indent nodes.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_drawLevel {node indent} {lappend _markers "$node:start" [$itk_component(list) index insert]set bg [$itk_component(list) cget -background]## Obtain the list of subnodes for this node and cycle through# each one displaying it in the hierarchy.#foreach child [_contents $node] {set _images($child) "$itk_component(list).hicon[incr _hcounter]"if {![info exists _states($child)]} {set _states($child) $itk_option(-expanded)}## Check the user tags to see if they have been kind enough# to tell us ahead of time what type of node we are dealing# with branch or leaf. If they neglected to do so, then# get the contents of the child node to see if it has children# itself.#set display 0if {[lsearch $_tags($child) leaf] != -1} {set type leaf} elseif {[lsearch $_tags($child) branch] != -1} {set type branch} else {if {[llength [_contents $child]] == 0} {set type leaf} else {set type branch}}## Now that we know the type of node, branch or leaf, we know# the type of icon to use.#if {$type == "leaf"} {set icon $itk_option(-nodeicon)eval $_filterCode} else {if {$_states($child)} {set icon $itk_option(-openicon)} else {set icon $itk_option(-closedicon)}set display 1}## If display is set then we're going to be drawing this node.# Save off the indentation level for this node and do the indent.#if {$display} {set _indents($child) "$indent\t"$itk_component(list) insert insert $indent## Add the branch or leaf icon and setup a binding to toggle# its expanded/collapsed state.#label $_images($child) -image $icon -background $bgbind $_images($child) <ButtonPress-1> [code $this toggle $child]$itk_component(list) window create insert -window $_images($child)## If any user icons exist then draw them as well. The little# regexp is just to check and see if they've passed in a# command which needs to be evaluated as opposed to just# a variable. Also, attach a binding to call them if their# icon is selected.#if {[info exists _icons($child)]} {foreach image $_icons($child) {set wid "$itk_component(list).uicon[incr _ucounter]"if {[regexp {\[.*\]} $image]} {eval label $wid -image $image -background $bg} else {label $wid -image $image -background $bg}bind $wid <ButtonPress-1> \[code $this _iconSelect $child $image]$itk_component(list) window create insert -window $wid}}## Create the list of tags to be applied to the text. Start# out with a tag of "info" and append "hilite" if the node# is currently selected, finally add the tags given by the# user.#set texttags [list "info" $child]if {[info exists _selected($child)]} {lappend texttags hilite}foreach tag $_tags($child) {lappend texttags $tag}## Insert the text for the node along with the tags and# append to the markers the start of this node. The text# has been broken at newlines into a list. We'll make sure# that each line is at the same indentation position.#set firstline 1foreach line $_text($child) {if {$firstline} {$itk_component(list) insert insert " "} else {$itk_component(list) insert insert "$indent\t"}$itk_component(list) insert insert $line $texttags "\n"set firstline 0}lappend _markers "$child:start" [$itk_component(list) index insert]## If the state of the node is open, proceed to draw the next# node below it in the hierarchy.#if {$_states($child)} {_drawLevel $child "$indent\t"}}}lappend _markers "$node:end" [$itk_component(list) index insert]}# ----------------------------------------------------------------------# PROTECTED METHOD: _contents uid## Used internally to get the contents of a particular node. If this# is the first time the node has been seen or the -alwaysquery# option is set, the -querycommand code is executed to query the node# list, and the list is stored until the next time it is needed.## The querycommand may return not only the list of subnodes for the# node but additional information on the tags and icons to be used.# The return value must be parsed based on the number of elements in# the list where the format is a list of lists:## {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}# ----------------------------------------------------------------------body iwidgets::Hierarchy::_contents {uid} {if {! $itk_option(-alwaysquery) && [info exists _nodes($uid)]} {return $_nodes($uid)}## Substitute any %n's for the node name whose children we're# interested in obtaining.#set cmd $itk_option(-querycommand)regsub -all {%n} $cmd [list $uid] cmdset nodeinfolist [uplevel \#0 $cmd]## Cycle through the node information returned by the query# command determining if additional information such as text,# user tags, or user icons have been provided. For text,# break it into a list at any newline characters.#set _nodes($uid) {}foreach nodeinfo $nodeinfolist {set subnodeuid [lindex $nodeinfo 0]lappend _nodes($uid) $subnodeuidset llen [llength $nodeinfo]if {$llen == 0 || $llen > 4} {error "invalid number of elements returned by query\command for node: \"$uid\",\should be uid \[text \[tags \[icons\]\]\]"}if {$llen == 1} {set _text($subnodeuid) [split $subnodeuid \n]}if {$llen > 1} {set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]}if {$llen > 2} {set _tags($subnodeuid) [lindex $nodeinfo 2]} else {set _tags($subnodeuid) unknown}if {$llen > 3} {set _icons($subnodeuid) [lindex $nodeinfo 3]}}## Return the list of nodes.#return $_nodes($uid)}# ----------------------------------------------------------------------# PROTECTED METHOD: _post x y## Used internally to post the popup menu at the coordinate (x,y)# relative to the widget. If (x,y) is on an item, then the itemMenu# component is posted. Otherwise, the bgMenu is posted.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_post {x y} {set rx [expr [winfo rootx $itk_component(list)]+$x]set ry [expr [winfo rooty $itk_component(list)]+$y]set index [$itk_component(list) index @$x,$y]## The posted variable will hold the list of tags which exist at# this x,y position that will be passed back to the user. They# don't need to know about our internal tags, info, hilite, and# lowlite, so remove them from the list.#set _posted {}foreach tag [$itk_component(list) tag names $index] {if {![_isInternalTag $tag]} {lappend _posted $tag}}## If we have tags then do the popup at this position.#if {$_posted != {}} {tk_popup $itk_component(itemMenu) $rx $ry} else {tk_popup $itk_component(bgMenu) $rx $ry}}# ----------------------------------------------------------------------# PROTECTED METHOD: _select x y## Used internally to select an item at the coordinate (x,y) relative# to the widget. The command associated with the -selectcommand# option is execute following % character substitutions. If %n# appears in the command, the selected node is substituted. If %s# appears, a boolean value representing the current selection state# will be substituted.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_select {x y} {if {$itk_option(-selectcommand) != {}} {if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {foreach tag $seltags {if {![_isInternalTag $tag]} {lappend node $tag}}if {[lsearch $seltags "hilite"] == -1} {set selectstatus 0} else {set selectstatus 1}set cmd $itk_option(-selectcommand)regsub -all {%n} $cmd [list $node] cmdregsub -all {%s} $cmd [list $selectstatus] cmduplevel #0 $cmd}}return}# ----------------------------------------------------------------------# PROTECTED METHOD: _iconSelect node icon## Used internally to upon selection of user icons. The -iconcommand# is executed after substitution of the node for %n and icon for %i.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_iconSelect {node icon} {set cmd $itk_option(-iconcommand)regsub -all {%n} $cmd [list $node] cmdregsub -all {%i} $cmd [list $icon] cmduplevel \#0 $cmdreturn {}}# ----------------------------------------------------------------------# PROTECTED METHOD: _deselectSubNodes uid## Used internally to recursively deselect all the nodes beneath a# particular node.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_deselectSubNodes {uid} {foreach node $_nodes($uid) {if {[array names _selected $node] != {}} {unset _selected($node)}if {[array names _nodes $node] != {}} {_deselectSubNodes $node}}}# ----------------------------------------------------------------------# PROTECTED METHOD: _deleteNodeInfo uid## Used internally to recursively delete all the information about a# node and its decendents.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_deleteNodeInfo {uid} {## Recursively call ourseleves as we go down the hierarchy beneath# this node.#if {[info exists _nodes($uid)]} {foreach node $_nodes($uid) {if {[array names _nodes $node] != {}} {_deleteNodeInfo $node}}}## Unset any entries in our arrays for the node.#catch {unset _nodes($uid)}catch {unset _text($uid)}catch {unset _tags($uid)}catch {unset _icons($uid)}catch {unset _states($uid)}catch {unset _images($uid)}catch {unset _indents($uid)}}# ----------------------------------------------------------------------# PROTECTED METHOD: _getParent uid## Used internally to determine the parent for a node.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_getParent {uid} {foreach node [array names _nodes] {if {[set index [lsearch $_nodes($node) $uid]] != -1} {return $node}}}# ----------------------------------------------------------------------# PROTECTED METHOD: _getHeritage uid## Used internally to determine the list of parents for a node.# ----------------------------------------------------------------------body iwidgets::Hierarchy::_getHeritage {uid} {set parents {}if {[set parent [_getParent $uid]] != {}} {lappend parents $parent}return $parents}# ----------------------------------------------------------------------# PROTECTED METHOD (could be proc?): _isInternalTag tag## Used internally to tags not to used for user callback commands# ----------------------------------------------------------------------body iwidgets::Hierarchy::_isInternalTag {tag} {set ii [expr [lsearch -exact {info hilite lowlite unknown} $tag] != -1];return $ii;}
Go to most recent revision | Compare with Previous | Blame | View Log