home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets3.0.0 / scripts / hierarchy.itk < prev    next >
Text File  |  1999-02-24  |  56KB  |  1,655 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.2 1998/08/11 14:42:07 welch 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. 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 -expanded expanded Expanded 0 
  84.     itk_option define -filter filter Filter 0 
  85.     itk_option define -font font Font \
  86.     -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 
  87.     itk_option define -height height Height 0
  88.     itk_option define -iconcommand iconCommand Command {}
  89.     itk_option define -markbackground markBackground Foreground #a0a0a0 
  90.     itk_option define -markforeground markForeground Background Black 
  91.     itk_option define -nodeicon nodeIcon Icon {}
  92.     itk_option define -openicon openIcon Icon {}
  93.     itk_option define -querycommand queryCommand Command {}
  94.     itk_option define -selectcommand selectCommand Command {}
  95.     itk_option define -selectbackground selectBackground Foreground #c3c3c3 
  96.     itk_option define -selectforeground selectForeground Background Black 
  97.     itk_option define -visibleitems visibleItems VisibleItems 80x24
  98.     itk_option define -width width Width 0
  99.  
  100.     public method clear {}
  101.     public method collapse {node}
  102.     public method current {}
  103.     public method draw {{when -now}}
  104.     public method expand {node}
  105.     public method mark {op args}
  106.     public method prune {node}
  107.     public method refresh {node}
  108.     public method selection {op args}
  109.     public method toggle {node}
  110.  
  111.     public method bbox {index} 
  112.     public method compare {index1 op index2} 
  113.     public method debug {args} {eval $args}
  114.     public method delete {first {last {}}} 
  115.     public method dlineinfo {index} 
  116.     public method dump {args}
  117.     public method get {index1 {index2 {}}} 
  118.     public method index {index} 
  119.     public method insert {args} 
  120.     public method scan {option args} 
  121.     public method search {args} 
  122.     public method see {index} 
  123.     public method tag {op args} 
  124.     public method window {option args} 
  125.     public method xview {args}
  126.     public method yview {args}
  127.  
  128.     protected method _contents {uid}
  129.     protected method _iconSelect {node icon}
  130.     protected method _post {x y}
  131.     protected method _drawLevel {node indent}
  132.     protected method _select {x y}
  133.     protected method _deselectSubNodes {uid}
  134.     protected method _deleteNodeInfo {uid}
  135.     protected method _getParent {uid}
  136.     protected method _getHeritage {uid}
  137.     protected method _isInternalTag {tag}
  138.  
  139.     private variable _filterCode ""  ;# Compact view flag.
  140.     private variable _hcounter 0     ;# Counter for hierarchy icons
  141.     private variable _icons          ;# Array of user icons by uid
  142.     private variable _images         ;# Array of our icons by uid
  143.     private variable _indents        ;# Array of indentation by uid
  144.     private variable _marked         ;# Array of marked nodes by uid
  145.     private variable _markers ""     ;# List of markers for level being drawn
  146.     private variable _nodes          ;# List of subnodes by uid
  147.     private variable _pending ""     ;# Pending draw flag
  148.     private variable _posted ""      ;# List of tags at posted menu position
  149.     private variable _selected       ;# Array of selected nodes by uid
  150.     private variable _tags           ;# Array of user tags by uid
  151.     private variable _text           ;# Array of displayed text by uid
  152.     private variable _states         ;# Array of selection state by uid
  153.     private variable _ucounter 0     ;# Counter for user icons
  154. }
  155.  
  156. #
  157. # Provide a lowercased access method for the Hierarchy class.
  158. # 
  159. proc ::iwidgets::hierarchy {pathName args} {
  160.     uplevel ::iwidgets::Hierarchy $pathName $args
  161. }
  162.  
  163. #
  164. # Use option database to override default resources of base classes.
  165. #
  166. option add *Hierarchy.menuCursor arrow widgetDefault
  167. option add *Hierarchy.labelPos n widgetDefault
  168. option add *Hierarchy.tabs 30 widgetDefault
  169.  
  170. # ------------------------------------------------------------------
  171. #                        CONSTRUCTOR
  172. # ------------------------------------------------------------------
  173. body iwidgets::Hierarchy::constructor {args} {
  174.     itk_option remove iwidgets::Labeledwidget::state
  175.  
  176.     #
  177.     # Our -width and -height options are slightly different than
  178.     # those implemented by our base class, so we're going to
  179.     # remove them and redefine our own.
  180.     #
  181.     itk_option remove iwidgets::Scrolledwidget::width
  182.     itk_option remove iwidgets::Scrolledwidget::height
  183.  
  184.     #
  185.     # Create a clipping frame which will provide the border for
  186.     # relief display.
  187.     #
  188.     itk_component add clipper {
  189.     frame $itk_interior.clipper
  190.     } {
  191.     usual
  192.  
  193.     keep -borderwidth -relief -highlightthickness -highlightcolor
  194.     rename -highlightbackground -background background Background
  195.     }    
  196.     grid $itk_component(clipper) -row 0 -column 0 -sticky nsew
  197.     grid rowconfigure $_interior 0 -weight 1
  198.     grid columnconfigure $_interior 0 -weight 1
  199.  
  200.     #
  201.     # Create a text widget for displaying our hierarchy.
  202.     #
  203.     itk_component add list {
  204.     text $itk_component(clipper).list -wrap none -cursor center_ptr \
  205.                 -state disabled -width 1 -height 1 \
  206.             -xscrollcommand \
  207.         [code $this _scrollWidget $itk_interior.horizsb] \
  208.         -yscrollcommand \
  209.         [code $this _scrollWidget $itk_interior.vertsb] \
  210.             -borderwidth 0 -highlightthickness 0
  211.     } {
  212.     usual
  213.  
  214.     keep -spacing1 -spacing2 -spacing3 -tabs
  215.     rename -font -textfont textFont Font
  216.     rename -background -textbackground textBackground Background
  217.     ignore -highlightthickness -highlightcolor
  218.     ignore -insertbackground -insertborderwidth
  219.     ignore -insertontime -insertofftime -insertwidth
  220.     ignore -selectborderwidth
  221.     ignore -borderwidth
  222.     }
  223.     grid $itk_component(list) -row 0 -column 0 -sticky nsew
  224.     grid rowconfigure $itk_component(clipper) 0 -weight 1
  225.     grid columnconfigure $itk_component(clipper) 0 -weight 1
  226.     
  227.     # 
  228.     # Configure the command on the vertical scroll bar in the base class.
  229.     #
  230.     $itk_component(vertsb) configure \
  231.     -command [code $itk_component(list) yview]
  232.  
  233.     #
  234.     # Configure the command on the horizontal scroll bar in the base class.
  235.     #
  236.     $itk_component(horizsb) configure \
  237.         -command [code $itk_component(list) xview]
  238.     
  239.     #
  240.     # Configure our text component's tab settings for twenty levels.
  241.     #
  242.     set tabs ""
  243.     for {set i 1} {$i < 20} {incr i} {
  244.     lappend tabs [expr $i*12+4]
  245.     }
  246.     $itk_component(list) configure -tabs $tabs
  247.  
  248.     #
  249.     # Add popup menus that can be configured by the user to add
  250.     # new functionality.
  251.     #
  252.     itk_component add itemMenu {
  253.     menu $itk_component(list).itemmenu -tearoff 0
  254.     } {
  255.     usual
  256.     ignore -tearoff
  257.     rename -cursor -menucursor menuCursor Cursor
  258.     }
  259.  
  260.     itk_component add bgMenu {
  261.     menu $itk_component(list).bgmenu -tearoff 0
  262.     } {
  263.     usual
  264.     ignore -tearoff
  265.     rename -cursor -menucursor menuCursor Cursor
  266.     }
  267.  
  268.     #
  269.     # Adjust the bind tags to remove the class bindings.  Also, add
  270.     # bindings for mouse button 1 to do selection and button 3 to 
  271.     # display a popup.
  272.     #
  273.     bindtags $itk_component(list) [list $itk_component(list) . all]
  274.     
  275.     bind $itk_component(list) <ButtonPress-1> \
  276.             [code $this _select %x %y]
  277.  
  278.     bind $itk_component(list) <ButtonPress-3> \
  279.             [code $this _post %x %y]
  280.     
  281.     #
  282.     # Initialize the widget based on the command line options.
  283.     #
  284.     eval itk_initialize $args
  285. }
  286.  
  287. # ------------------------------------------------------------------
  288. #                           DESTRUCTOR
  289. # ------------------------------------------------------------------
  290. body iwidgets::Hierarchy::destructor {} {
  291.     if {$_pending != ""} {
  292.     after cancel $_pending
  293.     }
  294. }
  295.  
  296. # ------------------------------------------------------------------
  297. #                             OPTIONS
  298. # ------------------------------------------------------------------
  299.  
  300. # ------------------------------------------------------------------
  301. # OPTION: -font
  302. #
  303. # Font used for text in the list.
  304. # ------------------------------------------------------------------
  305. configbody iwidgets::Hierarchy::font {
  306.     $itk_component(list) tag configure info \
  307.             -font $itk_option(-font) -spacing1 6
  308. }
  309.  
  310. # ------------------------------------------------------------------
  311. # OPTION: -selectbackground
  312. #
  313. # Background color scheme for selected nodes.
  314. # ------------------------------------------------------------------
  315. configbody iwidgets::Hierarchy::selectbackground {
  316.     $itk_component(list) tag configure hilite \
  317.             -background $itk_option(-selectbackground)
  318. }
  319.  
  320. # ------------------------------------------------------------------
  321. # OPTION: -selectforeground
  322. #
  323. # Foreground color scheme for selected nodes.
  324. # ------------------------------------------------------------------
  325. configbody iwidgets::Hierarchy::selectforeground {
  326.     $itk_component(list) tag configure hilite \
  327.             -foreground $itk_option(-selectforeground)
  328. }
  329.  
  330. # ------------------------------------------------------------------
  331. # OPTION: -markbackground
  332. #
  333. # Background color scheme for marked nodes.
  334. # ------------------------------------------------------------------
  335. configbody iwidgets::Hierarchy::markbackground {
  336.     $itk_component(list) tag configure lowlite \
  337.             -background $itk_option(-markbackground)
  338. }
  339.  
  340. # ------------------------------------------------------------------
  341. # OPTION: -markforeground
  342. #
  343. # Foreground color scheme for marked nodes.
  344. # ------------------------------------------------------------------
  345. configbody iwidgets::Hierarchy::markforeground {
  346.     $itk_component(list) tag configure lowlite \
  347.             -foreground $itk_option(-markforeground)
  348. }
  349.  
  350. # ------------------------------------------------------------------
  351. # OPTION: -querycommand
  352. #
  353. # Command executed to query the contents of each node.  If this 
  354. # command contains "%n", it is replaced with the name of the desired 
  355. # node.  In its simpilest form it should return the children of the 
  356. # given node as a list which will be depicted in the display.
  357. #
  358. # Since the names of the children are used as tags in the underlying 
  359. # text widget, each child must be unique in the hierarchy.  Due to
  360. # the unique requirement, the nodes shall be reffered to as uids 
  361. # or uid in the singular sense.
  362. # 
  363. #   {uid [uid ...]}
  364. #
  365. #   where uid is a unique id and primary key for the hierarchy entry
  366. #
  367. # Should the unique requirement pose a problem, the list returned
  368. # can take on another more extended form which enables the 
  369. # association of text to be displayed with the uids.  The uid must
  370. # still be unique, but the text does not have to obey the unique
  371. # rule.  In addition, the format also allows the specification of
  372. # additional tags to be used on the same entry in the hierarchy
  373. # as the uid and additional icons to be displayed just before
  374. # the node.  The tags and icons are considered to be the property of
  375. # the user in that the hierarchy widget will not depend on any of 
  376. # their values.
  377. #
  378. #   {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
  379. #
  380. #   where uid is a unique id and primary key for the hierarchy entry
  381. #         text is the text to be displayed for this uid
  382. #         tags is a list of user tags to be applied to the entry
  383. #         icons is a list of icons to be displayed in front of the text
  384. #
  385. # The hierarchy widget does a look ahead from each node to determine
  386. # if the node has a children.  This can be cost some performace with
  387. # large hierarchies.  User's can avoid this by providing a hint in
  388. # the user tags.  A tag of "leaf" or "branch" tells the hierarchy
  389. # widget the information it needs to know thereby avoiding the look
  390. # ahead operation.
  391. # ------------------------------------------------------------------
  392. configbody iwidgets::Hierarchy::querycommand {
  393.     clear
  394.     draw -eventually
  395. }
  396.  
  397. # ------------------------------------------------------------------
  398. # OPTION: -selectcommand
  399. #
  400. # Command executed to select an item in the list.  If this command
  401. # contains "%n", it is replaced with the name of the selected node.  
  402. # If it contains a "%s", it is replaced with a boolean indicator of 
  403. # the node's current selection status, where a value of 1 denotes
  404. # that the node is currently selected and 0 that it is not.
  405. # ------------------------------------------------------------------
  406. configbody iwidgets::Hierarchy::selectcommand {
  407. }
  408.  
  409. # ------------------------------------------------------------------
  410. # OPTION: -iconcommand
  411. #
  412. # Command executed upon selection of user icons.  If this command 
  413. # contains "%n", it is replaced with the name of the node the icon
  414. # belongs to.  Should it contain "%i" then the icon name is 
  415. # substituted.
  416. # ------------------------------------------------------------------
  417. configbody iwidgets::Hierarchy::iconcommand {
  418. }
  419.  
  420. # ------------------------------------------------------------------
  421. # OPTION: -alwaysquery
  422. #
  423. # Boolean flag which tells the hierarchy widget weather or not
  424. # each refresh of the display should be via a new query using
  425. # the -querycommand option or use the values previous found the
  426. # last time the query was made.
  427. # ------------------------------------------------------------------
  428. configbody iwidgets::Hierarchy::alwaysquery {
  429. }
  430.  
  431. # ------------------------------------------------------------------
  432. # OPTION: -filter
  433. #
  434. # When true only the branch nodes and selected items are displayed.
  435. # This gives a compact view of important items.
  436. # ------------------------------------------------------------------
  437. configbody iwidgets::Hierarchy::filter {
  438.     switch -- $itk_option(-filter) {
  439.     1 - true - yes - on {
  440.         set newCode {set display [info exists _selected($child)]}
  441.     }
  442.     0 - false - no - off {
  443.         set newCode {set display 1}
  444.     }
  445.     default {
  446.         error "bad filter option \"$itk_option(-filter)\":\
  447.                    should be boolean"
  448.     }
  449.     }
  450.     if {$newCode != $_filterCode} {
  451.     set _filterCode $newCode
  452.     draw -eventually
  453.     }
  454. }
  455.  
  456. # ------------------------------------------------------------------
  457. # OPTION: -expanded
  458. #
  459. # When true, the hierarchy will be completely expanded when it
  460. # is first displayed.  A fresh display can be triggered by
  461. # resetting the -querycommand option.
  462. # ------------------------------------------------------------------
  463. configbody iwidgets::Hierarchy::expanded {
  464.     switch -- $itk_option(-expanded) {
  465.     1 - true - yes - on {
  466.         ;# okay
  467.     }
  468.     0 - false - no - off {
  469.         ;# okay
  470.     }
  471.     default {
  472.         error "bad expanded option \"$itk_option(-expanded)\":\
  473.                    should be boolean"
  474.     }
  475.     }
  476. }
  477.     
  478. # ------------------------------------------------------------------
  479. # OPTION: -openicon
  480. #
  481. # Specifies the open icon image to be used in the hierarchy.  Should
  482. # one not be provided, then one will be generated, pixmap if 
  483. # possible, bitmap otherwise.
  484. # ------------------------------------------------------------------
  485. configbody iwidgets::Hierarchy::openicon {
  486.     if {$itk_option(-openicon) == {}} {
  487.     if {[lsearch [image names] openFolder] == -1} {
  488.         if {[lsearch [image types] pixmap] != -1} {
  489.         image create pixmap openFolder -data {
  490.             /* XPM */
  491.             static char * dir_opened [] = {
  492.             "16 16 4 1",
  493.             /* colors */
  494.             ". c grey85 m white g4 grey90",
  495.             "b c black  m black g4 black",
  496.             "y c yellow m white g4 grey80",
  497.             "g c grey70 m white g4 grey70",
  498.             /* pixels */
  499.             "................",
  500.             "................",
  501.             "................",
  502.             "..bbbb..........",
  503.             ".bggggb.........",
  504.             "bggggggbbbbbbb..",
  505.             "bggggggggggggb..",
  506.             "bgbbbbbbbbbbbbbb",
  507.             "bgbyyyyyyyyyyybb",
  508.             "bbyyyyyyyyyyyyb.",
  509.             "bbyyyyyyyyyyybb.",
  510.             "byyyyyyyyyyyyb..",
  511.             "bbbbbbbbbbbbbb..",
  512.             "................",
  513.             "................",
  514.             "................"};
  515.         }
  516.         } else {
  517.         image create bitmap openFolder -data {
  518.             #define open_width 16
  519.             #define open_height 16
  520.             static char open_bits[] = {
  521.             0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00, 
  522.             0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0, 
  523.             0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,
  524.             0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  525.         }
  526.         }
  527.  
  528.         set itk_option(-openicon) openFolder
  529.     }
  530.  
  531.     } else {
  532.     if {[lsearch [image names] $itk_option(-openicon)] == -1} {
  533.         error "bad openicon option \"$itk_option(-openicon)\":\
  534.                    should be an existing image"
  535.     }
  536.     }
  537. }
  538.  
  539. # ------------------------------------------------------------------
  540. # OPTION: -closedicon
  541. #
  542. # Specifies the closed icon image to be used in the hierarchy.  
  543. # Should one not be provided, then one will be generated, pixmap if 
  544. # possible, bitmap otherwise.
  545. # ------------------------------------------------------------------
  546. configbody iwidgets::Hierarchy::closedicon {
  547.     if {$itk_option(-closedicon) == {}} {
  548.     if {[lsearch [image names] closedFolder] == -1} {
  549.         if {[lsearch [image types] pixmap] != -1} {
  550.         image create pixmap closedFolder -data {
  551.             /* XPM */
  552.             static char *dir_closed[] = {
  553.             "16 16 3 1",
  554.             ". c grey85 m white g4 grey90",
  555.             "b c black  m black g4 black",
  556.             "y c yellow m white g4 grey80",
  557.             "................",
  558.             "................",
  559.             "................",
  560.             "..bbbb..........",
  561.             ".byyyyb.........",
  562.             "bbbbbbbbbbbbbb..",
  563.             "byyyyyyyyyyyyb..",
  564.             "byyyyyyyyyyyyb..",
  565.             "byyyyyyyyyyyyb..",
  566.             "byyyyyyyyyyyyb..",
  567.             "byyyyyyyyyyyyb..",
  568.             "byyyyyyyyyyyyb..",
  569.             "bbbbbbbbbbbbbb..",
  570.             "................",
  571.             "................",
  572.             "................"};    
  573.         }
  574.         } else {
  575.         image create bitmap closedFolder -data {
  576.             #define closed_width 16
  577.             #define closed_height 16
  578.             static char closed_bits[] = {
  579.             0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00, 
  580.             0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 
  581.             0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
  582.             0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  583.         }
  584.         }
  585.  
  586.         set itk_option(-closedicon) closedFolder
  587.     }
  588.  
  589.     } else {
  590.     if {[lsearch [image names] $itk_option(-closedicon)] == -1} {
  591.         error "bad closedicon option \"$itk_option(-closedicon)\":\
  592.                    should be an existing image"
  593.     }
  594.     }
  595. }
  596.  
  597. # ------------------------------------------------------------------
  598. # OPTION: -nodeicon
  599. #
  600. # Specifies the node icon image to be used in the hierarchy.  Should 
  601. # one not be provided, then one will be generated, pixmap if 
  602. # possible, bitmap otherwise.
  603. # ------------------------------------------------------------------
  604. configbody iwidgets::Hierarchy::nodeicon {
  605.     if {$itk_option(-nodeicon) == {}} {
  606.     if {[lsearch [image names] nodeFolder] == -1} {
  607.         if {[lsearch [image types] pixmap] != -1} {
  608.         image create pixmap nodeFolder -data {
  609.             /* XPM */
  610.             static char *dir_node[] = {
  611.             "16 16 3 1",
  612.             ". c grey85 m white g4 grey90",
  613.             "b c black  m black g4 black",
  614.             "y c yellow m white g4 grey80",
  615.             "................",
  616.             "................",
  617.             "................",
  618.             "...bbbbbbbbbbb..",
  619.             "..bybyyyyyyyyb..",
  620.             ".byybyyyyyyyyb..",
  621.             "byyybyyyyyyyyb..",
  622.             "bbbbbyyyyyyyyb..",
  623.             "byyyyyyyyyyyyb..",
  624.             "byyyyyyyyyyyyb..",
  625.             "byyyyyyyyyyyyb..",
  626.             "byyyyyyyyyyyyb..",
  627.             "bbbbbbbbbbbbbb..",
  628.             "................",
  629.             "................",
  630.             "................"};    
  631.         }
  632.         } else {
  633.         image create bitmap nodeFolder -data {
  634.             #define node_width 16
  635.             #define node_height 16
  636.             static char node_bits[] = {
  637.             0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40, 
  638.             0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40, 
  639.             0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
  640.             0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  641.         }
  642.         }
  643.  
  644.         set itk_option(-nodeicon) nodeFolder
  645.     }
  646.  
  647.     } else {
  648.     if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {
  649.         error "bad nodeicon option \"$itk_option(-nodeicon)\":\
  650.                    should be an existing image"
  651.     }
  652.     }
  653. }
  654.  
  655. # ------------------------------------------------------------------
  656. # OPTION: -width
  657. #
  658. # Specifies the width of the hierarchy widget as an entire unit.
  659. # The value may be specified in any of the forms acceptable to 
  660. # Tk_GetPixels.  Any additional space needed to display the other
  661. # components such as labels, margins, and scrollbars force the text
  662. # to be compressed.  A value of zero along with the same value for 
  663. # the height causes the value given for the visibleitems option 
  664. # to be applied which administers geometry constraints in a different
  665. # manner.
  666. # ------------------------------------------------------------------
  667. configbody iwidgets::Hierarchy::width {
  668.     if {$itk_option(-width) != 0} {
  669.     set shell [lindex [grid info $itk_component(clipper)] 1]
  670.  
  671.     #
  672.     # Due to a bug in the tk4.2 grid, we have to check the 
  673.     # propagation before setting it.  Setting it to the same
  674.     # value it already is will cause it to toggle.
  675.     #
  676.     if {[grid propagate $shell]} {
  677.         grid propagate $shell no
  678.     }
  679.     
  680.     $itk_component(list) configure -width 1
  681.     $shell configure \
  682.         -width [winfo pixels $shell $itk_option(-width)] 
  683.     } else {
  684.     configure -visibleitems $itk_option(-visibleitems)
  685.     }
  686. }
  687.  
  688. # ------------------------------------------------------------------
  689. # OPTION: -height
  690. #
  691. # Specifies the height of the hierarchy widget as an entire unit.
  692. # The value may be specified in any of the forms acceptable to 
  693. # Tk_GetPixels.  Any additional space needed to display the other
  694. # components such as labels, margins, and scrollbars force the text
  695. # to be compressed.  A value of zero along with the same value for 
  696. # the width causes the value given for the visibleitems option 
  697. # to be applied which administers geometry constraints in a different
  698. # manner.
  699. # ------------------------------------------------------------------
  700. configbody iwidgets::Hierarchy::height {
  701.     if {$itk_option(-height) != 0} {
  702.     set shell [lindex [grid info $itk_component(clipper)] 1]
  703.  
  704.     #
  705.     # Due to a bug in the tk4.2 grid, we have to check the 
  706.     # propagation before setting it.  Setting it to the same
  707.     # value it already is will cause it to toggle.
  708.     #
  709.     if {[grid propagate $shell]} {
  710.         grid propagate $shell no
  711.     }
  712.     
  713.     $itk_component(list) configure -height 1
  714.     $shell configure \
  715.         -height [winfo pixels $shell $itk_option(-height)] 
  716.     } else {
  717.     configure -visibleitems $itk_option(-visibleitems)
  718.     }
  719. }
  720.  
  721. # ------------------------------------------------------------------
  722. # OPTION: -visibleitems
  723. #
  724. # Specified the widthxheight in characters and lines for the text.
  725. # This option is only administered if the width and height options
  726. # are both set to zero, otherwise they take precedence.  With the
  727. # visibleitems option engaged, geometry constraints are maintained
  728. # only on the text.  The size of the other components such as 
  729. # labels, margins, and scroll bars, are additive and independent, 
  730. # effecting the overall size of the scrolled text.  In contrast,
  731. # should the width and height options have non zero values, they
  732. # are applied to the scrolled text as a whole.  The text is 
  733. # compressed or expanded to maintain the geometry constraints.
  734. # ------------------------------------------------------------------
  735. configbody iwidgets::Hierarchy::visibleitems {
  736.     if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
  737.     if {($itk_option(-width) == 0) && \
  738.         ($itk_option(-height) == 0)} {
  739.         set chars [lindex [split $itk_option(-visibleitems) x] 0]
  740.         set lines [lindex [split $itk_option(-visibleitems) x] 1]
  741.         
  742.         set shell [lindex [grid info $itk_component(clipper)] 1]
  743.  
  744.         #
  745.         # Due to a bug in the tk4.2 grid, we have to check the 
  746.         # propagation before setting it.  Setting it to the same
  747.         # value it already is will cause it to toggle.
  748.         #
  749.         if {! [grid propagate $shell]} {
  750.         grid propagate $shell yes
  751.         }
  752.         
  753.         $itk_component(list) configure -width $chars -height $lines
  754.     }
  755.     
  756.     } else {
  757.     error "bad visibleitems option\
  758.         \"$itk_option(-visibleitems)\": should be\
  759.         widthxheight"
  760.     }
  761. }
  762.  
  763. # ------------------------------------------------------------------
  764. #                         PUBLIC METHODS
  765. # ------------------------------------------------------------------
  766.  
  767. # ----------------------------------------------------------------------
  768. # PUBLIC METHOD: clear
  769. #
  770. # Removes all items from the display including all tags and icons.  
  771. # The display will remain empty until the -filter or -querycommand 
  772. # options are set.
  773. # ----------------------------------------------------------------------
  774. body iwidgets::Hierarchy::clear {} {
  775.     $itk_component(list) configure -state normal -cursor watch
  776.     $itk_component(list) delete 1.0 end
  777.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  778.     
  779.     catch {unset _nodes}
  780.     catch {unset _text}
  781.     catch {unset _tags}
  782.     catch {unset _icons}
  783.     catch {unset _states}
  784.     catch {unset _images}
  785.     catch {unset _indents}
  786.  
  787.     return
  788. }
  789.  
  790. # ----------------------------------------------------------------------
  791. # PUBLIC METHOD: selection option ?uid uid...?
  792. #
  793. # Handles all operations controlling selections in the hierarchy.
  794. # Selections may be cleared, added, removed, or queried.  The add and
  795. # remove options accept a series of unique ids.
  796. # ----------------------------------------------------------------------
  797. body iwidgets::Hierarchy::selection {op args} {
  798.     switch -- $op {
  799.         clear {
  800.             $itk_component(list) tag remove hilite 1.0 end
  801.             catch {unset _selected}
  802.         return
  803.         }
  804.         add {
  805.             foreach node $args {
  806.                 set _selected($node) 1
  807.                 catch {
  808.                     $itk_component(list) tag add hilite \
  809.                 "$node.first" "$node.last"
  810.                 }
  811.             }
  812.         }
  813.         remove {
  814.             foreach node $args {
  815.                 catch {
  816.                     unset _selected($node)
  817.                     $itk_component(list) tag remove hilite \
  818.                 "$node.first" "$node.last"
  819.                 }
  820.             }
  821.         }
  822.     get {
  823.         return [array names _selected]
  824.     }
  825.         default {
  826.             error "bad selection operation \"$op\":\
  827.                    should be add, remove, clear or get"
  828.         }
  829.     }
  830. }
  831.  
  832. # ----------------------------------------------------------------------
  833. # PUBLIC METHOD: mark option ?arg arg...?
  834. #
  835. # Handles all operations controlling marks in the hierarchy.  Marks may 
  836. # be cleared, added, removed, or queried.  The add and remove options 
  837. # accept a series of unique ids.
  838. # ----------------------------------------------------------------------
  839. body iwidgets::Hierarchy::mark {op args} {
  840.     switch -- $op {
  841.         clear {
  842.             $itk_component(list) tag remove lowlite 1.0 end
  843.             catch {unset _marked}
  844.         return
  845.         }
  846.         add {
  847.             foreach node $args {
  848.                 set _marked($node) 1
  849.                 catch {
  850.                     $itk_component(list) tag add lowlite \
  851.                 "$node.first" "$node.last"
  852.                 }
  853.             }
  854.         }
  855.         remove {
  856.             foreach node $args {
  857.                 catch {
  858.                     unset _marked($node)
  859.                     $itk_component(list) tag remove lowlite \
  860.                 "$node.first" "$node.last"
  861.                 }
  862.             }
  863.         }
  864.     get {
  865.         return [array names _marked]
  866.     }
  867.         default {
  868.             error "bad mark operation \"$op\":\
  869.                    should be add, remove, clear or get"
  870.         }
  871.     }
  872. }
  873.  
  874. # ----------------------------------------------------------------------
  875. # PUBLIC METHOD: current
  876. #
  877. # Returns the node that was most recently selected by the right mouse
  878. # button when the item menu was posted.  Usually used by the code
  879. # in the item menu to figure out what item is being manipulated.
  880. # ----------------------------------------------------------------------
  881. body iwidgets::Hierarchy::current {} {
  882.     return $_posted
  883. }
  884.  
  885. # ----------------------------------------------------------------------
  886. # PUBLIC METHOD: expand node
  887. #
  888. # Expands the hierarchy beneath the specified node.  Since this can take
  889. # a moment for large hierarchies, the cursor will be changed to a watch
  890. # during the expansion.
  891. # ----------------------------------------------------------------------
  892. body iwidgets::Hierarchy::expand {node} {
  893.     if {! [info exists _states($node)]} {
  894.     error "bad expand node argument: \"$node\", the node doesn't exist"
  895.     }
  896.  
  897.     if {!$_states($node) && \
  898.         (([lsearch $_tags($node) branch] != -1) || \
  899.          ([llength [_contents $node]] > 0))} {
  900.         $itk_component(list) configure -state normal -cursor watch
  901.         update
  902.  
  903.     #
  904.     # Get the indentation level for the node.
  905.     #
  906.         set indent $_indents($node)
  907.  
  908.         set _markers ""
  909.         $itk_component(list) mark set insert "$node:start"
  910.         _drawLevel $node $indent
  911.  
  912.     #
  913.     # Following the draw, all our markers need adjusting.
  914.     #
  915.         foreach {name index} $_markers {
  916.             $itk_component(list) mark set $name $index
  917.         }
  918.  
  919.     #
  920.     # Set the image to be the open icon, denote the new state,
  921.     # and set the cursor back to normal along with the state.
  922.     #
  923.     $_images($node) configure -image $itk_option(-openicon)
  924.  
  925.         set _states($node) 1
  926.  
  927.         $itk_component(list) configure -state disabled \
  928.         -cursor $itk_option(-cursor)
  929.     }
  930. }
  931.  
  932. # ----------------------------------------------------------------------
  933. # PUBLIC METHOD: collapse node
  934. #
  935. # Collapses the hierarchy beneath the specified node.  Since this can 
  936. # take a moment for large hierarchies, the cursor will be changed to a 
  937. # watch during the expansion.
  938. # ----------------------------------------------------------------------
  939. body iwidgets::Hierarchy::collapse {node} {
  940.     if {! [info exists _states($node)]} {
  941.     error "bad collapse node argument: \"$node\", the node doesn't exist"
  942.     }
  943.  
  944.     if {[info exists _states($node)] && $_states($node) && \
  945.         (([lsearch $_tags($node) branch] != -1) || \
  946.          ([llength [_contents $node]] > 0))} {
  947.         $itk_component(list) configure -state normal -cursor watch
  948.     update
  949.  
  950.     _deselectSubNodes $node
  951.  
  952.         $itk_component(list) delete "$node:start" "$node:end"
  953.  
  954.     catch {$_images($node) configure -image $itk_option(-closedicon)}
  955.  
  956.         set _states($node) 0
  957.  
  958.         $itk_component(list) configure -state disabled \
  959.         -cursor $itk_option(-cursor)
  960.     }
  961. }
  962.  
  963. # ----------------------------------------------------------------------
  964. # PUBLIC METHOD: toggle node
  965. #
  966. # Toggles the hierarchy beneath the specified node.  If the hierarchy
  967. # is currently expanded, then it is collapsed, and vice-versa.
  968. # ----------------------------------------------------------------------
  969. body iwidgets::Hierarchy::toggle {node} {
  970.     if {! [info exists _states($node)]} {
  971.     error "bad toggle node argument: \"$node\", the node doesn't exist"
  972.     }
  973.  
  974.     if {$_states($node)} {
  975.         collapse $node
  976.     } else {
  977.         expand $node
  978.     }
  979. }
  980.  
  981. # ----------------------------------------------------------------------
  982. # PUBLIC METHOD: prune node
  983. #
  984. # Removes a particular node from the hierarchy.
  985. # ----------------------------------------------------------------------
  986. body iwidgets::Hierarchy::prune {node} {
  987.     #
  988.     # While we're working, change the state and cursor so we can
  989.     # edit the text and give a busy visual clue.
  990.     #
  991.     $itk_component(list) configure -state normal -cursor watch
  992.  
  993.     #
  994.     # Recursively delete all the subnode information from our internal
  995.     # arrays and remove all the tags.  
  996.     #
  997.     _deleteNodeInfo $node
  998.  
  999.     #
  1000.     # If the mark $node:end exists then the node has decendents so
  1001.     # so we'll remove from the mark $node:start to $node:end in order 
  1002.     # to delete all the subnodes below it in the text.  
  1003.     # 
  1004.     if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {
  1005.     $itk_component(list) delete $node:start $node:end
  1006.     $itk_component(list) mark unset $node:end
  1007.     } 
  1008.  
  1009.     #
  1010.     # Next we need to remove the node itself.  Using the ranges for
  1011.     # its tag we'll remove it from line start to the end plus one
  1012.     # character which takes us to the start of the next node.
  1013.     #
  1014.     foreach {start end} [$itk_component(list) tag ranges $node] {
  1015.     $itk_component(list) delete "$start linestart" "$end + 1 char"
  1016.     }
  1017.  
  1018.     #
  1019.     # Delete the tag for this node.
  1020.     #
  1021.     $itk_component(list) tag delete $node
  1022.  
  1023.     #
  1024.     # The node must be removed from the list of subnodes for its parent.
  1025.     # We don't really have a clean way to do upwards referencing, so
  1026.     # the dirty way will have to do.  We'll cycle through each node
  1027.     # and if this node is in its list of subnodes, we'll remove it.
  1028.     #
  1029.     foreach uid [array names _nodes] {
  1030.     if {[set index [lsearch $_nodes($uid) $node]] != -1} {
  1031.         set _nodes($uid) [lreplace $_nodes($uid) $index $index]
  1032.     }
  1033.     }
  1034.  
  1035.     #
  1036.     # We're done, so change the state and cursor back to their 
  1037.     # original values.
  1038.     #
  1039.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1040. }
  1041.  
  1042. # ----------------------------------------------------------------------
  1043. # PUBLIC METHOD: draw ?when?
  1044. #
  1045. # Performs a complete draw of the entire hierarchy.
  1046. # ----------------------------------------------------------------------
  1047. body iwidgets::Hierarchy::draw {{when -now}} {
  1048.     if {$when == "-eventually"} {
  1049.         if {$_pending == ""} {
  1050.             set _pending [after idle [code $this draw -now]]
  1051.         }
  1052.         return
  1053.     } elseif {$when != "-now"} {
  1054.         error "bad when option \"$when\": should be -eventually or -now"
  1055.     }
  1056.     $itk_component(list) configure -state normal -cursor watch
  1057.     update
  1058.  
  1059.     $itk_component(list) delete 1.0 end
  1060.     catch {unset _images}
  1061.     set _markers ""
  1062.  
  1063.     _drawLevel "" ""
  1064.  
  1065.     foreach {name index} $_markers {
  1066.         $itk_component(list) mark set $name $index
  1067.     }
  1068.  
  1069.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1070.     set _pending ""
  1071. }
  1072.  
  1073. # ----------------------------------------------------------------------
  1074. # PUBLIC METHOD: refresh node
  1075. #
  1076. # Performs a redraw of a specific node.  If that node is currently 
  1077. # not visible, then no action is taken.
  1078. # ----------------------------------------------------------------------
  1079. body iwidgets::Hierarchy::refresh {node} {
  1080.     if {! [info exists _nodes($node)]} {
  1081.     error "bad refresh node argument: \"$node\", the node doesn't exist"
  1082.     }
  1083.  
  1084.     
  1085.     if {! $_states($node)} {return}
  1086.  
  1087.     foreach parent [_getHeritage $node] {
  1088.     if {! $_states($parent)} {return}
  1089.     }
  1090.  
  1091.     $itk_component(list) configure -state normal -cursor watch
  1092.     $itk_component(list) delete $node:start $node:end
  1093.  
  1094.     set _markers ""
  1095.     $itk_component(list) mark set insert "$node:start"
  1096.     set indent $_indents($node)
  1097.  
  1098.     _drawLevel $node $indent
  1099.  
  1100.     foreach {name index} $_markers {
  1101.         $itk_component(list) mark set $name $index
  1102.     }
  1103.  
  1104.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1105. }
  1106.  
  1107. # ------------------------------------------------------------------
  1108. # THIN WRAPPED TEXT METHODS:
  1109. #
  1110. # The following methods are thin wraps of standard text methods.
  1111. # Consult the Tk text man pages for functionallity and argument
  1112. # documentation.
  1113. # ------------------------------------------------------------------
  1114.  
  1115. # ------------------------------------------------------------------
  1116. # PUBLIC METHOD: bbox index
  1117. #
  1118. # Returns four element list describing the bounding box for the list
  1119. # item at index
  1120. # ------------------------------------------------------------------
  1121. body iwidgets::Hierarchy::bbox {index} {
  1122.     return [$itk_component(list) bbox $index]
  1123. }
  1124.  
  1125. # ------------------------------------------------------------------
  1126. # PUBLIC METHOD compare index1 op index2
  1127. #
  1128. # Compare indices according to relational operator.
  1129. # ------------------------------------------------------------------
  1130. body iwidgets::Hierarchy::compare {index1 op index2} {
  1131.     return [$itk_component(list) compare $index1 $op $index2]
  1132. }
  1133.  
  1134. # ------------------------------------------------------------------
  1135. # PUBLIC METHOD delete first ?last?
  1136. #
  1137. # Delete a range of characters from the text.
  1138. # ------------------------------------------------------------------
  1139. body iwidgets::Hierarchy::delete {first {last {}}} {
  1140.     $itk_component(list) configure -state normal -cursor watch
  1141.     $itk_component(list) delete $first $last
  1142.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1143. }
  1144.  
  1145. # ------------------------------------------------------------------
  1146. # PUBLIC METHOD dump ?switches? index1 ?index2?
  1147. #
  1148. # Returns information about the contents of the text widget from 
  1149. # index1 to index2.
  1150. # ------------------------------------------------------------------
  1151. body iwidgets::Hierarchy::dump {args} {
  1152.     return [eval $itk_component(list) dump $args]
  1153. }
  1154.  
  1155. # ------------------------------------------------------------------
  1156. # PUBLIC METHOD dlineinfo index
  1157. #
  1158. # Returns a five element list describing the area occupied by the
  1159. # display line containing index.
  1160. # ------------------------------------------------------------------
  1161. body iwidgets::Hierarchy::dlineinfo {index} {
  1162.     return [$itk_component(list) dlineinfo $index]
  1163. }
  1164.  
  1165. # ------------------------------------------------------------------
  1166. # PUBLIC METHOD get index1 ?index2?
  1167. #
  1168. # Return text from start index to end index.
  1169. # ------------------------------------------------------------------
  1170. body iwidgets::Hierarchy::get {index1 {index2 {}}} {
  1171.     return [$itk_component(list) get $index1 $index2]
  1172. }
  1173.  
  1174. # ------------------------------------------------------------------
  1175. # PUBLIC METHOD index index
  1176. #
  1177. # Return position corresponding to index.
  1178. # ------------------------------------------------------------------
  1179. body iwidgets::Hierarchy::index {index} {
  1180.     return [$itk_component(list) index $index]
  1181. }
  1182.  
  1183. # ------------------------------------------------------------------
  1184. # PUBLIC METHOD insert index chars ?tagList?
  1185. #
  1186. # Insert text at index.
  1187. # ------------------------------------------------------------------
  1188. body iwidgets::Hierarchy::insert {args} {
  1189.     $itk_component(list) configure -state normal -cursor watch
  1190.     eval $itk_component(list) insert $args
  1191.     $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
  1192. }
  1193.  
  1194. # ------------------------------------------------------------------
  1195. # PUBLIC METHOD scan option args
  1196. #
  1197. # Implements scanning on texts.
  1198. # ------------------------------------------------------------------
  1199. body iwidgets::Hierarchy::scan {option args} {
  1200.     eval $itk_component(list) scan $option $args
  1201. }
  1202.  
  1203. # ------------------------------------------------------------------
  1204. # PUBLIC METHOD search ?switches? pattern index ?varName?
  1205. #
  1206. # Searches the text for characters matching a pattern.
  1207. # ------------------------------------------------------------------
  1208. body iwidgets::Hierarchy::search {args} {
  1209.     return [eval $itk_component(list) search $args]
  1210. }
  1211.  
  1212. # ------------------------------------------------------------------
  1213. # PUBLIC METHOD see index
  1214. #
  1215. # Adjusts the view in the window so the character at index is 
  1216. # visible.
  1217. # ------------------------------------------------------------------
  1218. body iwidgets::Hierarchy::see {index} {
  1219.     $itk_component(list) see $index
  1220. }
  1221.  
  1222. # ------------------------------------------------------------------
  1223. # PUBLIC METHOD tag option ?arg arg ...?
  1224. #
  1225. # Manipulate tags dependent on options.
  1226. # ------------------------------------------------------------------
  1227. body iwidgets::Hierarchy::tag {op args} {
  1228.     return [eval $itk_component(list) tag $op $args]
  1229. }
  1230.  
  1231. # ------------------------------------------------------------------
  1232. # PUBLIC METHOD window option ?arg arg ...?
  1233. #
  1234. # Manipulate embedded windows.
  1235. # ------------------------------------------------------------------
  1236. body iwidgets::Hierarchy::window {option args} {
  1237.     return [eval $itk_component(list) window $option $args]
  1238. }
  1239.  
  1240. # ----------------------------------------------------------------------
  1241. # PUBLIC METHOD: xview args
  1242. #
  1243. # Thin wrap of the text widget's xview command.
  1244. # ----------------------------------------------------------------------
  1245. body iwidgets::Hierarchy::xview {args} {
  1246.     return [eval itk_component(list) xview $args]
  1247. }
  1248.  
  1249. # ----------------------------------------------------------------------
  1250. # PUBLIC METHOD: yview args
  1251. #
  1252. # Thin wrap of the text widget's yview command.
  1253. # ----------------------------------------------------------------------
  1254. body iwidgets::Hierarchy::yview {args} {
  1255.     return [eval $itk_component(list) yview $args]
  1256. }
  1257.  
  1258. # ------------------------------------------------------------------
  1259. #                       PROTECTED METHODS
  1260. # ------------------------------------------------------------------
  1261.  
  1262. # ----------------------------------------------------------------------
  1263. # PROTECTED METHOD: _drawLevel node indent
  1264. #
  1265. # Used internally by draw to draw one level of the hierarchy.
  1266. # Draws all of the nodes under node, using the indent string to
  1267. # indent nodes.
  1268. # ----------------------------------------------------------------------
  1269. body iwidgets::Hierarchy::_drawLevel {node indent} {
  1270.     lappend _markers "$node:start" [$itk_component(list) index insert]
  1271.     set bg [$itk_component(list) cget -background]
  1272.  
  1273.     #
  1274.     # Obtain the list of subnodes for this node and cycle through
  1275.     # each one displaying it in the hierarchy.
  1276.     #
  1277.     foreach child [_contents $node] {
  1278.     set _images($child) "$itk_component(list).hicon[incr _hcounter]"
  1279.  
  1280.         if {![info exists _states($child)]} {
  1281.             set _states($child) $itk_option(-expanded)
  1282.         }
  1283.  
  1284.     #
  1285.     # Check the user tags to see if they have been kind enough
  1286.     # to tell us ahead of time what type of node we are dealing
  1287.     # with branch or leaf.  If they neglected to do so, then
  1288.     # get the contents of the child node to see if it has children
  1289.     # itself.
  1290.     #
  1291.     set display 0
  1292.  
  1293.     if {[lsearch $_tags($child) leaf] != -1} {
  1294.         set type leaf
  1295.     } elseif {[lsearch $_tags($child) branch] != -1} {
  1296.         set type branch
  1297.     } else {
  1298.         if {[llength [_contents $child]] == 0} {
  1299.         set type leaf
  1300.         } else {
  1301.         set type branch
  1302.         }
  1303.     }
  1304.  
  1305.     #
  1306.     # Now that we know the type of node, branch or leaf, we know
  1307.     # the type of icon to use.
  1308.     #
  1309.     if {$type == "leaf"} {
  1310.             set icon $itk_option(-nodeicon)
  1311.             eval $_filterCode
  1312.     } else {
  1313.             if {$_states($child)} {
  1314.                 set icon $itk_option(-openicon)
  1315.             } else {
  1316.                 set icon $itk_option(-closedicon)
  1317.             }
  1318.             set display 1
  1319.     }
  1320.  
  1321.     #
  1322.     # If display is set then we're going to be drawing this node.
  1323.     # Save off the indentation level for this node and do the indent.
  1324.     #
  1325.     if {$display} {
  1326.         set _indents($child) "$indent\t"
  1327.         $itk_component(list) insert insert $indent
  1328.  
  1329.         #
  1330.         # Add the branch or leaf icon and setup a binding to toggle
  1331.         # its expanded/collapsed state.
  1332.         #
  1333.         label $_images($child) -image $icon -background $bg 
  1334.         bind $_images($child) <ButtonPress-1> [code $this toggle $child]
  1335.         $itk_component(list) window create insert -window $_images($child)
  1336.  
  1337.         #
  1338.         # If any user icons exist then draw them as well.  The little
  1339.         # regexp is just to check and see if they've passed in a
  1340.         # command which needs to be evaluated as opposed to just
  1341.         # a variable.  Also, attach a binding to call them if their
  1342.         # icon is selected.
  1343.         #
  1344.         if {[info exists _icons($child)]} {
  1345.         foreach image $_icons($child) {
  1346.             set wid "$itk_component(list).uicon[incr _ucounter]"
  1347.  
  1348.             if {[regexp {\[.*\]} $image]} {
  1349.             eval label $wid -image $image -background $bg 
  1350.             } else {
  1351.             label $wid -image $image -background $bg 
  1352.             }
  1353.  
  1354.             bind $wid <ButtonPress-1> \
  1355.             [code $this _iconSelect $child $image]
  1356.             $itk_component(list) window create insert -window $wid
  1357.         }
  1358.         }
  1359.  
  1360.         #
  1361.         # Create the list of tags to be applied to the text.  Start
  1362.         # out with a tag of "info" and append "hilite" if the node
  1363.         # is currently selected, finally add the tags given by the
  1364.         # user.
  1365.         #
  1366.         set texttags [list "info" $child]
  1367.  
  1368.         if {[info exists _selected($child)]} {
  1369.         lappend texttags hilite
  1370.         } 
  1371.  
  1372.         foreach tag $_tags($child) {
  1373.         lappend texttags $tag
  1374.         }
  1375.  
  1376.         #
  1377.         # Insert the text for the node along with the tags and 
  1378.         # append to the markers the start of this node.  The text
  1379.         # has been broken at newlines into a list.  We'll make sure
  1380.         # that each line is at the same indentation position.
  1381.         #
  1382.         set firstline 1
  1383.         foreach line $_text($child) {
  1384.         if {$firstline} {
  1385.             $itk_component(list) insert insert " "
  1386.         } else {
  1387.             $itk_component(list) insert insert "$indent\t"
  1388.         }
  1389.  
  1390.         $itk_component(list) insert insert $line $texttags "\n"
  1391.         set firstline 0
  1392.         }
  1393.  
  1394.         lappend _markers "$child:start" [$itk_component(list) index insert]
  1395.  
  1396.         #
  1397.         # If the state of the node is open, proceed to draw the next 
  1398.         # node below it in the hierarchy.
  1399.         #
  1400.         if {$_states($child)} {
  1401.         _drawLevel $child "$indent\t"
  1402.         }
  1403.     }
  1404.     }
  1405.  
  1406.     lappend _markers "$node:end" [$itk_component(list) index insert]
  1407. }
  1408.  
  1409. # ----------------------------------------------------------------------
  1410. # PROTECTED METHOD: _contents uid
  1411. #
  1412. # Used internally to get the contents of a particular node.  If this
  1413. # is the first time the node has been seen or the -alwaysquery
  1414. # option is set, the -querycommand code is executed to query the node 
  1415. # list, and the list is stored until the next time it is needed.
  1416. #
  1417. # The querycommand may return not only the list of subnodes for the 
  1418. # node but additional information on the tags and icons to be used.  
  1419. # The return value must be parsed based on the number of elements in 
  1420. # the list where the format is a list of lists:
  1421. #
  1422. # {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
  1423. # ----------------------------------------------------------------------
  1424. body iwidgets::Hierarchy::_contents {uid} {
  1425.     if {! $itk_option(-alwaysquery) && [info exists _nodes($uid)]} {
  1426.         return $_nodes($uid)
  1427.     }
  1428.  
  1429.     # 
  1430.     # Substitute any %n's for the node name whose children we're
  1431.     # interested in obtaining.
  1432.     #
  1433.     set cmd $itk_option(-querycommand)
  1434.     regsub -all {%n} $cmd [list $uid] cmd
  1435.  
  1436.     set nodeinfolist [uplevel \#0 $cmd]
  1437.  
  1438.     #
  1439.     # Cycle through the node information returned by the query
  1440.     # command determining if additional information such as text,
  1441.     # user tags, or user icons have been provided.  For text,
  1442.     # break it into a list at any newline characters.
  1443.     #
  1444.     set _nodes($uid) {}
  1445.  
  1446.     foreach nodeinfo $nodeinfolist {
  1447.     set subnodeuid [lindex $nodeinfo 0]
  1448.     lappend _nodes($uid) $subnodeuid
  1449.  
  1450.     set llen [llength $nodeinfo] 
  1451.  
  1452.     if {$llen == 0 || $llen > 4} {
  1453.         error "invalid number of elements returned by query\
  1454.                        command for node: \"$uid\",\
  1455.                        should be uid \[text \[tags \[icons\]\]\]"
  1456.     }
  1457.  
  1458.     if {$llen == 1} {
  1459.         set _text($subnodeuid) [split $subnodeuid \n]
  1460.     } 
  1461.     if {$llen > 1} {
  1462.         set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]
  1463.     }
  1464.     if {$llen > 2} {
  1465.         set _tags($subnodeuid) [lindex $nodeinfo 2]
  1466.     } else {
  1467.         set _tags($subnodeuid) unknown
  1468.     }
  1469.     if {$llen > 3} {
  1470.         set _icons($subnodeuid) [lindex $nodeinfo 3]
  1471.     }
  1472.     }
  1473.           
  1474.     #
  1475.     # Return the list of nodes.
  1476.     #
  1477.     return $_nodes($uid)
  1478. }
  1479.  
  1480. # ----------------------------------------------------------------------
  1481. # PROTECTED METHOD: _post x y
  1482. #
  1483. # Used internally to post the popup menu at the coordinate (x,y)
  1484. # relative to the widget.  If (x,y) is on an item, then the itemMenu
  1485. # component is posted.  Otherwise, the bgMenu is posted.
  1486. # ----------------------------------------------------------------------
  1487. body iwidgets::Hierarchy::_post {x y} {
  1488.     set rx [expr [winfo rootx $itk_component(list)]+$x]
  1489.     set ry [expr [winfo rooty $itk_component(list)]+$y]
  1490.  
  1491.     set index [$itk_component(list) index @$x,$y]
  1492.  
  1493.     #
  1494.     # The posted variable will hold the list of tags which exist at
  1495.     # this x,y position that will be passed back to the user.  They
  1496.     # don't need to know about our internal tags, info, hilite, and
  1497.     # lowlite, so remove them from the list.
  1498.     # 
  1499.     set _posted {}
  1500.  
  1501.     foreach tag [$itk_component(list) tag names $index] {
  1502.         if {![_isInternalTag $tag]} {
  1503.             lappend _posted $tag
  1504.         }
  1505.     }
  1506.  
  1507.     #
  1508.     # If we have tags then do the popup at this position.
  1509.     #
  1510.     if {$_posted != {}} {
  1511.     tk_popup $itk_component(itemMenu) $rx $ry
  1512.     } else {
  1513.     tk_popup $itk_component(bgMenu) $rx $ry
  1514.     }
  1515. }
  1516.  
  1517. # ----------------------------------------------------------------------
  1518. # PROTECTED METHOD: _select x y
  1519. #
  1520. # Used internally to select an item at the coordinate (x,y) relative 
  1521. # to the widget.  The command associated with the -selectcommand
  1522. # option is execute following % character substitutions.  If %n
  1523. # appears in the command, the selected node is substituted.  If %s
  1524. # appears, a boolean value representing the current selection state
  1525. # will be substituted.
  1526. # ----------------------------------------------------------------------
  1527. body iwidgets::Hierarchy::_select {x y} {
  1528.     if {$itk_option(-selectcommand) != {}} {
  1529.     if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
  1530.         foreach tag $seltags {
  1531.         if {![_isInternalTag $tag]} {
  1532.             lappend node $tag
  1533.         }
  1534.         }
  1535.  
  1536.         if {[lsearch $seltags "hilite"] == -1} {
  1537.         set selectstatus 0
  1538.         } else {
  1539.         set selectstatus 1
  1540.         }
  1541.  
  1542.         set cmd $itk_option(-selectcommand)
  1543.         regsub -all {%n} $cmd [list $node] cmd
  1544.         regsub -all {%s} $cmd [list $selectstatus] cmd
  1545.  
  1546.         uplevel #0 $cmd
  1547.     }
  1548.     }
  1549.  
  1550.     return
  1551. }
  1552.  
  1553. # ----------------------------------------------------------------------
  1554. # PROTECTED METHOD: _iconSelect node icon
  1555. #
  1556. # Used internally to upon selection of user icons.  The -iconcommand
  1557. # is executed after substitution of the node for %n and icon for %i.
  1558. # ----------------------------------------------------------------------
  1559. body iwidgets::Hierarchy::_iconSelect {node icon} {
  1560.     set cmd $itk_option(-iconcommand)
  1561.     regsub -all {%n} $cmd [list $node] cmd
  1562.     regsub -all {%i} $cmd [list $icon] cmd
  1563.  
  1564.     uplevel \#0 $cmd
  1565.  
  1566.     return {}
  1567. }
  1568.  
  1569. # ----------------------------------------------------------------------
  1570. # PROTECTED METHOD: _deselectSubNodes uid
  1571. #
  1572. # Used internally to recursively deselect all the nodes beneath a 
  1573. # particular node.
  1574. # ----------------------------------------------------------------------
  1575. body iwidgets::Hierarchy::_deselectSubNodes {uid} {
  1576.     foreach node $_nodes($uid) {
  1577.     if {[array names _selected $node] != {}} {
  1578.         unset _selected($node)
  1579.     }
  1580.     
  1581.     if {[array names _nodes $node] != {}} {
  1582.         _deselectSubNodes $node
  1583.     }
  1584.     }
  1585. }
  1586.  
  1587. # ----------------------------------------------------------------------
  1588. # PROTECTED METHOD: _deleteNodeInfo uid
  1589. #
  1590. # Used internally to recursively delete all the information about a
  1591. # node and its decendents.
  1592. # ----------------------------------------------------------------------
  1593. body iwidgets::Hierarchy::_deleteNodeInfo {uid} {
  1594.     #
  1595.     # Recursively call ourseleves as we go down the hierarchy beneath
  1596.     # this node.
  1597.     #
  1598.     if {[info exists _nodes($uid)]} {
  1599.     foreach node $_nodes($uid) {
  1600.         if {[array names _nodes $node] != {}} {
  1601.         _deleteNodeInfo $node
  1602.         }
  1603.     }
  1604.     }
  1605.  
  1606.     #
  1607.     # Unset any entries in our arrays for the node.
  1608.     #
  1609.     catch {unset _nodes($uid)}
  1610.     catch {unset _text($uid)}
  1611.     catch {unset _tags($uid)}
  1612.     catch {unset _icons($uid)}
  1613.     catch {unset _states($uid)}
  1614.     catch {unset _images($uid)}
  1615.     catch {unset _indents($uid)}
  1616. }
  1617.  
  1618. # ----------------------------------------------------------------------
  1619. # PROTECTED METHOD: _getParent uid
  1620. #
  1621. # Used internally to determine the parent for a node.
  1622. # ----------------------------------------------------------------------
  1623. body iwidgets::Hierarchy::_getParent {uid} {
  1624.     foreach node [array names _nodes] {
  1625.     if {[set index [lsearch $_nodes($node) $uid]] != -1} {
  1626.         return $node
  1627.     }
  1628.     }
  1629. }
  1630.  
  1631. # ----------------------------------------------------------------------
  1632. # PROTECTED METHOD: _getHeritage uid
  1633. #
  1634. # Used internally to determine the list of parents for a node.
  1635. # ----------------------------------------------------------------------
  1636. body iwidgets::Hierarchy::_getHeritage {uid} {
  1637.     set parents {}
  1638.  
  1639.     if {[set parent [_getParent $uid]] != {}} {
  1640.     lappend parents $parent
  1641.     }
  1642.  
  1643.     return $parents
  1644. }
  1645.  
  1646. # ----------------------------------------------------------------------
  1647. # PROTECTED METHOD (could be proc?): _isInternalTag tag
  1648. #
  1649. # Used internally to tags not to used for user callback commands
  1650. # ----------------------------------------------------------------------
  1651. body iwidgets::Hierarchy::_isInternalTag {tag} {
  1652.    set ii [expr [lsearch -exact {info hilite lowlite unknown} $tag] != -1];
  1653.    return $ii;
  1654. }
  1655.