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 / notebook.itk < prev    next >
Text File  |  2003-09-01  |  31KB  |  947 lines
  1. #
  2. # Notebook Widget
  3. # ----------------------------------------------------------------------
  4. # The Notebook command creates a new window (given by the pathName 
  5. # argument) and makes it into a Notebook widget. Additional options, 
  6. # described above may be specified on the command line or in the 
  7. # option database to configure aspects of the Notebook such as its 
  8. # colors, font, and text. The Notebook command returns its pathName 
  9. # argument. At the time this command is invoked, there must not exist 
  10. # a window named pathName, but path Name's parent must exist.
  11. # 
  12. # A Notebook is a widget that contains a set of pages. It displays one 
  13. # page from the set as the selected page. When a page is selected, the 
  14. # page's contents are displayed in the page area. When first created a 
  15. # Notebook has no pages. Pages may be added or deleted using widget commands 
  16. # described below.
  17. # 
  18. # A special option may be provided to the Notebook. The -auto option 
  19. # specifies whether the Nptebook will automatically handle the unpacking 
  20. # and packing of pages when pages are selected. A value of true signifies 
  21. # that the notebook will automatically manage it. This is the default 
  22. # value. A value of false signifies the notebook will not perform automatic 
  23. # switching of pages.
  24. #
  25. # WISH LIST:
  26. #   This section lists possible future enhancements.
  27. #
  28. # ----------------------------------------------------------------------
  29. #  AUTHOR: Bill W. Scott                 EMAIL: bscott@spd.dsccc.com
  30. #
  31. #  @(#) $Id: notebook.itk,v 1.4 2001/08/15 18:33:31 smithc Exp $
  32. # ----------------------------------------------------------------------
  33. #            Copyright (c) 1995 DSC Technologies Corporation
  34. # ======================================================================
  35. # Permission to use, copy, modify, distribute and license this software 
  36. # and its documentation for any purpose, and without fee or written 
  37. # agreement with DSC, is hereby granted, provided that the above copyright 
  38. # notice appears in all copies and that both the copyright notice and 
  39. # warranty disclaimer below appear in supporting documentation, and that 
  40. # the names of DSC Technologies Corporation or DSC Communications 
  41. # Corporation not be used in advertising or publicity pertaining to the 
  42. # software without specific, written prior permission.
  43. # 
  44. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  45. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  46. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  47. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  48. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  49. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  50. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  51. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  52. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  53. # SOFTWARE.
  54. # ======================================================================
  55.  
  56. #
  57. # Default resources.
  58. #
  59. option add *Notebook.background          #d9d9d9      widgetDefault
  60. option add *Notebook.auto                true         widgetDefault
  61.  
  62. #
  63. # Usual options.
  64. #
  65. itk::usual Notebook {
  66.     keep -background -cursor
  67. }
  68.  
  69. # ------------------------------------------------------------------
  70. #                            NOTEBOOK
  71. # ------------------------------------------------------------------
  72. itcl::class iwidgets::Notebook {
  73.     inherit itk::Widget
  74.     
  75.     constructor {args} {}
  76.     
  77.     itk_option define -background background Background #d9d9d9 
  78.     itk_option define -auto auto Auto true 
  79.     itk_option define -scrollcommand scrollCommand ScrollCommand {}
  80.     
  81.     public method add { args }
  82.     public method childsite { args }
  83.     public method delete { args } 
  84.     public method index { args } 
  85.     public method insert { args } 
  86.     public method prev { } 
  87.     public method next { } 
  88.     public method pageconfigure { args } 
  89.     public method pagecget { index option }
  90.     public method select { index } 
  91.     public method view { args } 
  92.     
  93.     private method _childSites { } 
  94.     private method _scrollCommand { } 
  95.     private method _index { pathList index select} 
  96.     private method _createPage { args } 
  97.     private method _deletePages { fromPage toPage } 
  98.     private method _configurePages { args } 
  99.     private method _tabCommand { } 
  100.     
  101.     private variable _currPage -1  ;# numerical index of current page selected
  102.     private variable _pages {}     ;# list of Page components
  103.     private variable _uniqueID 0   ;# one-up number for unique page numbering
  104.     
  105. }
  106.  
  107. #
  108. # Provide a lowercase access method for the Notebook class
  109. #
  110. proc ::iwidgets::notebook {pathName args} {
  111.     uplevel ::iwidgets::Notebook $pathName $args
  112. }
  113.  
  114. # ------------------------------------------------------------------
  115. #                      CONSTRUCTOR
  116. # ------------------------------------------------------------------
  117. itcl::body iwidgets::Notebook::constructor {args}  {
  118.     #
  119.     # Create the outermost frame to maintain geometry.
  120.     #
  121.     itk_component add cs {
  122.     frame $itk_interior.cs 
  123.     } {
  124.     keep -cursor -background -width -height
  125.     }
  126.     pack $itk_component(cs) -fill both -expand yes
  127.     pack propagate $itk_component(cs) no
  128.     
  129.     eval itk_initialize $args
  130.     
  131.     # force bg of all pages to reflect Notebook's background.
  132.     _configurePages -background $itk_option(-background)
  133. }
  134.  
  135. # ------------------------------------------------------------------
  136. #                      OPTIONS
  137. # ------------------------------------------------------------------
  138. # ------------------------------------------------------------------
  139. # OPTION -background
  140. #
  141. # Sets the bg color of all the pages in the Notebook.
  142. # ------------------------------------------------------------------
  143. itcl::configbody iwidgets::Notebook::background {
  144.     if {$itk_option(-background) != {}} {
  145.     _configurePages -background $itk_option(-background)
  146.     }
  147. }
  148.  
  149. # ------------------------------------------------------------------
  150. # OPTION -auto
  151. #
  152. # Determines whether pages are automatically unpacked and
  153. # packed when pages get selected.
  154. # ------------------------------------------------------------------
  155. itcl::configbody iwidgets::Notebook::auto {
  156.     if {$itk_option(-auto) != {}} {
  157.     }
  158. }
  159.  
  160. # ------------------------------------------------------------------
  161. # OPTION -scrollcommand
  162. #
  163. # Command string to be invoked when the notebook 
  164. # has any changes to its current page, or number of pages.
  165. # 
  166. # typically for scrollbars.
  167. # ------------------------------------------------------------------
  168. itcl::configbody iwidgets::Notebook::scrollcommand {
  169.     if {$itk_option(-scrollcommand) != {}} {
  170.     _scrollCommand
  171.     }
  172. }
  173.  
  174. # ------------------------------------------------------------------
  175. # METHOD: add add ?<option> <value>...?
  176. # 
  177. # Creates a page and appends it to the list of pages.
  178. # processes pageconfigure for the page added.
  179. # ------------------------------------------------------------------
  180. itcl::body iwidgets::Notebook::add { args } {
  181.     # The args list should be an even # of params, if not then
  182.     # prob missing value for last item in args list. Signal error.
  183.     set len [llength $args]
  184.     if {$len % 2} {
  185.     error "value for \"[lindex $args [expr {$len - 1}]]\" missing"
  186.     }
  187.     
  188.     # add a Page component
  189.     set pathName [eval _createPage $args]
  190.     lappend _pages $pathName
  191.     
  192.     # update scroller
  193.     _scrollCommand 
  194.     
  195.     # return childsite for the Page component
  196.     return [eval $pathName childsite]
  197. }
  198.  
  199. # ------------------------------------------------------------------
  200. # METHOD: childsite ?<index>?
  201. #
  202. # If index is supplied, returns the child site widget corresponding 
  203. # to the page index.  If called with no arguments, returns a list 
  204. # of all child sites
  205. # ------------------------------------------------------------------
  206. itcl::body iwidgets::Notebook::childsite { args } {
  207.     set len [llength $args]
  208.     
  209.     switch $len {
  210.     0 {
  211.         # ... called with no arguments, return a list
  212.         if { [llength $args] == 0 } {
  213.         return [_childSites]
  214.         }
  215.     }
  216.     1 {
  217.         set index [lindex $args 0]
  218.         # ... otherwise, return child site for the index given
  219.         # empty notebook
  220.         if { $_pages == {} } {
  221.         error "can't get childsite,\
  222.             no pages in the notebook \"$itk_component(hull)\""
  223.         }
  224.         
  225.         set index [_index $_pages $index $_currPage]
  226.         
  227.         # index out of range
  228.         if { $index < 0 || $index >= [llength $_pages] } {
  229.         error "bad Notebook page index in childsite method:\
  230.             should be between 0 and [expr {[llength $_pages] - 1}]"
  231.         }
  232.         
  233.         set pathName [lindex $_pages $index]
  234.         
  235.         set cs [eval $pathName childsite]
  236.         return $cs
  237.     }
  238.     default {
  239.         # ... too many parameters passed
  240.         error "wrong # args: should be\
  241.             \"$itk_component(hull) childsite ?index?\""
  242.     }
  243.     }
  244. }
  245.  
  246. # ------------------------------------------------------------------
  247. # METHOD: delete <index1> ?<index2>?
  248. # 
  249. # Deletes a page or range of pages from the notebook
  250. # ------------------------------------------------------------------
  251. itcl::body iwidgets::Notebook::delete { args } {
  252.     # empty notebook
  253.     if { $_pages == {} } {
  254.     error "can't delete page, no pages in the notebook\
  255.         \"$itk_component(hull)\""
  256.     }
  257.     
  258.     set len [llength $args]
  259.     switch -- $len {
  260.     1 {
  261.         set fromPage [_index $_pages [lindex $args 0] $_currPage]
  262.         
  263.         if { $fromPage < 0 || $fromPage >= [llength $_pages] } {
  264.         error "bad Notebook page index in delete method:\
  265.             should be between 0 and [expr {[llength $_pages] - 1}]"
  266.         }
  267.         
  268.         set toPage $fromPage
  269.         _deletePages $fromPage $toPage
  270.     }
  271.     
  272.     2 {
  273.         set fromPage [_index $_pages [lindex $args 0] $_currPage]
  274.         
  275.         if { $fromPage < 0 || $fromPage >= [llength $_pages] } {
  276.         error "bad Notebook page index1 in delete method:\
  277.             should be between 0 and [expr {[llength $_pages] - 1}]"
  278.         }
  279.         
  280.         set toPage [_index $_pages [lindex $args 1] $_currPage]
  281.         
  282.         if { $toPage < 0 || $toPage >= [llength $_pages] } {
  283.         error "bad Notebook page index2 in delete method:\
  284.             should be between 0 and [expr {[llength $_pages] - 1}]"
  285.         error "bad Notebook page index2"
  286.         }
  287.         
  288.         if { $fromPage > $toPage } {
  289.         error "bad Notebook page index1 in delete method:\
  290.             index1 is greater than index2"
  291.         }
  292.         
  293.         _deletePages $fromPage $toPage
  294.         
  295.     }
  296.     
  297.     default {
  298.         # ... too few/many parameters passed
  299.         error "wrong # args: should be\
  300.             \"$itk_component(hull) delete index1 ?index2?\""
  301.     }
  302.     }
  303. }
  304.  
  305. # ------------------------------------------------------------------
  306. # METHOD: index <index>
  307. #
  308. # Given an index identifier returns the numeric index of the page
  309. # ------------------------------------------------------------------
  310. itcl::body iwidgets::Notebook::index { args } {
  311.     if { [llength $args] != 1 } {
  312.     error "wrong # args: should be\
  313.         \"$itk_component(hull) index index\""
  314.     }
  315.     
  316.     set index $args
  317.     
  318.     set number [_index $_pages $index $_currPage]
  319.     
  320.     return $number
  321. }
  322.  
  323. # ------------------------------------------------------------------
  324. # METHOD: insert <index> ?<option> <value>...?
  325. #
  326. # Inserts a page before a index. The before page may
  327. # be specified as a label or a page position. 
  328. # ------------------------------------------------------------------
  329. itcl::body iwidgets::Notebook::insert { args } {
  330.     # ... Error: no args passed
  331.     set len [llength $args]
  332.     if { $len == 0 } {
  333.     error "wrong # args: should be\
  334.         \"$itk_component(hull) insert index ?option value?\""
  335.     }
  336.     
  337.     # ... set up index and args 
  338.     set index [lindex $args 0]
  339.     set args [lrange $args 1 $len]
  340.     
  341.     # ... Error: unmatched option value pair (len is odd)
  342.     # The args list should be an even # of params, if not then
  343.     # prob missing value for last item in args list. Signal error.
  344.     set len [llength $args]
  345.     if { $len % 2 } {
  346.     error "value for \"[lindex $args [expr {$len - 1}]]\" missing"
  347.     }
  348.     
  349.     # ... Error: catch notebook empty
  350.     if { $_pages == {} } {
  351.     error "can't insert page, no pages in the notebook\
  352.         \"$itk_component(hull)\""
  353.     }
  354.     
  355.     # ok, get the page
  356.     set page [_index $_pages $index $_currPage]
  357.     
  358.     # ... Error: catch bad value for before page.
  359.     if { $page < 0 || $page >= [llength $_pages] } {
  360.     error "bad Notebook page index in insert method:\
  361.         should be between 0 and [expr {[llength $_pages] - 1}]"
  362.     }
  363.     
  364.     # ... Start the business of inserting
  365.     # create the new page and get its path name...
  366.     set pathName [eval _createPage $args]
  367.     
  368.     # grab the name of the page currently selected. (to keep in sync)
  369.     set currPathName [lindex $_pages $_currPage]
  370.     
  371.     # insert pathName before $page
  372.     set _pages [linsert $_pages $page $pathName]
  373.     
  374.     # keep the _currPage in sync with the insert.
  375.     set _currPage [lsearch -exact $_pages $currPathName]
  376.     
  377.     # give scrollcommand chance to update
  378.     _scrollCommand 
  379.     
  380.     # give them child site back...
  381.     return [eval $pathName childsite]
  382. }
  383.  
  384. # ------------------------------------------------------------------
  385. # METHOD: prev
  386. #
  387. # Selects the previous page. Wraps at first back to last page.
  388. # ------------------------------------------------------------------
  389. itcl::body iwidgets::Notebook::prev { } {
  390.     # catch empty notebook
  391.     if { $_pages == {} } {
  392.     error "can't move to previous page,\
  393.         no pages in the notebook \"$itk_component(hull)\""
  394.     }
  395.     
  396.     # bump to the previous page and wrap if necessary
  397.     set prev [expr {$_currPage - 1}]
  398.     if { $prev < 0 } {
  399.     set prev [expr {[llength $_pages] - 1}]
  400.     }
  401.     
  402.     select $prev
  403.     
  404.     return $prev
  405. }
  406.  
  407. # ------------------------------------------------------------------
  408. # METHOD: next
  409. #
  410. # Selects the next page. Wraps at last back to first page.
  411. # ------------------------------------------------------------------
  412. itcl::body iwidgets::Notebook::next { } {
  413.     # catch empty notebook
  414.     if { $_pages == {} } {
  415.     error "can't move to next page,\
  416.         no pages in the notebook \"$itk_component(hull)\""
  417.     }
  418.     
  419.     # bump to the next page and wrap if necessary
  420.     set next [expr {$_currPage + 1}]
  421.     if { $next >= [llength $_pages] } {
  422.     set next 0
  423.     }
  424.     
  425.     select $next
  426.     
  427.     return $next
  428. }
  429.  
  430. # ------------------------------------------------------------------
  431. # METHOD: pageconfigure <index> ?<option> <value>...?
  432. #
  433. # Performs configure on a given page denoted by index.  Index may 
  434. # be a page number or a pattern matching the label associated with 
  435. # a page.
  436. # ------------------------------------------------------------------
  437. itcl::body iwidgets::Notebook::pageconfigure { args } {
  438.     # ... Error: no args passed
  439.     set len [llength $args]
  440.     if { $len == 0 } {
  441.     error "wrong # args: should be\
  442.         \"$itk_component(hull) pageconfigure index ?option value?\""
  443.     }
  444.     
  445.     # ... set up index and args 
  446.     set index [lindex $args 0]
  447.     set args [lrange $args 1 $len]
  448.     
  449.     set page [_index $_pages $index $_currPage]
  450.     
  451.     # ... Error: page out of range
  452.     if { $page < 0 || $page >= [llength $_pages] } {
  453.     error "bad Notebook page index in pageconfigure method:\
  454.         should be between 0 and [expr {[llength $_pages] - 1}]"
  455.     }
  456.     
  457.     # Configure the page component
  458.     set pathName [lindex $_pages $page]
  459.     return [eval $pathName configure $args]
  460. }
  461.  
  462. # ------------------------------------------------------------------
  463. # METHOD: pagecget <index> <option>
  464. #
  465. # Performs cget on a given page denoted by index.  Index may 
  466. # be a page number or a pattern matching the label associated with 
  467. # a page.
  468. # ------------------------------------------------------------------
  469. itcl::body iwidgets::Notebook::pagecget { index option } {
  470.     set page [_index $_pages $index $_currPage]
  471.     
  472.     # ... Error: page out of range
  473.     if { $page < 0 || $page >= [llength $_pages] } {
  474.     error "bad Notebook page index in pagecget method:\
  475.         should be between 0 and [expr {[llength $_pages] - 1}]"
  476.     }
  477.     
  478.     # Get the page info.
  479.     set pathName [lindex $_pages $page]
  480.     return [$pathName cget $option]
  481. }
  482.  
  483. # ------------------------------------------------------------------
  484. # METHOD: select <index>
  485. #
  486. # Select a page by index.  Hide the last _currPage if it existed.
  487. # Then show the new one if it exists.  Returns the currently 
  488. # selected page or -1 if tried to do a select select when there is 
  489. # no selection.
  490. # ------------------------------------------------------------------
  491. itcl::body iwidgets::Notebook::select { index } {
  492.     global page$itk_component(hull)
  493.     
  494.     # ... Error: empty notebook
  495.     if { $_pages == {} } {
  496.     error "can't select page $index,\
  497.         no pages in the notebook \"$itk_component(hull)\""
  498.     }
  499.     
  500.     # if there is not current selection just ignore trying this selection
  501.     if { $index == "select" && $_currPage == -1 } {
  502.     return -1
  503.     }
  504.     
  505.     set reqPage [_index $_pages $index $_currPage]
  506.     
  507.     if { $reqPage < 0 || $reqPage >= [llength $_pages] } {
  508.     error "bad Notebook page index in select method:\
  509.         should be between 0 and [expr {[llength $_pages] - 1}]"
  510.     }
  511.     
  512.     # if we already have this page selected, then ignore selection.
  513.     if { $reqPage == $_currPage } {
  514.     return $_currPage
  515.     }
  516.     
  517.     # if we are handling packing and unpacking the unpack if we can
  518.     if { $itk_option(-auto) } {
  519.     # if there is a current page packed, then unpack it
  520.     if { $_currPage != -1 } {
  521.         set currPathName [lindex $_pages $_currPage]
  522.         pack forget $currPathName
  523.     }
  524.     }
  525.     
  526.     # set this now so that the -command cmd can do an 'index select'
  527.     # to operate on this page.
  528.     set _currPage $reqPage
  529.     
  530.     # invoke the command for this page
  531.     set cmd [lindex [pageconfigure $index -command] 4]
  532.     eval $cmd
  533.     
  534.     # give scrollcommand chance to update
  535.     _scrollCommand 
  536.     
  537.     # if we are handling packing and unpacking the pack if we can
  538.     if { $itk_option(-auto) } {
  539.     set reqPathName [lindex $_pages $reqPage]
  540.     pack $reqPathName -anchor nw -fill both -expand yes
  541.     }
  542.     
  543.     return $_currPage
  544. }
  545.  
  546.  
  547. # ------------------------------------------------------------------
  548. # METHOD: view
  549. #
  550. # Return the current page
  551. #
  552. #      view <index>
  553. #
  554. # Selects the page denoted by index to be current page
  555. #
  556. #         view 'moveto' <fraction>
  557. #
  558. # Selects the page by using fraction amount
  559. #
  560. #      view 'scroll' <num> <what>
  561. #
  562. # Selects the page by using num as indicator of next or    previous
  563. # ------------------------------------------------------------------
  564. itcl::body iwidgets::Notebook::view { args } {
  565.     set len [llength $args]
  566.     switch -- $len {
  567.     0 {
  568.         # Return current page
  569.         return $_currPage
  570.     }
  571.     1 {
  572.         # Select by index
  573.         select [lindex $args 0]
  574.     }
  575.     2 {
  576.         # Select using moveto
  577.         set arg [lindex $args 0]
  578.         if { $arg == "moveto" } {
  579.         set fraction [lindex $args 1]
  580.         if { [catch { set page \
  581.             [expr {round($fraction/(1.0/[llength $_pages]))}]}]} {
  582.             error "expected floating-point number \
  583.                 but got \"$fraction\""
  584.         }
  585.         if { $page == [llength $_pages] } {
  586.             incr page -1
  587.         }
  588.         
  589.         if { $page >= 0 && $page < [llength $_pages] } {
  590.             select $page
  591.         }
  592.         } else {
  593.         error "expected \"moveto\" but got $arg"
  594.         }
  595.     }
  596.     3 {
  597.         # Select using scroll keyword
  598.         set arg [lindex $args 0]
  599.         if { $arg == "scroll" } {
  600.         set amount [lindex $args 1]
  601.         # check for integer value
  602.         if { ! [regexp {^[-]*[0-9]*$} $amount] } {
  603.             error "expected integer but got \"$amount\""
  604.         }
  605.         set page [expr {$_currPage + $amount}]
  606.         if { $page >= 0 && $page < [llength $_pages] } {
  607.             select $page
  608.         }
  609.         
  610.         } else {
  611.         error "expected \"scroll\" but got $arg"
  612.         }
  613.     }
  614.     default {
  615.         set arg [lindex $args 0]
  616.         if { $arg == "moveto" } {
  617.         error "wrong # args: should be\
  618.             \"$itk_component(hull) view moveto fraction\""
  619.         } elseif { $arg == "scroll" } {
  620.         error "wrong # args: should be\
  621.             \"$itk_component(hull) view scroll units|pages\""
  622.         } else {
  623.         error "wrong # args: should be\
  624.             \"$itk_component(hull) view index\""
  625.         }
  626.     }
  627.     }
  628. }
  629.  
  630. # ------------------------------------------------------------------
  631. # PRIVATE METHOD: _childSites
  632. #
  633. # Returns a list of child sites for all pages in the notebook.
  634. # ------------------------------------------------------------------
  635. itcl::body iwidgets::Notebook::_childSites { } {
  636.     # empty notebook
  637.     if { $_pages == {} } {
  638.     error "can't get childsite list,\
  639.         no pages in the notebook \"$itk_component(hull)\""
  640.     }
  641.     
  642.     set csList {}
  643.     
  644.     foreach pathName $_pages { 
  645.     lappend csList [eval $pathName childsite]
  646.     }
  647.     
  648.     return $csList
  649. }
  650.  
  651. # ------------------------------------------------------------------
  652. # PRIVATE METHOD: _scrollCommand
  653. #
  654. # If there is a -scrollcommand set up, then call the tcl command
  655. # and suffix onto it the standard 4 numbers scrollbars get.
  656. #
  657. # Invoke the scrollcommand, this is like the y/xscrollcommand
  658. # it is designed to talk to scrollbars and the the
  659. # tabset also knows how to obey scrollbar protocol.
  660. # ------------------------------------------------------------------
  661. itcl::body iwidgets::Notebook::_scrollCommand { } {
  662.     if { $itk_option(-scrollcommand) != {} } {
  663.         if  { $_currPage != -1 }  {
  664.         set relTop [expr {($_currPage*1.0) / [llength $_pages]}]
  665.         set relBottom [expr {(($_currPage+1)*1.0) / [llength $_pages]}]
  666.         set scrollCommand "$itk_option(-scrollcommand) $relTop $relBottom"
  667.     } else {
  668.         set scrollCommand "$itk_option(-scrollcommand) 0 1"
  669.     }
  670.     uplevel #0 $scrollCommand
  671.     }
  672. }
  673.  
  674. # ------------------------------------------------------------------
  675. # PRIVATE METHOD: _index
  676. #
  677. # pathList : list of path names to search thru if index is a label
  678. # index    : either number, 'select', 'end', or pattern
  679. # select   : current selection
  680. #
  681. # _index takes takes the value $index converts it to
  682. # a numeric identifier. If the value is not already
  683. # an integer it looks it up in the $pathList array.
  684. # If it fails it returns -1
  685. # ------------------------------------------------------------------
  686. itcl::body iwidgets::Notebook::_index { pathList index select} {
  687.     switch -- $index {
  688.     select {
  689.         set number $select
  690.     }
  691.     end {
  692.         set number [expr {[llength $pathList] -1}]
  693.     }
  694.     default {
  695.         # is it a number already?
  696.         if { [regexp {^[0-9]+$} $index] } {
  697.         set number $index
  698.         if { $number < 0 || $number >= [llength $pathList] } {
  699.             set number -1
  700.         }
  701.         
  702.         # otherwise it is a label
  703.         } else {
  704.         # look thru the pathList of pathNames and 
  705.         # get each label and compare with index.
  706.         # if we get a match then set number to postion in $pathList
  707.         # and break out.
  708.         # otherwise number is still -1
  709.         set i 0
  710.         set number -1
  711.         foreach pathName $pathList {
  712.             set label [lindex [$pathName configure -label] 4]
  713.             if { [string match $label $index] } {
  714.             set number $i
  715.             break
  716.             }
  717.             incr i
  718.         }
  719.         }
  720.     }
  721.     }
  722.     
  723.     return $number
  724. }
  725.  
  726. # ------------------------------------------------------------------
  727. # PRIVATE METHOD: _createPage
  728. #
  729. # Creates a page, using unique page naming, propagates background
  730. # and keeps unique id up to date.
  731. # ------------------------------------------------------------------
  732. itcl::body iwidgets::Notebook::_createPage { args } {
  733.     #
  734.     # create an internal name for the page: .n.cs.page0, .n.cs.page1, etc.
  735.     #
  736.     set pathName $itk_component(cs).page$_uniqueID
  737.     
  738.     eval iwidgets::Page $pathName -background $itk_option(-background) $args
  739.     
  740.     incr _uniqueID
  741.     return $pathName
  742.     
  743. }
  744.  
  745. # ------------------------------------------------------------------
  746. # PRIVATE METHOD: _deletePages
  747. #
  748. # Deletes pages from $fromPage to $toPage.
  749. #
  750. # Operates in two passes, destroys all the widgets
  751. # Then removes the pathName from the page list
  752. #
  753. # Also keeps the current selection in bounds.
  754. # ------------------------------------------------------------------
  755. itcl::body iwidgets::Notebook::_deletePages { fromPage toPage } {
  756.     for { set page $fromPage } { $page <= $toPage } { incr page } {
  757.     # kill the widget
  758.     set pathName [lindex $_pages $page]
  759.     destroy $pathName
  760.     }
  761.     
  762.     # physically remove the page
  763.     set _pages [lreplace $_pages $fromPage $toPage]
  764.     
  765.     # If we deleted a selected page set our selection to none
  766.     if { $_currPage >= $fromPage && $_currPage <= $toPage } {
  767.     set _currPage -1
  768.     }
  769.     
  770.     # make sure _currPage stays in sync with new numbering...
  771.     if { $_pages == {} } {
  772.     # if deleted only remaining page,
  773.     # reset current page to undefined
  774.     set _currPage -1
  775.     
  776.     # or if the current page was the last page, it needs come back
  777.     } elseif { $_currPage >= [llength $_pages] } {
  778.     incr _currPage -1
  779.     if { $_currPage < 0 } {
  780.         # but only to zero
  781.         set _currPage 0
  782.     }
  783.     }
  784.     
  785.     # give scrollcommand chance to update
  786.     _scrollCommand 
  787. }
  788.  
  789. # ------------------------------------------------------------------
  790. # PRIVATE METHOD: _configurePages
  791. #
  792. # Does the pageconfigure method on each page in the notebook
  793. # ------------------------------------------------------------------
  794. itcl::body iwidgets::Notebook::_configurePages { args } {
  795.     # make sure we have pages
  796.     if { [catch {set _pages}] } {
  797.     return
  798.     }
  799.     
  800.     # go thru all pages and pageconfigure them.
  801.     foreach pathName $_pages {
  802.     eval "$pathName configure $args"
  803.     }
  804. }
  805.  
  806. # ------------------------------------------------------------------
  807. # PRIVATE METHOD: _tabCommand
  808. #
  809. # Calls the command that was passed in through the 
  810. # $itk_option(-tabcommand) argument.
  811. #
  812. # This method is up for debate... do we need the -tabcommand option?
  813. # ------------------------------------------------------------------
  814. itcl::body iwidgets::Notebook::_tabCommand { } {
  815.     global page$itk_component(hull)
  816.     
  817.     if { $itk_option(-tabcommand) != {} } {
  818.     set newTabCmdStr $itk_option(-tabcommand)
  819.     lappend newTabCmdStr [set page$itk_component(hull)]
  820.     
  821.     #eval $newTabCmdStr
  822.     uplevel #0 $newTabCmdStr
  823.     }
  824. }
  825.     
  826. #
  827. # Page widget
  828. # ------------------------------------------------------------------
  829. #
  830. # The Page command creates a new window (given by the pathName argument) 
  831. # and makes it into a Page widget. Additional options, described above 
  832. # may be specified on the com mand line or in the option database to 
  833. # configure aspects of the Page such as its back ground, cursor, and 
  834. # geometry. The Page command returns its pathName argument. At the time 
  835. # this command is invoked, there must not exist a window named pathName, 
  836. # but path Name's parent must exist.
  837. # 
  838. # A Page is a frame that holds a child site. It is nothing more than a 
  839. # frame widget with some intelligence built in. Its primary purpose is 
  840. # to support the Notebook's concept of a page. It allows another widget 
  841. # like the Notebook to treat a page as a single object. The Page has an 
  842. # associated label and knows how to return its child site.
  843. #
  844. # ------------------------------------------------------------------
  845. #  AUTHOR: Bill W. Scott                 EMAIL: bscott@spd.dsccc.com
  846. #
  847. # ------------------------------------------------------------------
  848. #               Copyright (c) 1995  DSC Communications Corp.
  849. # ======================================================================
  850. # Permission is hereby granted, without written agreement and without
  851. # license or royalty fees, to use, copy, modify, and distribute this
  852. # software and its documentation for any purpose, provided that the
  853. # above copyright notice and the following two paragraphs appear in
  854. # all copies of this software.
  855. #
  856. # IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
  857. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
  858. # ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
  859. # IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
  860. # DAMAGE.
  861. #
  862. # THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
  863. # BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  864. # FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  865. # ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
  866. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  867. # ======================================================================
  868. #
  869. # Option database default resources:
  870. #
  871. option add *Page.disabledForeground #a3a3a3     widgetDefault
  872. option add *Page.label              {}       widgetDefault
  873. option add *Page.command            {}       widgetDefault
  874.  
  875. itcl::class iwidgets::Page {
  876.     inherit itk::Widget
  877.     
  878.     constructor {args} {}
  879.     
  880.     itk_option define \
  881.         -disabledforeground disabledForeground DisabledForeground #a3a3a3 
  882.     itk_option define -label label Label {} 
  883.     itk_option define -command command Command {}
  884.     
  885.     public method childsite { } 
  886. }
  887.  
  888. # ------------------------------------------------------------------
  889. #                          CONSTRUCTOR
  890. # ------------------------------------------------------------------
  891. itcl::body iwidgets::Page::constructor {args} {
  892.     #
  893.     # Create the outermost frame to maintain geometry.
  894.     #
  895.     itk_component add cs {
  896.     frame $itk_interior.cs 
  897.     } {
  898.     keep -cursor -background -width -height
  899.     }
  900.     pack $itk_component(cs) -fill both -expand yes 
  901.     pack propagate $itk_component(cs) no
  902.     
  903.     eval itk_initialize $args
  904. }
  905.  
  906. # ------------------------------------------------------------------
  907. #                            OPTIONS
  908. # ------------------------------------------------------------------
  909. # ------------------------------------------------------------------
  910. # OPTION -disabledforeground
  911. #
  912. # Sets the disabledForeground color of this page
  913. # ------------------------------------------------------------------
  914. itcl::configbody iwidgets::Page::disabledforeground {
  915. }
  916.  
  917. # ------------------------------------------------------------------
  918. # OPTION -label
  919. #
  920. # Sets the label of this page.  The label is a string identifier 
  921. # for this page.
  922. # ------------------------------------------------------------------
  923. itcl::configbody iwidgets::Page::label {
  924. }
  925.  
  926. # ------------------------------------------------------------------
  927. # OPTION -command
  928. #
  929. # The Tcl Command to associate with this page.
  930. # ------------------------------------------------------------------
  931. itcl::configbody iwidgets::Page::command {
  932. }
  933.  
  934. # ------------------------------------------------------------------
  935. #                            METHODS
  936. # ------------------------------------------------------------------
  937.  
  938. # ------------------------------------------------------------------
  939. # METHOD: childsite
  940. #
  941. # Returns the child site widget of this page
  942. # ------------------------------------------------------------------
  943. itcl::body iwidgets::Page::childsite { } {
  944.     return $itk_component(cs)
  945. }
  946.  
  947.