home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / bwidget1.3.0 / pagesmgr.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  8.8 KB  |  300 lines
  1. # ------------------------------------------------------------------------------
  2. #  pagesmgr.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: pagesmgr.tcl,v 1.4 2001/10/14 19:32:58 hobbs Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - PagesManager::create
  8. #     - PagesManager::configure
  9. #     - PagesManager::cget
  10. #     - PagesManager::compute_size
  11. #     - PagesManager::add
  12. #     - PagesManager::delete
  13. #     - PagesManager::raise
  14. #     - PagesManager::page
  15. #     - PagesManager::pages
  16. #     - PagesManager::getframe
  17. #     - PagesManager::_test_page
  18. #     - PagesManager::_select
  19. #     - PagesManager::_redraw
  20. #     - PagesManager::_draw_area
  21. #     - PagesManager::_realize
  22. # ------------------------------------------------------------------------------
  23. package require Tcl 8.1.1
  24.  
  25. namespace eval PagesManager {
  26.     Widget::declare PagesManager {
  27.         {-background TkResource "" 0 frame}
  28.         {-width      Int        0  0 "%d >= 0"}
  29.         {-height     Int        0  0 "%d >= 0"}
  30.     }
  31.  
  32.     Widget::addmap PagesManager "" :cmd {-width {} -height {}}
  33.  
  34.     proc ::PagesManager { path args } { return [eval PagesManager::create $path $args] }
  35.     proc use {} {}
  36. }
  37.  
  38.  
  39. # ------------------------------------------------------------------------------
  40. #  Command PagesManager::create
  41. # ------------------------------------------------------------------------------
  42. proc PagesManager::create { path args } {
  43.     variable $path
  44.     upvar 0  $path data
  45.  
  46.     Widget::init PagesManager $path $args
  47.  
  48.     set data(select)   ""
  49.     set data(pages)    {}
  50.     set data(cpt)      0
  51.     set data(realized) 0
  52.  
  53.     # --- creation du canvas -----------------------------------------------------------------
  54.     eval canvas $path -relief flat -bd 0 -highlightthickness 0 \
  55.         [Widget::subcget $path :cmd]
  56.  
  57.     bind $path <Configure> "PagesManager::_realize $path"
  58.     bind $path <Destroy>   "PagesManager::_destroy $path"
  59.  
  60.     rename $path ::$path:cmd
  61.     proc ::$path { cmd args } "return \[eval PagesManager::\$cmd $path \$args\]"
  62.  
  63.     return $path
  64. }
  65.  
  66.  
  67. # ------------------------------------------------------------------------------
  68. #  Command PagesManager::configure
  69. # ------------------------------------------------------------------------------
  70. proc PagesManager::configure { path args } {
  71.     return [Widget::configure $path $args]
  72. }
  73.  
  74.  
  75. # ------------------------------------------------------------------------------
  76. #  Command PagesManager::cget
  77. # ------------------------------------------------------------------------------
  78. proc PagesManager::cget { path option } {
  79.     return [Widget::cget $path $option]
  80. }
  81.  
  82.  
  83. # ------------------------------------------------------------------------------
  84. #  Command PagesManager::compute_size
  85. # ------------------------------------------------------------------------------
  86. proc PagesManager::compute_size { path } {
  87.     variable $path
  88.     upvar 0  $path data
  89.  
  90.     set wmax 0
  91.     set hmax 0
  92.     update idletasks
  93.     foreach page $data(pages) {
  94.         set w    [winfo reqwidth  $path.f$page]
  95.         set h    [winfo reqheight $path.f$page]
  96.         set wmax [expr {$w>$wmax ? $w : $wmax}]
  97.         set hmax [expr {$h>$hmax ? $h : $hmax}]
  98.     }
  99.     configure $path -width $wmax -height $hmax
  100. }
  101.  
  102.  
  103. # ------------------------------------------------------------------------------
  104. #  Command PagesManager::add
  105. # ------------------------------------------------------------------------------
  106. proc PagesManager::add { path page } {
  107.     variable $path
  108.     upvar 0  $path data
  109.  
  110.     if { [lsearch -exact $data(pages) $page] != -1 } {
  111.         return -code error "page \"$page\" already exists"
  112.     }
  113.  
  114.     lappend data(pages) $page
  115.  
  116.     frame $path.f$page -relief flat \
  117.         -background [Widget::cget $path -background] -borderwidth 0
  118.  
  119.     return $path.f$page
  120. }
  121.  
  122.  
  123. # ------------------------------------------------------------------------------
  124. #  Command PagesManager::delete
  125. # ------------------------------------------------------------------------------
  126. proc PagesManager::delete { path page } {
  127.     variable $path
  128.     upvar 0  $path data
  129.  
  130.     set pos [_test_page $path $page]
  131.     set data(pages) [lreplace $data(pages) $pos $pos]
  132.     if { $data(select) == $page } {
  133.         set data(select) ""
  134.     }
  135.     destroy $path.f$page
  136.     _redraw $path
  137. }
  138.  
  139.  
  140. # ------------------------------------------------------------------------------
  141. #  Command PagesManager::raise
  142. # ------------------------------------------------------------------------------
  143. proc PagesManager::raise { path {page ""} } {
  144.     variable $path
  145.     upvar 0  $path data
  146.  
  147.     if { $page != "" } {
  148.         _test_page $path $page
  149.         _select $path $page
  150.     }
  151.     return $data(select)
  152. }
  153.  
  154.  
  155. # ------------------------------------------------------------------------------
  156. #  Command PagesManager::page - deprecated, use pages
  157. # ------------------------------------------------------------------------------
  158. proc PagesManager::page { path first {last ""} } {
  159.     variable $path
  160.     upvar 0  $path data
  161.  
  162.     if { $last == "" } {
  163.         return [lindex $data(pages) $first]
  164.     } else {
  165.         return [lrange $data(pages) $first $last]
  166.     }
  167. }
  168.  
  169.  
  170. # ------------------------------------------------------------------------------
  171. #  Command PagesManager::pages
  172. # ------------------------------------------------------------------------------
  173. proc PagesManager::pages { path {first ""} {last ""} } {
  174.     variable $path
  175.     upvar 0  $path data
  176.  
  177.     if { ![string length $first] } {
  178.     return $data(pages)
  179.     }
  180.  
  181.     if { ![string length $last] } {
  182.         return [lindex $data(pages) $first]
  183.     } else {
  184.         return [lrange $data(pages) $first $last]
  185.     }
  186. }
  187.  
  188.  
  189. # ------------------------------------------------------------------------------
  190. #  Command PagesManager::_destroy
  191. # ------------------------------------------------------------------------------
  192. proc PagesManager::_destroy { path } {
  193.     variable $path
  194.     upvar 0  $path data
  195.  
  196.     Widget::destroy $path
  197.     unset data
  198.     rename $path {}
  199. }
  200.  
  201.  
  202. # ------------------------------------------------------------------------------
  203. #  Command PagesManager::getframe
  204. # ------------------------------------------------------------------------------
  205. proc PagesManager::getframe { path page } {
  206.     return $path.f$page
  207. }
  208.  
  209.  
  210. # ------------------------------------------------------------------------------
  211. #  Command PagesManager::_test_page
  212. # ------------------------------------------------------------------------------
  213. proc PagesManager::_test_page { path page } {
  214.     variable $path
  215.     upvar 0  $path data
  216.  
  217.     if { [set pos [lsearch $data(pages) $page]] == -1 } {
  218.         return -code error "page \"$page\" does not exists"
  219.     }
  220.     return $pos
  221. }
  222.  
  223.  
  224. # ------------------------------------------------------------------------------
  225. #  Command PagesManager::_select
  226. # ------------------------------------------------------------------------------
  227. proc PagesManager::_select { path page } {
  228.     variable $path
  229.     upvar 0  $path data
  230.  
  231.     set oldsel $data(select)
  232.     if { $page != $oldsel } {
  233.         set data(select) $page
  234.         _draw_area $path
  235.     }
  236. }
  237.  
  238.  
  239. # ------------------------------------------------------------------------------
  240. #  Command PagesManager::_redraw
  241. # ------------------------------------------------------------------------------
  242. proc PagesManager::_redraw { path } {
  243.     variable $path
  244.     upvar 0  $path data
  245.  
  246.     if { !$data(realized) } {
  247.         return
  248.     }
  249.     _draw_area $path
  250. }
  251.  
  252.  
  253. # ------------------------------------------------------------------------------
  254. #  Command PagesManager::_draw_area
  255. # ------------------------------------------------------------------------------
  256. proc PagesManager::_draw_area { path } {
  257.     variable $path
  258.     upvar 0  $path data
  259.  
  260.     set w   [winfo width  $path]
  261.     set h   [winfo height $path]
  262.     set sel $data(select)
  263.     if { $sel != "" } {
  264.         if { [llength [$path:cmd find withtag "window"]] } {
  265.             $path:cmd coords "window" 0 0
  266.             $path:cmd itemconfigure "window"    \
  267.                 -width  $w        \
  268.                 -height $h    \
  269.                 -window $path.f$sel
  270.         } else {
  271.             $path:cmd create window 0 0 \
  272.                 -width  $w          \
  273.                 -height $h       \
  274.                 -anchor nw                      \
  275.                 -tags   "window"                \
  276.                 -window $path.f$sel
  277.         }
  278.     } else {
  279.         $path:cmd delete "window"
  280.     }
  281. }
  282.  
  283.  
  284. # ------------------------------------------------------------------------------
  285. #  Command PagesManager::_realize
  286. # ------------------------------------------------------------------------------
  287. proc PagesManager::_realize { path } {
  288.     variable $path
  289.     upvar 0  $path data
  290.  
  291.     if { [set width  [Widget::cget $path -width]]  == 0 ||
  292.          [set height [Widget::cget $path -height]] == 0 } {
  293.         compute_size $path
  294.     }
  295.  
  296.     set data(realized) 1
  297.     _draw_area $path
  298.     bind $path <Configure> "PagesManager::_draw_area $path"
  299. }
  300.