home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / hierarchy.itk < prev    next >
Text File  |  2003-09-01  |  67KB  |  1,984 lines
  1. # Hierarchy
  2. # ----------------------------------------------------------------------
  3. # Hierarchical data viewer.  Manages a list of nodes that can be
  4. # expanded or collapsed.  Individual nodes can be highlighted.
  5. # Clicking with the right mouse button on any item brings up a
  6. # special item menu.  Clicking on the background area brings up
  7. # a different popup menu.
  8. # ----------------------------------------------------------------------
  9. #   AUTHOR:  Michael J. McLennan
  10. #            Bell Labs Innovations for Lucent Technologies
  11. #            mmclennan@lucent.com
  12. #
  13. #            Mark L. Ulferts
  14. #            DSC Communications
  15. #            mulferts@austin.dsccc.com
  16. #
  17. #      RCS:  $Id: hierarchy.itk,v 1.9 2002/09/06 16:27:03 smithc Exp $
  18. # ----------------------------------------------------------------------
  19. #                Copyright (c) 1996  Lucent Technologies
  20. # ======================================================================
  21. # Permission to use, copy, modify, and distribute this software and its
  22. # documentation for any purpose and without fee is hereby granted,
  23. # provided that the above copyright notice appear in all copies and that
  24. # both that the copyright notice and warranty disclaimer appear in
  25. # supporting documentation, and that the names of Lucent Technologies
  26. # any of their entities not be used in advertising or publicity
  27. # pertaining to distribution of the software without specific, written
  28. # prior permission.
  29. #
  30. # Lucent Technologies disclaims all warranties with regard to this
  31. # software, including all implied warranties of merchantability and
  32. # fitness.  In no event shall Lucent Technologies be liable for any
  33. # special, indirect or consequential damages or any damages whatsoever
  34. # resulting from loss of use, data or profits, whether in an action of
  35. # contract, negligence or other tortuous action, arising out of or in
  36. # connection with the use or performance of this software.
  37. #
  38. # ----------------------------------------------------------------------
  39. #            Copyright (c) 1996 DSC Technologies Corporation
  40. # ======================================================================
  41. # Permission to use, copy, modify, distribute and license this software 
  42. # and its documentation for any purpose, and without fee or written 
  43. # agreement with DSC, is hereby granted, provided that the above copyright 
  44. # notice appears in all copies and that both the copyright notice and 
  45. # warranty disclaimer below appear in supporting documentation, and that 
  46. # the names of DSC Technologies Corporation or DSC Communications 
  47. # Corporation not be used in advertising or publicity pertaining to the 
  48. # software without specific, written prior permission.
  49. # 
  50. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  51. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  52. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  53. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  54. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  55. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  56. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  57. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  58. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  59. # SOFTWARE.
  60. # ======================================================================
  61.  
  62. #
  63. # Usual options.
  64. #
  65. itk::usual Hierarchy {
  66.     keep -cursor -textfont -font
  67.     keep -background -foreground -textbackground 
  68.     keep -selectbackground -selectforeground 
  69. }
  70.  
  71. # ------------------------------------------------------------------
  72. #                            HIERARCHY
  73. # ------------------------------------------------------------------
  74. itcl::class iwidgets::Hierarchy {
  75.     inherit iwidgets::Scrolledwidget
  76.  
  77.     constructor {args} {}
  78.  
  79.     destructor {}
  80.  
  81.     itk_option define -alwaysquery alwaysQuery AlwaysQuery 0
  82.     itk_option define -closedicon closedIcon Icon {}
  83.     itk_option define -dblclickcommand dblClickCommand Command {}
  84.     itk_option define -expanded expanded Expanded 0 
  85.     itk_option define -filter filter Filter 0 
  86.     itk_option define -font font Font \
  87.     -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 
  88.     itk_option define -height height Height 0
  89.     itk_option define -iconcommand iconCommand Command {}
  90.     itk_option define -icondblcommand iconDblCommand Command {}
  91.     itk_option define -imagecommand imageCommand Command {}
  92.     itk_option define -imagedblcommand imageDblCommand Command {}
  93.     itk_option define -imagemenuloadcommand imageMenuLoadCommand Command {}
  94.     itk_option define -markbackground markBackground Foreground #a0a0a0 
  95.     itk_option define -markforeground markForeground Background Black 
  96.     itk_option define -nodeicon nodeIcon Icon {}
  97.     itk_option define -openicon openIcon Icon {}
  98.     itk_option define -querycommand queryCommand Command {}
  99.     itk_option define -selectcommand selectCommand Command {}
  100.     itk_option define -selectbackground selectBackground Foreground #c3c3c3 
  101.     itk_option define -selectforeground selectForeground Background Black 
  102.     itk_option define -textmenuloadcommand textMenuLoadCommand Command {}
  103.     itk_option define -visibleitems visibleItems VisibleItems 80x24
  104.     itk_option define -width width Width 0
  105.  
  106.     public {
  107.     method clear {}
  108.     method collapse {node}
  109.     method current {}
  110.     method draw {{when -now}}
  111.     method expand {node}
  112.     method expanded {node}
  113.     method expState { }
  114.     method mark {op args}
  115.     method prune {node}
  116.     method refresh {node}
  117.     method selection {op args}
  118.     method toggle {node}
  119.     
  120.     method bbox {index} 
  121.     method compare {index1 op index2} 
  122.     method debug {args} {eval $args}
  123.     method delete {first {last {}}} 
  124.     method dlineinfo {index} 
  125.     method dump {args}
  126.     method get {index1 {index2 {}}} 
  127.     method index {index} 
  128.     method insert {args} 
  129.     method scan {option args} 
  130.     method search {args} 
  131.     method see {index} 
  132.     method tag {op args} 
  133.     method window {option args} 
  134.     method xview {args}
  135.     method yview {args}
  136.     }
  137.  
  138.     protected {
  139.     method _contents {uid}
  140.     method _post {x y}
  141.     method _drawLevel {node indent}
  142.     method _select {x y}
  143.     method _deselectSubNodes {uid}
  144.     method _deleteNodeInfo {uid}
  145.     method _getParent {uid}
  146.     method _getHeritage {uid}
  147.     method _isInternalTag {tag}
  148.     method _iconSelect {node icon}
  149.     method _iconDblSelect {node icon}
  150.     method _imageSelect {node}
  151.     method _imageDblClick {node}
  152.     method _imagePost {node image type x y}
  153.     method _double {x y}
  154.     }
  155.     
  156.     private {
  157.         method _configureTags {}
  158.  
  159.     variable _filterCode ""  ;# Compact view flag.
  160.     variable _hcounter 0     ;# Counter for hierarchy icons
  161.     variable _icons          ;# Array of user icons by uid
  162.     variable _images         ;# Array of our icons by uid
  163.     variable _indents        ;# Array of indentation by uid
  164.     variable _marked         ;# Array of marked nodes by uid
  165.     variable _markers ""     ;# List of markers for level being drawn
  166.     variable _nodes          ;# Array of subnodes by uid
  167.     variable _pending ""     ;# Pending draw flag
  168.     variable _posted ""      ;# List of tags at posted menu position
  169.     variable _selected       ;# Array of selected nodes by uid
  170.     variable _tags           ;# Array of user tags by uid
  171.     variable _text           ;# Array of displayed text by uid
  172.     variable _states         ;# Array of selection state by uid
  173.     variable _ucounter 0     ;# Counter for user icons
  174.     }
  175. }
  176.  
  177. #
  178. # Provide a lowercased access method for the Hierarchy class.
  179. # 
  180. proc ::iwidgets::hierarchy {pathName args} {
  181.     uplevel ::iwidgets::Hierarchy $pathName $args
  182. }
  183.  
  184. #
  185. # Use option database to override default resources of base classes.
  186. #
  187. option add *Hierarchy.menuCursor arrow widgetDefault
  188. option add *Hierarchy.labelPos n widgetDefault
  189. option add *Hierarchy.tabs 30 widgetDefault
  190.  
  191. # ------------------------------------------------------------------
  192. #                        CONSTRUCTOR
  193. # ------------------------------------------------------------------
  194. itcl::body iwidgets::Hierarchy::constructor {args} {
  195.     itk_option remove iwidgets::Labeledwidget::state
  196.  
  197.     #
  198.     # Our -width and -height options are slightly different than
  199.     # those implemented by our base class, so we're going to
  200.     # remove them and redefine our own.
  201.     #
  202.     itk_option remove iwidgets::Scrolledwidget::width
  203.     itk_option remove iwidgets::Scrolledwidget::height
  204.  
  205.     #
  206.     # Create a clipping frame which will provide the border for
  207.     # relief display.
  208.     #
  209.     itk_component add clipper {
  210.     frame $itk_interior.clipper
  211.     } {
  212.     usual
  213.  
  214.     keep -borderwidth -relief -highlightthickness -highlightcolor
  215.     rename -highlightbackground -background background Background
  216.     }    
  217.     grid $itk_component(clipper) -row 0 -column 0 -sticky nsew
  218.     grid rowconfigure $_interior 0 -weight 1
  219.     grid columnconfigure $_interior 0 -weight 1
  220.  
  221.     #
  222.     # Create a text widget for displaying our hierarchy.
  223.     #
  224.     itk_component add list {
  225.     text $itk_component(clipper).list -wrap none -cursor center_ptr \
  226.                 -state disabled -width 1 -height 1 \
  227.             -xscrollcommand \
  228.         [itcl::code $this _scrollWidget $itk_interior.horizsb] \
  229.         -yscrollcommand \
  230.         [itcl::code $this _scrollWidget $itk_interior.vertsb] \
  231.             -borderwidth 0 -highlightthickness 0
  232.     } {
  233.     usual
  234.  
  235.     keep -spacing1 -spacing2 -spacing3 -tabs
  236.     rename -font -textfont textFont Font
  237.     rename -background -textbackground textBackground Background
  238.     ignore -highlightthickness -highlightcolor
  239.     ignore -insertbackground -insertborderwidth
  240.     ignore -insertontime -insertofftime -insertwidth
  241.     ignore -selectborderwidth
  242.     ignore -borderwidth
  243.     }
  244.     grid $itk_component(list) -row 0 -column 0 -sticky nsew
  245.     grid rowconfigure $itk_component(clipper) 0 -weight 1
  246.     grid columnconfigure $itk_component(clipper) 0 -weight 1
  247.     
  248.     # 
  249.     # Configure the command on the vertical scroll bar in the base class.
  250.     #
  251.     $itk_component(vertsb) configure \
  252.     -command [itcl::code $itk_component(list) yview]
  253.  
  254.     #
  255.     # Configure the command on the horizontal scroll bar in the base class.
  256.     #
  257.     $itk_component(horizsb) configure \
  258.         -command [itcl::code $itk_component(list) xview]
  259.     
  260.     #
  261.     # Configure our text component's tab settings for twenty levels.
  262.     #
  263.     set tabs ""
  264.     for {set i 1} {$i < 20} {incr i} {
  265.     lappend tabs [expr {$i*12+4}]
  266.     }
  267.     $itk_component(list) configure -tabs $tabs
  268.  
  269.     #
  270.     # Add popup menus that can be configured by the user to add
  271.     # new functionality.
  272.     #
  273.     itk_component add itemMenu {
  274.     menu $itk_component(list).itemmenu -tearoff 0
  275.     } {
  276.     usual
  277.     ignore -tearoff
  278.     rename -cursor -menucursor menuCursor Cursor
  279.     }
  280.  
  281.     itk_component add bgMenu {
  282.     menu $itk_component(list).bgmenu -tearoff 0
  283.     } {
  284.     usual
  285.     ignore -tearoff
  286.     rename -cursor -menucursor menuCursor Cursor
  287.     }
  288.  
  289.     #
  290.     # Adjust the bind tags to remove the class bindings.  Also, add
  291.     # bindings for mouse button 1 to do selection and button 3 to 
  292.     # display a popup.
  293.     #
  294.     bindtags $itk_component(list) [list $itk_component(list) . all]
  295.     
  296.     bind $itk_component(list) <ButtonPress-1> \
  297.             [itcl::code $this _select %x %y]
  298.  
  299.     bind $itk_component(list) <Double-1> \
  300.             [itcl::code $this _double %x %y]
  301.  
  302.     bind $itk_component(list) <ButtonPress-3> \
  303.             [itcl::code $this _post %x %y]
  304.     
  305.     #
  306.     # Initialize the widget based on the command line options.
  307.     #
  308.     eval itk_initialize $args
  309. }
  310.  
  311. # ------------------------------------------------------------------
  312. #                           DESTRUCTOR
  313. # ------------------------------------------------------------------
  314. itcl::body iwidgets::Hierarchy::destructor {} {
  315.     if {$_pending != ""} {
  316.     after cancel $_pending
  317.     }
  318. }
  319.  
  320. # ------------------------------------------------------------------
  321. #                             OPTIONS
  322. # ------------------------------------------------------------------
  323.  
  324. # ------------------------------------------------------------------
  325. # OPTION: -font
  326. #
  327. # Font used for text in the list.
  328. # ------------------------------------------------------------------
  329. itcl::configbody iwidgets::Hierarchy::font {
  330.     $itk_component(list) tag configure info \
  331.             -font $itk_option(-font) -spacing1 6
  332. }
  333.  
  334. # ------------------------------------------------------------------
  335. # OPTION: -selectbackground
  336. #
  337. # Background color scheme for selected nodes.
  338. # ------------------------------------------------------------------
  339. itcl::configbody iwidgets::Hierarchy::selectbackground {
  340.     $itk_component(list) tag configure hilite \
  341.             -background $itk_option(-selectbackground)
  342. }
  343.  
  344. # ------------------------------------------------------------------
  345. # OPTION: -selectforeground
  346. #
  347. # Foreground color scheme for selected nodes.
  348. # ------------------------------------------------------------------
  349. itcl::configbody iwidgets::Hierarchy::selectforeground {
  350.     $itk_component(list) tag configure hilite \
  351.             -foreground $itk_option(-selectforeground)
  352. }
  353.  
  354. # ------------------------------------------------------------------
  355. # OPTION: -markbackground
  356. #
  357. # Background color scheme for marked nodes.
  358. # ------------------------------------------------------------------
  359. itcl::configbody iwidgets::Hierarchy::markbackground {
  360.     $itk_component(list) tag configure lowlite \
  361.             -background $itk_option(-markbackground)
  362. }
  363.  
  364. # ------------------------------------------------------------------
  365. # OPTION: -markforeground
  366. #
  367. # Foreground color scheme for marked nodes.
  368. # ------------------------------------------------------------------
  369. itcl::configbody iwidgets::Hierarchy::markforeground {
  370.     $itk_component(list) tag configure lowlite \
  371.             -foreground $itk_option(-markforeground)
  372. }
  373.  
  374. # ------------------------------------------------------------------
  375. # OPTION: -querycommand
  376. #
  377. # Command executed to query the contents of each node.  If this 
  378. # command contains "%n", it is replaced with the name of the desired 
  379. # node.  In its simpilest form it should return the children of the 
  380. # given node as a list which will be depicted in the display.
  381. #
  382. # Since the names of the children are used as tags in the underlying 
  383. # text widget, each child must be unique in the hierarchy.  Due to
  384. # the unique requirement, the nodes shall be reffered to as uids 
  385. # or uid in the singular sense.
  386. # 
  387. #   {uid [uid ...]}
  388. #
  389. #   where uid is a unique id and primary key for the hierarchy entry
  390. #
  391. # Should the unique requirement pose a problem, the list returned
  392. # can take on another more extended form which enables the 
  393. # association of text to be displayed with the uids.  The uid must
  394. # still be unique, but the text does not have to obey the unique
  395. # rule.  In addition, the format also allows the specification of
  396. # additional tags to be used on the same entry in the hierarchy
  397. # as the uid and additional icons to be displayed just before
  398. # the node.  The tags and icons are considered to be the property of
  399. # the user in that the hierarchy widget will not depend on any of 
  400. # their values.
  401. #
  402. #   {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
  403. #
  404. #   where uid is a unique id and primary key for the hierarchy entry
  405. #         text is the text to be displayed for this uid
  406. #         tags is a list of user tags to be applied to the entry
  407. #         icons is a list of icons to be displayed in front of the text
  408. #
  409. # The hierarchy widget does a look ahead from each node to determine
  410. # if the node has a children.  This can be cost some performace with
  411. # large hierarchies.  User's can avoid this by providing a hint in
  412. # the user tags.  A tag of "leaf" or "branch" tells the hierarchy
  413. # widget the information it needs to know thereby avoiding the look
  414. # ahead operation.
  415. # ------------------------------------------------------------------
  416. itcl::configbody iwidgets::Hierarchy::querycommand {
  417.     clear
  418.     draw -eventually
  419.  
  420.     # Added for SF ticket #596111
  421.     _configureTags
  422. }
  423.  
  424. # ------------------------------------------------------------------
  425. # OPTION: -selectcommand
  426. #
  427. # Command executed to select an item in the list.  If this command
  428. # contains "%n", it is replaced with the name of the selected node.  
  429. # If it contains a "%s", it is replaced with a boolean indicator of 
  430. # the node's current selection status, where a value of 1 denotes
  431. # that the node is currently selected and 0 that it is not.
  432. # ------------------------------------------------------------------
  433. itcl::configbody iwidgets::Hierarchy::selectcommand {
  434. }
  435.  
  436. # ------------------------------------------------------------------
  437. # OPTION: -dblclickcommand
  438. #
  439. # Command executed to double click an item in the list.  If this command
  440. # contains "%n", it is replaced with the name of the selected node.  
  441. # If it contains a "%s", it is replaced with a boolean indicator of 
  442. # the node's current selection status, where a value of 1 denotes
  443. # that the node is currently selected and 0 that it is not.
  444. #
  445. # Douglas R. Howard, Jr.
  446. # ------------------------------------------------------------------
  447. itcl::configbody iwidgets::Hierarchy::dblclickcommand {
  448. }
  449.  
  450. # ------------------------------------------------------------------
  451. # OPTION: -iconcommand
  452. #
  453. # Command executed upon selection of user icons.  If this command 
  454. # contains "%n", it is replaced with the name of the node the icon
  455. # belongs to.  Should it contain "%i" then the icon name is 
  456. # substituted.
  457. # ------------------------------------------------------------------
  458. itcl::configbody iwidgets::Hierarchy::iconcommand {
  459. }
  460.  
  461. # ------------------------------------------------------------------
  462. # OPTION: -icondblcommand
  463. #
  464. # Command executed upon double selection of user icons.  If this command 
  465. # contains "%n", it is replaced with the name of the node the icon
  466. # belongs to.  Should it contain "%i" then the icon name is 
  467. # substituted.
  468. #
  469. # Douglas R. Howard, Jr.
  470. # ------------------------------------------------------------------
  471. itcl::configbody iwidgets::Hierarchy::icondblcommand {
  472. }
  473.  
  474. # ------------------------------------------------------------------
  475. # OPTION: -imagecommand
  476. #
  477. # Command executed upon selection of image icons.  If this command 
  478. # contains "%n", it is replaced with the name of the node the icon
  479. # belongs to.  Should it contain "%i" then the icon name is 
  480. # substituted.
  481. #
  482. # Douglas R. Howard, Jr.
  483. # ------------------------------------------------------------------
  484. itcl::configbody iwidgets::Hierarchy::imagecommand {
  485. }
  486.  
  487. # ------------------------------------------------------------------
  488. # OPTION: -imagedblcommand
  489. #
  490. # Command executed upon double selection of user icons.  If this command 
  491. # contains "%n", it is replaced with the name of the node the icon
  492. # belongs to.
  493. #
  494. # Douglas R. Howard, Jr.
  495. # ------------------------------------------------------------------
  496. itcl::configbody iwidgets::Hierarchy::imagedblcommand {
  497. }
  498.  
  499. # ------------------------------------------------------------------
  500. # OPTION: -alwaysquery
  501. #
  502. # Boolean flag which tells the hierarchy widget weather or not
  503. # each refresh of the display should be via a new query using
  504. # the -querycommand option or use the values previous found the
  505. # last time the query was made.
  506. # ------------------------------------------------------------------
  507. itcl::configbody iwidgets::Hierarchy::alwaysquery {
  508.     switch -- $itk_option(-alwaysquery) {
  509.         1 - true - yes - on {
  510.             ;# okay
  511.         }
  512.         0 - false - no - off {
  513.             ;# okay
  514.         }
  515.         default {
  516.             error "bad alwaysquery option \"$itk_option(-alwaysquery)\":\
  517.                     should be boolean"
  518.         }
  519.     }
  520. }
  521.  
  522. # ------------------------------------------------------------------
  523. # OPTION: -filter
  524. #
  525. # When true only the branch nodes and selected items are displayed.
  526. # This gives a compact view of important items.
  527. # ------------------------------------------------------------------
  528. itcl::configbody iwidgets::Hierarchy::filter {
  529.     switch -- $itk_option(-filter) {
  530.         1 - true - yes - on {
  531.             set newCode {set display [info exists _selected($child)]}
  532.         }
  533.         0 - false - no - off {
  534.             set newCode {set display 1}
  535.         }
  536.         default {
  537.             error "bad filter option \"$itk_option(-filter)\":\
  538.                    should be boolean"
  539.         }
  540.     }
  541.     if {$newCode != $_filterCode} {
  542.         set _filterCode $newCode
  543.         draw -eventually
  544.     }
  545. }
  546.  
  547. # ------------------------------------------------------------------
  548. # OPTION: -expanded
  549. #
  550. # When true, the hierarchy will be completely expanded when it
  551. # is first displayed.  A fresh display can be triggered by
  552. # resetting the -querycommand option.
  553. # ------------------------------------------------------------------
  554. itcl::configbody iwidgets::Hierarchy::expanded {
  555.     switch -- $itk_option(-expanded) {
  556.         1 - true - yes - on {
  557.             ;# okay
  558.         }
  559.         0 - false - no - off {
  560.             ;# okay
  561.         }
  562.         default {
  563.             error "bad expanded option \"$itk_option(-expanded)\":\
  564.                    should be boolean"
  565.         }
  566.     }
  567. }
  568.     
  569. # ------------------------------------------------------------------
  570. # OPTION: -openicon
  571. #
  572. # Specifies the open icon image to be used in the hierarchy.  Should
  573. # one not be provided, then one will be generated, pixmap if 
  574. # possible, bitmap otherwise.
  575. # ------------------------------------------------------------------
  576. itcl::configbody iwidgets::Hierarchy::openicon {
  577.     if {$itk_option(-openicon) == {}} {
  578.     if {[lsearch [image names] openFolder] == -1} {
  579.         if {[lsearch [image types] pixmap] != -1} {
  580.         image create pixmap openFolder -data {
  581.             /* XPM */
  582.             static char * dir_opened [] = {
  583.             "16 16 4 1",
  584.             /* colors */
  585.             ". c grey85 m white g4 grey90",
  586.             "b c black  m black g4 black",
  587.             "y c yellow m white g4 grey80",
  588.             "g c grey70 m white g4 grey70",
  589.             /* pixels */
  590.             "................",
  591.             "................",
  592.             "................",
  593.             "..bbbb..........",
  594.             ".bggggb.........",
  595.             "bggggggbbbbbbb..",
  596.             "bggggggggggggb..",
  597.             "bgbbbbbbbbbbbbbb",
  598.             "bgbyyyyyyyyyyybb",
  599.             "bbyyyyyyyyyyyyb.",
  600.             "bbyyyyyyyyyyybb.",
  601.             "byyyyyyyyyyyyb..",
  602.             "bbbbbbbbbbbbbb..",
  603.             "................",
  604.             "................",
  605.             "................"};
  606.         }
  607.         } else {
  608.         image create bitmap openFolder -data {
  609.             #define open_width 16
  610.             #define open_height 16
  611.             static char open_bits[] = {
  612.             0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00, 
  613.             0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0, 
  614.             0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,
  615.             0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  616.         }
  617.         }
  618.     }
  619.     set itk_option(-openicon) openFolder
  620.     } else {
  621.     if {[lsearch [image names] $itk_option(-openicon)] == -1} {
  622.         error "bad openicon option \"$itk_option(-openicon)\":\
  623.                    should be an existing image"
  624.     }
  625.     }
  626. }
  627.  
  628. # ------------------------------------------------------------------
  629. # OPTION: -closedicon
  630. #
  631. # Specifies the closed icon image to be used in the hierarchy.  
  632. # Should one not be provided, then one will be generated, pixmap if 
  633. # possible, bitmap otherwise.
  634. # ------------------------------------------------------------------
  635. itcl::configbody iwidgets::Hierarchy::closedicon {
  636.     if {$itk_option(-closedicon) == {}} {
  637.     if {[lsearch [image names] closedFolder] == -1} {
  638.         if {[lsearch [image types] pixmap] != -1} {
  639.         image create pixmap closedFolder -data {
  640.             /* XPM */
  641.             static char *dir_closed[] = {
  642.             "16 16 3 1",
  643.             ". c grey85 m white g4 grey90",
  644.             "b c black  m black g4 black",
  645.             "y c yellow m white g4 grey80",
  646.             "................",
  647.             "................",
  648.             "................",
  649.             "..bbbb..........",
  650.             ".byyyyb.........",
  651.             "bbbbbbbbbbbbbb..",
  652.             "byyyyyyyyyyyyb..",
  653.             "byyyyyyyyyyyyb..",
  654.             "byyyyyyyyyyyyb..",
  655.             "byyyyyyyyyyyyb..",
  656.             "byyyyyyyyyyyyb..",
  657.             "byyyyyyyyyyyyb..",
  658.             "bbbbbbbbbbbbbb..",
  659.             "................",
  660.             "................",
  661.             "................"};    
  662.         }
  663.         } else {
  664.         image create bitmap closedFolder -data {
  665.             #define closed_width 16
  666.             #define closed_height 16
  667.             static char closed_bits[] = {
  668.             0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00, 
  669.             0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 
  670.             0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
  671.             0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  672.         }
  673.         }
  674.     }
  675.     set itk_option(-closedicon) closedFolder
  676.     } else {
  677.     if {[lsearch [image names] $itk_option(-closedicon)] == -1} {
  678.         error "bad closedicon option \"$itk_option(-closedicon)\":\
  679.                    should be an existing image"
  680.     }
  681.     }
  682. }
  683.  
  684. # ------------------------------------------------------------------
  685. # OPTION: -nodeicon
  686. #
  687. # Specifies the node icon image to be used in the hierarchy.  Should 
  688. # one not be provided, then one will be generated, pixmap if 
  689. # possible, bitmap otherwise.
  690. # ------------------------------------------------------------------
  691. itcl::configbody iwidgets::Hierarchy::nodeicon {
  692.     if {$itk_option(-nodeicon) == {}} {
  693.     if {[lsearch [image names] nodeFolder] == -1} {
  694.         if {[lsearch [image types] pixmap] != -1} {
  695.         image create pixmap nodeFolder -data {
  696.             /* XPM */
  697.             static char *dir_node[] = {
  698.             "16 16 3 1",
  699.             ". c grey85 m white g4 grey90",
  700.             "b c black  m black g4 black",
  701.             "y c yellow m white g4 grey80",
  702.             "................",
  703.             "................",
  704.             "................",
  705.             "...bbbbbbbbbbb..",
  706.             "..bybyyyyyyyyb..",
  707.             ".byybyyyyyyyyb..",
  708.             "byyybyyyyyyyyb..",
  709.             "bbbbbyyyyyyyyb..",
  710.             "byyyyyyyyyyyyb..",
  711.             "byyyyyyyyyyyyb..",
  712.             "byyyyyyyyyyyyb..",
  713.             "byyyyyyyyyyyyb..",
  714.             "bbbbbbbbbbbbbb..",
  715.             "................",
  716.             "................",
  717.             "................"};    
  718.         }
  719.         } else {
  720.         image create bitmap nodeFolder -data {
  721.             #define node_width 16
  722.             #define node_height 16
  723.             static char node_bits[] = {
  724.             0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40, 
  725.             0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40, 
  726.             0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
  727.             0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  728.         }
  729.         }
  730.     }
  731.     set itk_option(-nodeicon) nodeFolder
  732.     } else {
  733.     if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {
  734.         error "bad nodeicon option \"$itk_option(-nodeicon)\":\
  735.                    should be an existing image"
  736.     }
  737.     }
  738. }
  739.  
  740. # ------------------------------------------------------------------
  741. # OPTION: -width
  742. #
  743. # Specifies the width of the hierarchy widget as an entire unit.
  744. # The value may be specified in any of the forms acceptable to 
  745. # Tk_GetPixels.  Any additional space needed to display the other
  746. # components such as labels, margins, and scrollbars force the text
  747. # to be compressed.  A value of zero along with the same value for 
  748. # the height causes the value given for the visibleitems option 
  749. # to be applied which administers geometry constraints in a different
  750. # manner.
  751. # ------------------------------------------------------------------
  752. itcl::configbody iwidgets::Hierarchy::width {
  753.     if {$itk_option(-width) != 0} {
  754.     set shell [lindex [grid info $itk_component(clipper)] 1]
  755.  
  756.     #
  757.     # Due to a bug in the tk4.2 grid, we have to check the 
  758.     # propagation before setting it.  Setting it to the same
  759.     # value it already is will cause it to toggle.
  760.     #
  761.     if {[grid propagate $shell]} {
  762.         grid propagate $shell no
  763.     }
  764.     
  765.     $itk_component(list) configure -width 1
  766.     $shell configure \
  767.         -width [winfo pixels $shell $itk_option(-width)] 
  768.     } else {
  769.     configure -visibleitems $itk_option(-visibleitems)
  770.     }
  771. }
  772.  
  773. # ------------------------------------------------------------------
  774. # OPTION: -height
  775. #
  776. # Specifies the height of the hierarchy widget as an entire unit.
  777. # The value may be specified in any of the forms acceptable to 
  778. # Tk_GetPixels.  Any additional space needed to display the other
  779. # components such as labels, margins, and scrollbars force the text
  780. # to be compressed.  A value of zero along with the same value for 
  781. # the width causes the value given for the visibleitems option 
  782. # to be applied which administers geometry constraints in a different
  783. # manner.
  784. # ------------------------------------------------------------------
  785. itcl::configbody iwidgets::Hierarchy::height {
  786.     if {$itk_option(-height) != 0} {
  787.     set shell [lindex [grid info $itk_component(clipper)] 1]
  788.  
  789.     #
  790.     # Due to a bug in the tk4.2 grid, we have to check the 
  791.     # propagation before setting it.  Setting it to the same
  792.     # value it already is will cause it to toggle.
  793.     #
  794.     if {[grid propagate $shell]} {
  795.         grid propagate $shell no
  796.     }
  797.     
  798.     $itk_component(list) configure -height 1
  799.     $shell configure \
  800.         -height [winfo pixels $shell $itk_option(-height)] 
  801.     } else {
  802.     configure -visibleitems $itk_option(-visibleitems)
  803.     }
  804. }
  805.  
  806. # ------------------------------------------------------------------
  807. # OPTION: -visibleitems
  808. #
  809. # Specified the widthxheight in characters and lines for the text.
  810. # This option is only administered if the width and height options
  811. # are both set to zero, otherwise they take precedence.  With the
  812. # visibleitems option engaged, geometry constraints are maintained
  813. # only on the text.  The size of the other components such as 
  814. # labels, margins, and scroll bars, are additive and independent, 
  815. # effecting the overall size of the scrolled text.  In contrast,
  816. # should the width and height options have non zero values, they
  817. # are applied to the scrolled text as a whole.  The text is 
  818. # compressed or expanded to maintain the geometry constraints.
  819. # ------------------------------------------------------------------
  820. itcl::configbody iwidgets::Hierarchy::visibleitems {
  821.     if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
  822.     if {($itk_option(-width) == 0) && \
  823.         ($itk_option(-height) == 0)} {
  824.         set chars [lindex [split $itk_option(-visibleitems) x] 0]
  825.         set lines [lindex [split $itk_option(-visibleitems) x] 1]
  826.         
  827.         set shell [lindex [grid info $itk_component(clipper)] 1]
  828.  
  829.         #
  830.         # Due to a bug in the tk4.2 grid, we have to check the 
  831.         # propagation before setting it.  Setting it to the same
  832.         # value it already is will cause it to toggle.
  833.         #
  834.         if {! [grid propagate $shell]} {
  835.         grid propagate $shell yes
  836.         }
  837.         
  838.         $itk_component(list) configure -width $chars -height $lines
  839.     }
  840.     
  841.     } else {
  842.     error "bad visibleitems option\
  843.         \"$itk_option(-visibleitems)\": should be\
  844.         widthxheight"
  845.     }
  846. }
  847.  
  848. # ------------------------------------------------------------------
  849. # OPTION: -textmenuloadcommand
  850. #
  851. # Dynamically loads the popup menu based on what was selected.
  852. #
  853. # Douglas R. Howard, Jr.
  854. # ------------------------------------------------------------------
  855. itcl::configbody iwidgets::Hierarchy::textmenuloadcommand {}
  856.  
  857. # ------------------------------------------------------------------
  858. # OPTION: -imagemenuloadcommand
  859. #
  860. # Dynamically loads the popup menu based on what was selected.
  861. #
  862. # Douglas R. Howard, Jr.
  863. # ------------------------------------------------------------------
  864. itcl::configbody iwidgets::Hierarchy::imagemenuloadcommand {}
  865.  
  866.  
  867. # ------------------------------------------------------------------
  868. #                         PUBLIC METHODS
  869. # ------------------------------------------------------------------
  870.  
  871. # ----------------------------------------------------------------------
  872. # PUBLIC METHOD: clear
  873. #
  874. # Removes all items from the display including all tags and icons.  
  875. # The display will remain empty until the -filter or -querycommand 
  876. # options are set.
  877. # ----------------------------------------------------------------------
  878. itcl::body iwidgets::Hierarchy::clear {} {
  879.     $itk_component(list) configure -state normal -cursor watch
  880.     $itk_component(list) delete 1.0 end
  881.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  882.  
  883.     # Clear the tags
  884.     eval $itk_component(list) tag delete [$itk_component(list) tag names]
  885.     
  886.     catch {unset _nodes}
  887.     catch {unset _text}
  888.     catch {unset _tags}
  889.     catch {unset _icons}
  890.     catch {unset _states}
  891.     catch {unset _images}
  892.     catch {unset _indents}
  893.     catch {unset _marked}
  894.     catch {unset _selected}
  895.     set _markers  ""
  896.     set _posted   ""
  897.     set _ucounter 0
  898.     set _hcounter 0 
  899.  
  900.     foreach mark [$itk_component(list) mark names] {
  901.         $itk_component(list) mark unset $mark
  902.     }
  903.  
  904.     return
  905. }
  906.  
  907. # ----------------------------------------------------------------------
  908. # PUBLIC METHOD: selection option ?uid uid...?
  909. #
  910. # Handles all operations controlling selections in the hierarchy.
  911. # Selections may be cleared, added, removed, or queried.  The add and
  912. # remove options accept a series of unique ids.
  913. # ----------------------------------------------------------------------
  914. itcl::body iwidgets::Hierarchy::selection {op args} {
  915.     switch -- $op {
  916.         clear {
  917.             $itk_component(list) tag remove hilite 1.0 end
  918.             catch {unset _selected}
  919.         return
  920.         }
  921.         add {
  922.             foreach node $args {
  923.                 set _selected($node) 1
  924.                 catch {
  925.                     $itk_component(list) tag add hilite \
  926.                 "$node.first" "$node.last"
  927.                 }
  928.             }
  929.         }
  930.         remove {
  931.             foreach node $args {
  932.                 catch {
  933.                     unset _selected($node)
  934.                     $itk_component(list) tag remove hilite \
  935.                 "$node.first" "$node.last"
  936.                 }
  937.             }
  938.         }
  939.     get {
  940.         return [array names _selected]
  941.     }
  942.         default {
  943.             error "bad selection operation \"$op\":\
  944.                    should be add, remove, clear or get"
  945.         }
  946.     }
  947. }
  948.  
  949. # ----------------------------------------------------------------------
  950. # PUBLIC METHOD: mark option ?arg arg...?
  951. #
  952. # Handles all operations controlling marks in the hierarchy.  Marks may 
  953. # be cleared, added, removed, or queried.  The add and remove options 
  954. # accept a series of unique ids.
  955. # ----------------------------------------------------------------------
  956. itcl::body iwidgets::Hierarchy::mark {op args} {
  957.     switch -- $op {
  958.         clear {
  959.             $itk_component(list) tag remove lowlite 1.0 end
  960.             catch {unset _marked}
  961.         return
  962.         }
  963.         add {
  964.             foreach node $args {
  965.                 set _marked($node) 1
  966.                 catch {
  967.                     $itk_component(list) tag add lowlite \
  968.                 "$node.first" "$node.last"
  969.                 }
  970.             }
  971.         }
  972.         remove {
  973.             foreach node $args {
  974.                 catch {
  975.                     unset _marked($node)
  976.                     $itk_component(list) tag remove lowlite \
  977.                 "$node.first" "$node.last"
  978.                 }
  979.             }
  980.         }
  981.     get {
  982.         return [array names _marked]
  983.     }
  984.         default {
  985.             error "bad mark operation \"$op\":\
  986.                    should be add, remove, clear or get"
  987.         }
  988.     }
  989. }
  990.  
  991. # ----------------------------------------------------------------------
  992. # PUBLIC METHOD: current
  993. #
  994. # Returns the node that was most recently selected by the right mouse
  995. # button when the item menu was posted.  Usually used by the code
  996. # in the item menu to figure out what item is being manipulated.
  997. # ----------------------------------------------------------------------
  998. itcl::body iwidgets::Hierarchy::current {} {
  999.     return $_posted
  1000. }
  1001.  
  1002. # ----------------------------------------------------------------------
  1003. # PUBLIC METHOD: expand node
  1004. #
  1005. # Expands the hierarchy beneath the specified node.  Since this can take
  1006. # a moment for large hierarchies, the cursor will be changed to a watch
  1007. # during the expansion.
  1008. # ----------------------------------------------------------------------
  1009. itcl::body iwidgets::Hierarchy::expand {node} {
  1010.     if {! [info exists _states($node)]} {
  1011.     error "bad expand node argument: \"$node\", the node doesn't exist"
  1012.     }
  1013.  
  1014.     if {!$_states($node) && \
  1015.         (([lsearch $_tags($node) branch] != -1) || \
  1016.          ([llength [_contents $node]] > 0))} {
  1017.         $itk_component(list) configure -state normal -cursor watch
  1018.         update
  1019.  
  1020.     #
  1021.     # Get the indentation level for the node.
  1022.     #
  1023.         set indent $_indents($node)
  1024.  
  1025.         set _markers ""
  1026.         $itk_component(list) mark set insert "$node:start"
  1027.         _drawLevel $node $indent
  1028.  
  1029.     #
  1030.     # Following the draw, all our markers need adjusting.
  1031.     #
  1032.         foreach {name index} $_markers {
  1033.             $itk_component(list) mark set $name $index
  1034.         }
  1035.  
  1036.     #
  1037.     # Set the image to be the open icon, denote the new state,
  1038.     # and set the cursor back to normal along with the state.
  1039.     #
  1040.     $_images($node) configure -image $itk_option(-openicon)
  1041.  
  1042.         set _states($node) 1
  1043.  
  1044.         $itk_component(list) configure -state disabled \
  1045.         -cursor $itk_option(-cursor)
  1046.     }
  1047. }
  1048.  
  1049. # ----------------------------------------------------------------------
  1050. # PUBLIC METHOD: collapse node
  1051. #
  1052. # Collapses the hierarchy beneath the specified node.  Since this can 
  1053. # take a moment for large hierarchies, the cursor will be changed to a 
  1054. # watch during the expansion.
  1055. # ----------------------------------------------------------------------
  1056. itcl::body iwidgets::Hierarchy::collapse {node} {
  1057.     if {! [info exists _states($node)]} {
  1058.     error "bad collapse node argument: \"$node\", the node doesn't exist"
  1059.     }
  1060.  
  1061.     if {[info exists _states($node)] && $_states($node) && \
  1062.         (([lsearch $_tags($node) branch] != -1) || \
  1063.          ([llength [_contents $node]] > 0))} {
  1064.         $itk_component(list) configure -state normal -cursor watch
  1065.     update
  1066.  
  1067.     _deselectSubNodes $node
  1068.  
  1069.         $itk_component(list) delete "$node:start" "$node:end"
  1070.  
  1071.     catch {$_images($node) configure -image $itk_option(-closedicon)}
  1072.  
  1073.         set _states($node) 0
  1074.  
  1075.         $itk_component(list) configure -state disabled \
  1076.         -cursor $itk_option(-cursor)
  1077.     }
  1078. }
  1079.  
  1080. # ----------------------------------------------------------------------
  1081. # PUBLIC METHOD: toggle node
  1082. #
  1083. # Toggles the hierarchy beneath the specified node.  If the hierarchy
  1084. # is currently expanded, then it is collapsed, and vice-versa.
  1085. # ----------------------------------------------------------------------
  1086. itcl::body iwidgets::Hierarchy::toggle {node} {
  1087.     if {! [info exists _states($node)]} {
  1088.     error "bad toggle node argument: \"$node\", the node doesn't exist"
  1089.     }
  1090.  
  1091.     if {$_states($node)} {
  1092.         collapse $node
  1093.     } else {
  1094.         expand $node
  1095.     }
  1096. }
  1097.  
  1098. # ----------------------------------------------------------------------
  1099. # PUBLIC METHOD: prune node
  1100. #
  1101. # Removes a particular node from the hierarchy.
  1102. # ----------------------------------------------------------------------
  1103. itcl::body iwidgets::Hierarchy::prune {node} {
  1104.     #
  1105.     # While we're working, change the state and cursor so we can
  1106.     # edit the text and give a busy visual clue.
  1107.     #
  1108.     $itk_component(list) configure -state normal -cursor watch
  1109.  
  1110.     #
  1111.     # Recursively delete all the subnode information from our internal
  1112.     # arrays and remove all the tags.  
  1113.     #
  1114.     _deleteNodeInfo $node
  1115.  
  1116.     #
  1117.     # If the mark $node:end exists then the node has decendents so
  1118.     # so we'll remove from the mark $node:start to $node:end in order 
  1119.     # to delete all the subnodes below it in the text.  
  1120.     # 
  1121.     if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {
  1122.     $itk_component(list) delete $node:start $node:end
  1123.     $itk_component(list) mark unset $node:end
  1124.     } 
  1125.  
  1126.     #
  1127.     # Next we need to remove the node itself.  Using the ranges for
  1128.     # its tag we'll remove it from line start to the end plus one
  1129.     # character which takes us to the start of the next node.
  1130.     #
  1131.     foreach {start end} [$itk_component(list) tag ranges $node] {
  1132.     $itk_component(list) delete "$start linestart" "$end + 1 char"
  1133.     }
  1134.  
  1135.     #
  1136.     # Delete the tag for this node.
  1137.     #
  1138.     $itk_component(list) tag delete $node
  1139.  
  1140.     #
  1141.     # The node must be removed from the list of subnodes for its parent.
  1142.     # We don't really have a clean way to do upwards referencing, so
  1143.     # the dirty way will have to do.  We'll cycle through each node
  1144.     # and if this node is in its list of subnodes, we'll remove it.
  1145.     #
  1146.     foreach uid [array names _nodes] {
  1147.     if {[set index [lsearch $_nodes($uid) $node]] != -1} {
  1148.         set _nodes($uid) [lreplace $_nodes($uid) $index $index]
  1149.     }
  1150.     }
  1151.  
  1152.     #
  1153.     # We're done, so change the state and cursor back to their 
  1154.     # original values.
  1155.     #
  1156.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1157. }
  1158.  
  1159. # ----------------------------------------------------------------------
  1160. # PUBLIC METHOD: draw ?when?
  1161. #
  1162. # Performs a complete draw of the entire hierarchy.
  1163. # ----------------------------------------------------------------------
  1164. itcl::body iwidgets::Hierarchy::draw {{when -now}} {
  1165.     if {$when == "-eventually"} {
  1166.         if {$_pending == ""} {
  1167.             set _pending [after idle [itcl::code $this draw -now]]
  1168.         }
  1169.         return
  1170.     } elseif {$when != "-now"} {
  1171.         error "bad when option \"$when\": should be -eventually or -now"
  1172.     }
  1173.     $itk_component(list) configure -state normal -cursor watch
  1174.     update
  1175.  
  1176.     $itk_component(list) delete 1.0 end
  1177.     catch {unset _images}
  1178.     set _markers ""
  1179.  
  1180.     _drawLevel "" ""
  1181.  
  1182.     foreach {name index} $_markers {
  1183.         $itk_component(list) mark set $name $index
  1184.     }
  1185.  
  1186.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1187.     set _pending ""
  1188. }
  1189.  
  1190. # ----------------------------------------------------------------------
  1191. # PUBLIC METHOD: refresh node
  1192. #
  1193. # Performs a redraw of a specific node.  If that node is currently 
  1194. # not visible, then no action is taken.
  1195. # ----------------------------------------------------------------------
  1196. itcl::body iwidgets::Hierarchy::refresh {node} {
  1197.     if {! [info exists _nodes($node)]} {
  1198.     error "bad refresh node argument: \"$node\", the node doesn't exist"
  1199.     }
  1200.  
  1201.     
  1202.     if {! $_states($node)} {return}
  1203.  
  1204.     foreach parent [_getHeritage $node] {
  1205.     if {! $_states($parent)} {return}
  1206.     }
  1207.  
  1208.     $itk_component(list) configure -state normal -cursor watch
  1209.     $itk_component(list) delete $node:start $node:end
  1210.  
  1211.     set _markers ""
  1212.     $itk_component(list) mark set insert "$node:start"
  1213.     set indent $_indents($node)
  1214.  
  1215.     _drawLevel $node $indent
  1216.  
  1217.     foreach {name index} $_markers {
  1218.         $itk_component(list) mark set $name $index
  1219.     }
  1220.  
  1221.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1222. }
  1223.  
  1224. # ------------------------------------------------------------------
  1225. # THIN WRAPPED TEXT METHODS:
  1226. #
  1227. # The following methods are thin wraps of standard text methods.
  1228. # Consult the Tk text man pages for functionallity and argument
  1229. # documentation.
  1230. # ------------------------------------------------------------------
  1231.  
  1232. # ------------------------------------------------------------------
  1233. # PUBLIC METHOD: bbox index
  1234. #
  1235. # Returns four element list describing the bounding box for the list
  1236. # item at index
  1237. # ------------------------------------------------------------------
  1238. itcl::body iwidgets::Hierarchy::bbox {index} {
  1239.     return [$itk_component(list) bbox $index]
  1240. }
  1241.  
  1242. # ------------------------------------------------------------------
  1243. # PUBLIC METHOD compare index1 op index2
  1244. #
  1245. # Compare indices according to relational operator.
  1246. # ------------------------------------------------------------------
  1247. itcl::body iwidgets::Hierarchy::compare {index1 op index2} {
  1248.     return [$itk_component(list) compare $index1 $op $index2]
  1249. }
  1250.  
  1251. # ------------------------------------------------------------------
  1252. # PUBLIC METHOD delete first ?last?
  1253. #
  1254. # Delete a range of characters from the text.
  1255. # ------------------------------------------------------------------
  1256. itcl::body iwidgets::Hierarchy::delete {first {last {}}} {
  1257.     $itk_component(list) configure -state normal -cursor watch
  1258.     $itk_component(list) delete $first $last
  1259.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1260. }
  1261.  
  1262. # ------------------------------------------------------------------
  1263. # PUBLIC METHOD dump ?switches? index1 ?index2?
  1264. #
  1265. # Returns information about the contents of the text widget from 
  1266. # index1 to index2.
  1267. # ------------------------------------------------------------------
  1268. itcl::body iwidgets::Hierarchy::dump {args} {
  1269.     return [eval $itk_component(list) dump $args]
  1270. }
  1271.  
  1272. # ------------------------------------------------------------------
  1273. # PUBLIC METHOD dlineinfo index
  1274. #
  1275. # Returns a five element list describing the area occupied by the
  1276. # display line containing index.
  1277. # ------------------------------------------------------------------
  1278. itcl::body iwidgets::Hierarchy::dlineinfo {index} {
  1279.     return [$itk_component(list) dlineinfo $index]
  1280. }
  1281.  
  1282. # ------------------------------------------------------------------
  1283. # PUBLIC METHOD get index1 ?index2?
  1284. #
  1285. # Return text from start index to end index.
  1286. # ------------------------------------------------------------------
  1287. itcl::body iwidgets::Hierarchy::get {index1 {index2 {}}} {
  1288.     return [$itk_component(list) get $index1 $index2]
  1289. }
  1290.  
  1291. # ------------------------------------------------------------------
  1292. # PUBLIC METHOD index index
  1293. #
  1294. # Return position corresponding to index.
  1295. # ------------------------------------------------------------------
  1296. itcl::body iwidgets::Hierarchy::index {index} {
  1297.     return [$itk_component(list) index $index]
  1298. }
  1299.  
  1300. # ------------------------------------------------------------------
  1301. # PUBLIC METHOD insert index chars ?tagList?
  1302. #
  1303. # Insert text at index.
  1304. # ------------------------------------------------------------------
  1305. itcl::body iwidgets::Hierarchy::insert {args} {
  1306.     $itk_component(list) configure -state normal -cursor watch
  1307.     eval $itk_component(list) insert $args
  1308.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1309. }
  1310.  
  1311. # ------------------------------------------------------------------
  1312. # PUBLIC METHOD scan option args
  1313. #
  1314. # Implements scanning on texts.
  1315. # ------------------------------------------------------------------
  1316. itcl::body iwidgets::Hierarchy::scan {option args} {
  1317.     eval $itk_component(list) scan $option $args
  1318. }
  1319.  
  1320. # ------------------------------------------------------------------
  1321. # PUBLIC METHOD search ?switches? pattern index ?varName?
  1322. #
  1323. # Searches the text for characters matching a pattern.
  1324. # ------------------------------------------------------------------
  1325. itcl::body iwidgets::Hierarchy::search {args} {
  1326.     return [eval $itk_component(list) search $args]
  1327. }
  1328.  
  1329. # ------------------------------------------------------------------
  1330. # PUBLIC METHOD see index
  1331. #
  1332. # Adjusts the view in the window so the character at index is 
  1333. # visible.
  1334. # ------------------------------------------------------------------
  1335. itcl::body iwidgets::Hierarchy::see {index} {
  1336.     $itk_component(list) see $index
  1337. }
  1338.  
  1339. # ------------------------------------------------------------------
  1340. # PUBLIC METHOD tag option ?arg arg ...?
  1341. #
  1342. # Manipulate tags dependent on options.
  1343. # ------------------------------------------------------------------
  1344. itcl::body iwidgets::Hierarchy::tag {op args} {
  1345.     return [eval $itk_component(list) tag $op $args]
  1346. }
  1347.  
  1348. # ------------------------------------------------------------------
  1349. # PUBLIC METHOD window option ?arg arg ...?
  1350. #
  1351. # Manipulate embedded windows.
  1352. # ------------------------------------------------------------------
  1353. itcl::body iwidgets::Hierarchy::window {option args} {
  1354.     return [eval $itk_component(list) window $option $args]
  1355. }
  1356.  
  1357. # ----------------------------------------------------------------------
  1358. # PUBLIC METHOD: xview args
  1359. #
  1360. # Thin wrap of the text widget's xview command.
  1361. # ----------------------------------------------------------------------
  1362. itcl::body iwidgets::Hierarchy::xview {args} {
  1363.     return [eval itk_component(list) xview $args]
  1364. }
  1365.  
  1366. # ----------------------------------------------------------------------
  1367. # PUBLIC METHOD: yview args
  1368. #
  1369. # Thin wrap of the text widget's yview command.
  1370. # ----------------------------------------------------------------------
  1371. itcl::body iwidgets::Hierarchy::yview {args} {
  1372.     return [eval $itk_component(list) yview $args]
  1373. }
  1374.  
  1375. # ----------------------------------------------------------------------
  1376. # PUBLIC METHOD: expanded node
  1377. #
  1378. # Tells if a node is expanded or collapsed
  1379. #
  1380. # Douglas R. Howard, Jr.
  1381. # ----------------------------------------------------------------------
  1382. itcl::body iwidgets::Hierarchy::expanded {node} {
  1383.     if {! [info exists _states($node)]} {
  1384.     error "bad collapse node argument: \"$node\", the node doesn't exist"
  1385.     }
  1386.     
  1387.     return $_states($node)
  1388. }
  1389.  
  1390. # ----------------------------------------------------------------------
  1391. # PUBLIC METHOD: expState
  1392. #
  1393. # Returns a list of all expanded nodes
  1394. #
  1395. # Douglas R. Howard, Jr.
  1396. # ----------------------------------------------------------------------
  1397. itcl::body iwidgets::Hierarchy::expState {} {
  1398.     set nodes [_contents ""]
  1399.     set open ""
  1400.     set i 0
  1401.     while {1} {
  1402.     if {[info exists _states([lindex $nodes $i])] &&
  1403.     $_states([lindex $nodes $i])} {
  1404.         lappend open [lindex $nodes $i]
  1405.         foreach child [_contents [lindex $nodes $i]] {
  1406.         lappend nodes $child
  1407.         }
  1408.     }
  1409.     incr i
  1410.     if {$i >= [llength $nodes]} {break}
  1411.     }
  1412.     
  1413.     return $open
  1414. }
  1415.  
  1416. # ------------------------------------------------------------------
  1417. #                       PROTECTED METHODS
  1418. # ------------------------------------------------------------------
  1419.  
  1420. # ----------------------------------------------------------------------
  1421. # PROTECTED METHOD: _drawLevel node indent
  1422. #
  1423. # Used internally by draw to draw one level of the hierarchy.
  1424. # Draws all of the nodes under node, using the indent string to
  1425. # indent nodes.
  1426. # ----------------------------------------------------------------------
  1427. itcl::body iwidgets::Hierarchy::_drawLevel {node indent} {
  1428.     lappend _markers "$node:start" [$itk_component(list) index insert]
  1429.     set bg [$itk_component(list) cget -background]
  1430.  
  1431.     #
  1432.     # Obtain the list of subnodes for this node and cycle through
  1433.     # each one displaying it in the hierarchy.
  1434.     #
  1435.     foreach child [_contents $node] {
  1436.     set _images($child) "$itk_component(list).hicon[incr _hcounter]"
  1437.  
  1438.         if {![info exists _states($child)]} {
  1439.             set _states($child) $itk_option(-expanded)
  1440.         }
  1441.  
  1442.     #
  1443.     # Check the user tags to see if they have been kind enough
  1444.     # to tell us ahead of time what type of node we are dealing
  1445.     # with branch or leaf.  If they neglected to do so, then
  1446.     # get the contents of the child node to see if it has children
  1447.     # itself.
  1448.     #
  1449.     set display 0
  1450.  
  1451.     if {[lsearch $_tags($child) leaf] != -1} {
  1452.         set type leaf
  1453.     } elseif {[lsearch $_tags($child) branch] != -1} {
  1454.         set type branch
  1455.     } else {
  1456.         if {[llength [_contents $child]] == 0} {
  1457.         set type leaf
  1458.         } else {
  1459.         set type branch
  1460.         }
  1461.     }
  1462.  
  1463.     #
  1464.     # Now that we know the type of node, branch or leaf, we know
  1465.     # the type of icon to use.
  1466.     #
  1467.     if {$type == "leaf"} {
  1468.             set icon $itk_option(-nodeicon)
  1469.             eval $_filterCode
  1470.     } else {
  1471.             if {$_states($child)} {
  1472.                 set icon $itk_option(-openicon)
  1473.             } else {
  1474.                 set icon $itk_option(-closedicon)
  1475.             }
  1476.             set display 1
  1477.     }
  1478.  
  1479.     #
  1480.     # If display is set then we're going to be drawing this node.
  1481.     # Save off the indentation level for this node and do the indent.
  1482.     #
  1483.     if {$display} {
  1484.         set _indents($child) "$indent\t"
  1485.         $itk_component(list) insert insert $indent
  1486.  
  1487.         #
  1488.         # Add the branch or leaf icon and setup a binding to toggle
  1489.         # its expanded/collapsed state.
  1490.         #
  1491.         label $_images($child) -image $icon -background $bg 
  1492.         # DRH - enhanced and added features that handle image clicking,
  1493.         # double clicking, and right clicking behavior
  1494.         bind $_images($child) <ButtonPress-1> \
  1495.           "[itcl::code $this toggle $child]; [itcl::code $this _imageSelect $child]"
  1496.         bind $_images($child) <Double-1> [itcl::code $this _imageDblClick $child]
  1497.         bind $_images($child) <ButtonPress-3> \
  1498.           [itcl::code $this _imagePost $child $_images($child) $type %x %y]
  1499.         $itk_component(list) window create insert -window $_images($child)
  1500.  
  1501.         #
  1502.         # If any user icons exist then draw them as well.  The little
  1503.         # regexp is just to check and see if they've passed in a
  1504.         # command which needs to be evaluated as opposed to just
  1505.         # a variable.  Also, attach a binding to call them if their
  1506.         # icon is selected.
  1507.         #
  1508.         if {[info exists _icons($child)]} {
  1509.         foreach image $_icons($child) {
  1510.             set wid "$itk_component(list).uicon[incr _ucounter]"
  1511.  
  1512.             if {[regexp {\[.*\]} $image]} {
  1513.             eval label $wid -image $image -background $bg 
  1514.             } else {
  1515.             label $wid -image $image -background $bg 
  1516.             }
  1517.  
  1518.             # DRH - this will bind events to the icons to allow
  1519.             # clicking, double clicking, and right clicking actions.
  1520.             bind $wid <ButtonPress-1> \
  1521.                 [itcl::code $this _iconSelect $child $image]
  1522.             bind $wid <Double-1> \
  1523.                 [itcl::code $this _iconDblSelect $child $image]
  1524.             bind $wid <ButtonPress-3> \
  1525.                 [itcl::code $this _imagePost $child $wid $type %x %y]
  1526.             $itk_component(list) window create insert -window $wid
  1527.         }
  1528.         }
  1529.  
  1530.         #
  1531.         # Create the list of tags to be applied to the text.  Start
  1532.         # out with a tag of "info" and append "hilite" if the node
  1533.         # is currently selected, finally add the tags given by the
  1534.         # user.
  1535.         #
  1536.         set texttags [list "info" $child]
  1537.  
  1538.         if {[info exists _selected($child)]} {
  1539.         lappend texttags hilite
  1540.         } 
  1541.  
  1542.             # The following conditional added for SF ticket #600941.
  1543.             if {[info exists _marked($child)]} { 
  1544.                 lappend texttags lowlite 
  1545.             } 
  1546.  
  1547.         foreach tag $_tags($child) {
  1548.         lappend texttags $tag
  1549.         }
  1550.  
  1551.         #
  1552.         # Insert the text for the node along with the tags and 
  1553.         # append to the markers the start of this node.  The text
  1554.         # has been broken at newlines into a list.  We'll make sure
  1555.         # that each line is at the same indentation position.
  1556.         #
  1557.         set firstline 1
  1558.         foreach line $_text($child) {
  1559.         if {$firstline} {
  1560.             $itk_component(list) insert insert " "
  1561.         } else {
  1562.             $itk_component(list) insert insert "$indent\t"
  1563.         }
  1564.  
  1565.         $itk_component(list) insert insert $line $texttags "\n"
  1566.         set firstline 0
  1567.         }
  1568.  
  1569.         $itk_component(list) tag raise $child
  1570.         lappend _markers "$child:start" [$itk_component(list) index insert]
  1571.  
  1572.         #
  1573.         # If the state of the node is open, proceed to draw the next 
  1574.         # node below it in the hierarchy.
  1575.         #
  1576.         if {$_states($child)} {
  1577.         _drawLevel $child "$indent\t"
  1578.         }
  1579.     }
  1580.     }
  1581.  
  1582.     lappend _markers "$node:end" [$itk_component(list) index insert]
  1583. }
  1584.  
  1585. # ----------------------------------------------------------------------
  1586. # PROTECTED METHOD: _contents uid
  1587. #
  1588. # Used internally to get the contents of a particular node.  If this
  1589. # is the first time the node has been seen or the -alwaysquery
  1590. # option is set, the -querycommand code is executed to query the node 
  1591. # list, and the list is stored until the next time it is needed.
  1592. #
  1593. # The querycommand may return not only the list of subnodes for the 
  1594. # node but additional information on the tags and icons to be used.  
  1595. # The return value must be parsed based on the number of elements in 
  1596. # the list where the format is a list of lists:
  1597. #
  1598. # {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
  1599. # ----------------------------------------------------------------------
  1600. itcl::body iwidgets::Hierarchy::_contents {uid} {
  1601.     if {$itk_option(-alwaysquery)} {
  1602.     } else {
  1603.       if {[info exists _nodes($uid)]} {
  1604.           return $_nodes($uid)
  1605.       }
  1606.     }
  1607.  
  1608.     # 
  1609.     # Substitute any %n's for the node name whose children we're
  1610.     # interested in obtaining.
  1611.     #
  1612.     set cmd $itk_option(-querycommand)
  1613.     regsub -all {%n} $cmd [list $uid] cmd
  1614.  
  1615.     set nodeinfolist [uplevel \#0 $cmd]
  1616.  
  1617.     #
  1618.     # Cycle through the node information returned by the query
  1619.     # command determining if additional information such as text,
  1620.     # user tags, or user icons have been provided.  For text,
  1621.     # break it into a list at any newline characters.
  1622.     #
  1623.     set _nodes($uid) {}
  1624.  
  1625.     foreach nodeinfo $nodeinfolist {
  1626.     set subnodeuid [lindex $nodeinfo 0]
  1627.     lappend _nodes($uid) $subnodeuid
  1628.  
  1629.     set llen [llength $nodeinfo] 
  1630.  
  1631.     if {$llen == 0 || $llen > 4} {
  1632.         error "invalid number of elements returned by query\
  1633.                        command for node: \"$uid\",\
  1634.                        should be uid \[text \[tags \[icons\]\]\]"
  1635.     }
  1636.  
  1637.     if {$llen == 1} {
  1638.         set _text($subnodeuid) [split $subnodeuid \n]
  1639.     } 
  1640.     if {$llen > 1} {
  1641.         set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]
  1642.     }
  1643.     if {$llen > 2} {
  1644.         set _tags($subnodeuid) [lindex $nodeinfo 2]
  1645.     } else {
  1646.         set _tags($subnodeuid) unknown
  1647.     }
  1648.     if {$llen > 3} {
  1649.         set _icons($subnodeuid) [lindex $nodeinfo 3]
  1650.     }
  1651.     }
  1652.           
  1653.     #
  1654.     # Return the list of nodes.
  1655.     #
  1656.     return $_nodes($uid)
  1657. }
  1658.  
  1659. # ----------------------------------------------------------------------
  1660. # PROTECTED METHOD: _post x y
  1661. #
  1662. # Used internally to post the popup menu at the coordinate (x,y)
  1663. # relative to the widget.  If (x,y) is on an item, then the itemMenu
  1664. # component is posted.  Otherwise, the bgMenu is posted.
  1665. # ----------------------------------------------------------------------
  1666. itcl::body iwidgets::Hierarchy::_post {x y} {
  1667.     set rx [expr {[winfo rootx $itk_component(list)]+$x}]
  1668.     set ry [expr {[winfo rooty $itk_component(list)]+$y}]
  1669.  
  1670.     set index [$itk_component(list) index @$x,$y]
  1671.  
  1672.     #
  1673.     # The posted variable will hold the list of tags which exist at
  1674.     # this x,y position that will be passed back to the user.  They
  1675.     # don't need to know about our internal tags, info, hilite, and
  1676.     # lowlite, so remove them from the list.
  1677.     # 
  1678.     set _posted {}
  1679.  
  1680.     foreach tag [$itk_component(list) tag names $index] {
  1681.         if {![_isInternalTag $tag]} {
  1682.             lappend _posted $tag
  1683.         }
  1684.     }
  1685.  
  1686.     #
  1687.     # If we have tags then do the popup at this position.
  1688.     #
  1689.     if {$_posted != {}} {
  1690.     # DRH - here is where the user's function for dynamic popup
  1691.     # menu loading is done, if the user has specified to do so with the
  1692.     # "-textmenuloadcommand"
  1693.     if {$itk_option(-textmenuloadcommand) != {}} {
  1694.         eval $itk_option(-textmenuloadcommand)
  1695.     }
  1696.     tk_popup $itk_component(itemMenu) $rx $ry
  1697.     } else {
  1698.     tk_popup $itk_component(bgMenu) $rx $ry
  1699.     }
  1700. }
  1701.  
  1702. # ----------------------------------------------------------------------
  1703. # PROTECTED METHOD: _imagePost node image type x y
  1704. #
  1705. # Used internally to post the popup menu at the coordinate (x,y)
  1706. # relative to the widget.  If (x,y) is on an image, then the itemMenu
  1707. # component is posted.
  1708. #
  1709. # Douglas R. Howard, Jr.
  1710. # ----------------------------------------------------------------------
  1711. itcl::body iwidgets::Hierarchy::_imagePost {node image type x y} {
  1712.     set rx [expr {[winfo rootx $image]+$x}]
  1713.     set ry [expr {[winfo rooty $image]+$y}]
  1714.  
  1715.     #
  1716.     # The posted variable will hold the list of tags which exist at
  1717.     # this x,y position that will be passed back to the user.  They
  1718.     # don't need to know about our internal tags, info, hilite, and
  1719.     # lowlite, so remove them from the list.
  1720.     # 
  1721.     set _posted {}
  1722.  
  1723.     lappend _posted $node $type
  1724.  
  1725.     #
  1726.     # If we have tags then do the popup at this position.
  1727.     #
  1728.     if {$itk_option(-imagemenuloadcommand) != {}} {
  1729.     eval $itk_option(-imagemenuloadcommand)
  1730.     }
  1731.     tk_popup $itk_component(itemMenu) $rx $ry
  1732. }
  1733.  
  1734. # ----------------------------------------------------------------------
  1735. # PROTECTED METHOD: _select x y
  1736. #
  1737. # Used internally to select an item at the coordinate (x,y) relative 
  1738. # to the widget.  The command associated with the -selectcommand
  1739. # option is execute following % character substitutions.  If %n
  1740. # appears in the command, the selected node is substituted.  If %s
  1741. # appears, a boolean value representing the current selection state
  1742. # will be substituted.
  1743. # ----------------------------------------------------------------------
  1744. itcl::body iwidgets::Hierarchy::_select {x y} {
  1745.     if {$itk_option(-selectcommand) != {}} {
  1746.     if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
  1747.         foreach tag $seltags {
  1748.         if {![_isInternalTag $tag]} {
  1749.             lappend node $tag
  1750.         }
  1751.         }
  1752.  
  1753.         if {[lsearch $seltags "hilite"] == -1} {
  1754.         set selectstatus 0
  1755.         } else {
  1756.         set selectstatus 1
  1757.         }
  1758.  
  1759.         set cmd $itk_option(-selectcommand)
  1760.         regsub -all {%n} $cmd [lindex $node end] cmd
  1761.         regsub -all {%s} $cmd [list $selectstatus] cmd
  1762.  
  1763.         uplevel #0 $cmd
  1764.     }
  1765.     }
  1766.  
  1767.     return
  1768. }
  1769.  
  1770. # ----------------------------------------------------------------------
  1771. # PROTECTED METHOD: _double x y
  1772. #
  1773. # Used internally to double click an item at the coordinate (x,y) relative 
  1774. # to the widget.  The command associated with the -dblclickcommand
  1775. # option is execute following % character substitutions.  If %n
  1776. # appears in the command, the selected node is substituted.  If %s
  1777. # appears, a boolean value representing the current selection state
  1778. # will be substituted.
  1779. #
  1780. # Douglas R. Howard, Jr.
  1781. # ----------------------------------------------------------------------
  1782. itcl::body iwidgets::Hierarchy::_double {x y} {
  1783.     if {$itk_option(-dblclickcommand) != {}} {
  1784.     if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
  1785.         foreach tag $seltags {
  1786.         if {![_isInternalTag $tag]} {
  1787.             lappend node $tag
  1788.         }
  1789.         }
  1790.  
  1791.         if {[lsearch $seltags "hilite"] == -1} {
  1792.         set selectstatus 0
  1793.         } else {
  1794.         set selectstatus 1
  1795.         }
  1796.  
  1797.         set cmd $itk_option(-dblclickcommand)
  1798.         regsub -all {%n} $cmd [list $node] cmd
  1799.         regsub -all {%s} $cmd [list $selectstatus] cmd
  1800.  
  1801.         uplevel #0 $cmd
  1802.     }
  1803.     }
  1804.  
  1805.     return
  1806. }
  1807.  
  1808. # ----------------------------------------------------------------------
  1809. # PROTECTED METHOD: _iconSelect node icon
  1810. #
  1811. # Used internally to upon selection of user icons.  The -iconcommand
  1812. # is executed after substitution of the node for %n and icon for %i.
  1813. #
  1814. # Douglas R. Howard, Jr.
  1815. # ----------------------------------------------------------------------
  1816. itcl::body iwidgets::Hierarchy::_iconSelect {node icon} {
  1817.     set cmd $itk_option(-iconcommand)
  1818.     regsub -all {%n} $cmd [list $node] cmd
  1819.     regsub -all {%i} $cmd [list $icon] cmd
  1820.  
  1821.     uplevel \#0 $cmd
  1822.  
  1823.     return {}
  1824. }
  1825.  
  1826. # ----------------------------------------------------------------------
  1827. # PROTECTED METHOD: _iconDblSelect node icon
  1828. #
  1829. # Used internally to upon double selection of user icons.  The 
  1830. # -icondblcommand is executed after substitution of the node for %n and 
  1831. # icon for %i.
  1832. #
  1833. # Douglas R. Howard, Jr.
  1834. # ----------------------------------------------------------------------
  1835. itcl::body iwidgets::Hierarchy::_iconDblSelect {node icon} {
  1836.     if {$itk_option(-icondblcommand) != {}} {
  1837.     set cmd $itk_option(-icondblcommand)
  1838.     regsub -all {%n} $cmd [list $node] cmd
  1839.     regsub -all {%i} $cmd [list $icon] cmd
  1840.     
  1841.     uplevel \#0 $cmd
  1842.     }
  1843.     return {}
  1844. }
  1845.  
  1846. # ----------------------------------------------------------------------
  1847. # PROTECTED METHOD: _imageSelect node icon
  1848. #
  1849. # Used internally to upon selection of user icons.  The -imagecommand
  1850. # is executed after substitution of the node for %n.
  1851. #
  1852. # Douglas R. Howard, Jr.
  1853. # ----------------------------------------------------------------------
  1854. itcl::body iwidgets::Hierarchy::_imageSelect {node} {
  1855.     if {$itk_option(-imagecommand) != {}} {
  1856.     set cmd $itk_option(-imagecommand)
  1857.     regsub -all {%n} $cmd [list $node] cmd
  1858.     
  1859.     uplevel \#0 $cmd
  1860.     }
  1861.     return {}
  1862. }
  1863.  
  1864. # ----------------------------------------------------------------------
  1865. # PROTECTED METHOD: _imageDblClick node
  1866. #
  1867. # Used internally to upon double selection of images.  The 
  1868. # -imagedblcommand is executed.
  1869. #
  1870. # Douglas R. Howard, Jr.
  1871. # ----------------------------------------------------------------------
  1872. itcl::body iwidgets::Hierarchy::_imageDblClick {node} {
  1873.     if {$itk_option(-imagedblcommand) != {}} {
  1874.     set cmd $itk_option(-imagedblcommand)
  1875.     regsub -all {%n} $cmd [list $node] cmd
  1876.     
  1877.     uplevel \#0 $cmd
  1878.     }
  1879.     return {}
  1880. }
  1881.  
  1882. # ----------------------------------------------------------------------
  1883. # PROTECTED METHOD: _deselectSubNodes uid
  1884. #
  1885. # Used internally to recursively deselect all the nodes beneath a 
  1886. # particular node.
  1887. # ----------------------------------------------------------------------
  1888. itcl::body iwidgets::Hierarchy::_deselectSubNodes {uid} {
  1889.     foreach node $_nodes($uid) {
  1890.     if {[array names _selected $node] != {}} {
  1891.         unset _selected($node)
  1892.     }
  1893.     
  1894.     if {[array names _nodes $node] != {}} {
  1895.         _deselectSubNodes $node
  1896.     }
  1897.     }
  1898. }
  1899.  
  1900. # ----------------------------------------------------------------------
  1901. # PROTECTED METHOD: _deleteNodeInfo uid
  1902. #
  1903. # Used internally to recursively delete all the information about a
  1904. # node and its decendents.
  1905. # ----------------------------------------------------------------------
  1906. itcl::body iwidgets::Hierarchy::_deleteNodeInfo {uid} {
  1907.     #
  1908.     # Recursively call ourseleves as we go down the hierarchy beneath
  1909.     # this node.
  1910.     #
  1911.     if {[info exists _nodes($uid)]} {
  1912.     foreach node $_nodes($uid) {
  1913.         if {[array names _nodes $node] != {}} {
  1914.         _deleteNodeInfo $node
  1915.         }
  1916.     }
  1917.     }
  1918.  
  1919.     #
  1920.     # Unset any entries in our arrays for the node.
  1921.     #
  1922.     catch {unset _nodes($uid)}
  1923.     catch {unset _text($uid)}
  1924.     catch {unset _tags($uid)}
  1925.     catch {unset _icons($uid)}
  1926.     catch {unset _states($uid)}
  1927.     catch {unset _images($uid)}
  1928.     catch {unset _indents($uid)}
  1929. }
  1930.  
  1931. # ----------------------------------------------------------------------
  1932. # PROTECTED METHOD: _getParent uid
  1933. #
  1934. # Used internally to determine the parent for a node.
  1935. # ----------------------------------------------------------------------
  1936. itcl::body iwidgets::Hierarchy::_getParent {uid} {
  1937.     foreach node [array names _nodes] {
  1938.     if {[set index [lsearch $_nodes($node) $uid]] != -1} {
  1939.         return $node
  1940.     }
  1941.     }
  1942. }
  1943.  
  1944. # ----------------------------------------------------------------------
  1945. # PROTECTED METHOD: _getHeritage uid
  1946. #
  1947. # Used internally to determine the list of parents for a node.
  1948. # ----------------------------------------------------------------------
  1949. itcl::body iwidgets::Hierarchy::_getHeritage {uid} {
  1950.     set parents {}
  1951.  
  1952.     if {[set parent [_getParent $uid]] != {}} {
  1953.     lappend parents $parent
  1954.     }
  1955.  
  1956.     return $parents
  1957. }
  1958.  
  1959. # ----------------------------------------------------------------------
  1960. # PROTECTED METHOD (could be proc?): _isInternalTag tag
  1961. #
  1962. # Used internally to tags not to used for user callback commands
  1963. # ----------------------------------------------------------------------
  1964. itcl::body iwidgets::Hierarchy::_isInternalTag {tag} {
  1965.    set ii [expr {[lsearch -exact {info hilite lowlite unknown} $tag] != -1}];
  1966.    return $ii;
  1967. }
  1968.  
  1969. # ----------------------------------------------------------------------
  1970. # PRIVATE METHOD: _configureTags
  1971. #
  1972. # This method added to fix SF ticket #596111.  When the -querycommand
  1973. # is reset after initial construction, the text component loses its
  1974. # tag configuration.  This method resets the hilite, lowlite, and info
  1975. # tags.  csmith: 9/5/02
  1976. # ----------------------------------------------------------------------
  1977. itcl::body iwidgets::Hierarchy::_configureTags {} {
  1978.   tag configure hilite -background $itk_option(-selectbackground) \
  1979.     -foreground $itk_option(-selectforeground)
  1980.   tag configure lowlite -background $itk_option(-markbackground) \
  1981.     -foreground $itk_option(-markforeground)
  1982.   tag configure info -font $itk_option(-font) -spacing1 6
  1983. }
  1984.