home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / bwidget / pagesmgr.tcl < prev    next >
Encoding:
Text File  |  2003-08-12  |  8.8 KB  |  299 lines
  1. # ------------------------------------------------------------------------------
  2. #  pagesmgr.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: pagesmgr.tcl,v 1.1 2001/07/24 17:07:56 damonc 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.  
  24. namespace eval PagesManager {
  25.     Widget::declare PagesManager {
  26.         {-background TkResource "" 0 frame}
  27.     {-cursor     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 $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 -background [Widget::cget $path -background] -borderwidth 0
  117.  
  118.     return $path.f$page
  119. }
  120.  
  121.  
  122. # ------------------------------------------------------------------------------
  123. #  Command PagesManager::delete
  124. # ------------------------------------------------------------------------------
  125. proc PagesManager::delete { path page } {
  126.     variable $path
  127.     upvar 0  $path data
  128.  
  129.     set pos [_test_page $path $page]
  130.     set data(pages) [lreplace $data(pages) $pos $pos]
  131.     if { $data(select) == $page } {
  132.         set data(select) ""
  133.     }
  134.     destroy $path.f$page
  135.     _redraw $path
  136. }
  137.  
  138.  
  139. # ------------------------------------------------------------------------------
  140. #  Command PagesManager::raise
  141. # ------------------------------------------------------------------------------
  142. proc PagesManager::raise { path {page ""} } {
  143.     variable $path
  144.     upvar 0  $path data
  145.  
  146.     if { $page != "" } {
  147.         _test_page $path $page
  148.         _select $path $page
  149.     }
  150.     return $data(select)
  151. }
  152.  
  153.  
  154. # ------------------------------------------------------------------------------
  155. #  Command PagesManager::page - deprecated, use pages
  156. # ------------------------------------------------------------------------------
  157. proc PagesManager::page { path first {last ""} } {
  158.     variable $path
  159.     upvar 0  $path data
  160.  
  161.     if { $last == "" } {
  162.         return [lindex $data(pages) $first]
  163.     } else {
  164.         return [lrange $data(pages) $first $last]
  165.     }
  166. }
  167.  
  168.  
  169. # ------------------------------------------------------------------------------
  170. #  Command PagesManager::pages
  171. # ------------------------------------------------------------------------------
  172. proc PagesManager::pages { path {first ""} {last ""} } {
  173.     variable $path
  174.     upvar 0  $path data
  175.  
  176.     if { ![string length $first] } {
  177.     return $data(pages)
  178.     }
  179.  
  180.     if { ![string length $last] } {
  181.         return [lindex $data(pages) $first]
  182.     } else {
  183.         return [lrange $data(pages) $first $last]
  184.     }
  185. }
  186.  
  187.  
  188. # ------------------------------------------------------------------------------
  189. #  Command PagesManager::_destroy
  190. # ------------------------------------------------------------------------------
  191. proc PagesManager::_destroy { path } {
  192.     variable $path
  193.     upvar 0  $path data
  194.  
  195.     Widget::destroy $path
  196.     unset data
  197.     rename $path {}
  198. }
  199.  
  200.  
  201. # ------------------------------------------------------------------------------
  202. #  Command PagesManager::getframe
  203. # ------------------------------------------------------------------------------
  204. proc PagesManager::getframe { path page } {
  205.     return $path.f$page
  206. }
  207.  
  208.  
  209. # ------------------------------------------------------------------------------
  210. #  Command PagesManager::_test_page
  211. # ------------------------------------------------------------------------------
  212. proc PagesManager::_test_page { path page } {
  213.     variable $path
  214.     upvar 0  $path data
  215.  
  216.     if { [set pos [lsearch $data(pages) $page]] == -1 } {
  217.         return -code error "page \"$page\" does not exists"
  218.     }
  219.     return $pos
  220. }
  221.  
  222.  
  223. # ------------------------------------------------------------------------------
  224. #  Command PagesManager::_select
  225. # ------------------------------------------------------------------------------
  226. proc PagesManager::_select { path page } {
  227.     variable $path
  228.     upvar 0  $path data
  229.  
  230.     set oldsel $data(select)
  231.     if { $page != $oldsel } {
  232.         set data(select) $page
  233.         _draw_area $path
  234.     }
  235. }
  236.  
  237.  
  238. # ------------------------------------------------------------------------------
  239. #  Command PagesManager::_redraw
  240. # ------------------------------------------------------------------------------
  241. proc PagesManager::_redraw { path } {
  242.     variable $path
  243.     upvar 0  $path data
  244.  
  245.     if { !$data(realized) } {
  246.         return
  247.     }
  248.     _draw_area $path
  249. }
  250.  
  251.  
  252. # ------------------------------------------------------------------------------
  253. #  Command PagesManager::_draw_area
  254. # ------------------------------------------------------------------------------
  255. proc PagesManager::_draw_area { path } {
  256.     variable $path
  257.     upvar 0  $path data
  258.  
  259.     set w   [winfo width  $path]
  260.     set h   [winfo height $path]
  261.     set sel $data(select)
  262.     if { $sel != "" } {
  263.         if { [llength [$path:cmd find withtag "window"]] } {
  264.             $path:cmd coords "window" 0 0
  265.             $path:cmd itemconfigure "window"    \
  266.                 -width  $w        \
  267.                 -height $h    \
  268.                 -window $path.f$sel
  269.         } else {
  270.             $path:cmd create window 0 0 \
  271.                 -width  $w          \
  272.                 -height $h       \
  273.                 -anchor nw                      \
  274.                 -tags   "window"                \
  275.                 -window $path.f$sel
  276.         }
  277.     } else {
  278.         $path:cmd delete "window"
  279.     }
  280. }
  281.  
  282.  
  283. # ------------------------------------------------------------------------------
  284. #  Command PagesManager::_realize
  285. # ------------------------------------------------------------------------------
  286. proc PagesManager::_realize { path } {
  287.     variable $path
  288.     upvar 0  $path data
  289.  
  290.     if { [set width  [Widget::cget $path -width]]  == 0 ||
  291.          [set height [Widget::cget $path -height]] == 0 } {
  292.         compute_size $path
  293.     }
  294.  
  295.     set data(realized) 1
  296.     _draw_area $path
  297.     bind $path <Configure> "PagesManager::_draw_area $path"
  298. }
  299.