home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / blt2.4 / tabnotebook.tcl < prev    next >
Encoding:
Text File  |  2009-12-04  |  10.2 KB  |  319 lines
  1. #
  2. # tabnotebook.tcl
  3. #
  4. # ----------------------------------------------------------------------
  5. # Bindings for the BLT tabnotebook widget
  6. # ----------------------------------------------------------------------
  7. #   AUTHOR:  George Howlett
  8. #            Bell Labs Innovations for Lucent Technologies
  9. #            gah@bell-labs.com
  10. #            http://www.tcltk.com/blt
  11. # ----------------------------------------------------------------------
  12. # Copyright (c) 1998  Lucent Technologies, Inc.
  13. # ======================================================================
  14. #
  15. # Permission to use, copy, modify, and distribute this software and its
  16. # documentation for any purpose and without fee is hereby granted,
  17. # provided that the above copyright notice appear in all copies and that
  18. # both that the copyright notice and warranty disclaimer appear in
  19. # supporting documentation, and that the names of Lucent Technologies
  20. # any of their entities not be used in advertising or publicity
  21. # pertaining to distribution of the software without specific, written
  22. # prior permission.
  23. #
  24. # Lucent Technologies disclaims all warranties with regard to this
  25. # software, including all implied warranties of merchantability and
  26. # fitness.  In no event shall Lucent be liable for any special, indirect
  27. # or consequential damages or any damages whatsoever resulting from loss
  28. # of use, data or profits, whether in an action of contract, negligence
  29. # or other tortuous action, arising out of or in connection with the use
  30. # or performance of this software.
  31. #
  32. # ======================================================================
  33.  
  34. #
  35. # Indicates whether to activate (highlight) tabs when the mouse passes
  36. # over them.  This is turned off during scan operations.
  37. #
  38. set bltTabnotebook(activate) yes
  39.  
  40. # ----------------------------------------------------------------------
  41. # 
  42. # ButtonPress assignments
  43. #
  44. #   <ButtonPress-2>    Starts scan mechanism (pushes the tabs)
  45. #   <B2-Motion>        Adjust scan
  46. #   <ButtonRelease-2>    Stops scan
  47. #
  48. # ----------------------------------------------------------------------
  49. bind Tabnotebook <B2-Motion> {
  50.     %W scan dragto %x %y
  51. }
  52.  
  53. bind Tabnotebook <ButtonPress-2> {
  54.     set bltTabnotebook(cursor) [%W cget -cursor]
  55.     set bltTabnotebook(activate) no
  56.     %W configure -cursor hand1
  57.     %W scan mark %x %y
  58. }
  59.  
  60. bind Tabnotebook <ButtonRelease-2> {
  61.     %W configure -cursor $bltTabnotebook(cursor)
  62.     set bltTabnotebook(activate) yes
  63.     %W activate @%x,%y
  64. }
  65.  
  66. # ----------------------------------------------------------------------
  67. # 
  68. # KeyPress assignments
  69. #
  70. #   <KeyPress-Up>    Moves focus to the tab immediately above the 
  71. #            current.
  72. #   <KeyPress-Down>    Moves focus to the tab immediately below the 
  73. #            current.
  74. #   <KeyPress-Left>    Moves focus to the tab immediately left of the 
  75. #            currently focused tab.
  76. #   <KeyPress-Right>    Moves focus to the tab immediately right of the 
  77. #            currently focused tab.
  78. #   <KeyPress-space>    Invokes the commands associated with the current
  79. #            tab.
  80. #   <KeyPress-Return>    Same as above.
  81. #   <KeyPress>        Go to next tab starting with the ASCII character.
  82. #
  83. # ----------------------------------------------------------------------
  84. bind Tabnotebook <KeyPress-Up> { blt::SelectTab %W "up" }
  85. bind Tabnotebook <KeyPress-Down> { blt::SelectTab %W "down" }
  86. bind Tabnotebook <KeyPress-Right> { blt::SelectTab %W "right" }
  87. bind Tabnotebook <KeyPress-Left> { blt::SelectTab %W "left" }
  88. bind Tabnotebook <KeyPress-space> { %W invoke focus }
  89. bind Tabnotebook <KeyPress-Return> { %W invoke focus }
  90.  
  91. bind Tabnotebook <KeyPress> {
  92.     if { [string match {[A-Za-z0-9]*} "%A"] } {
  93.     blt::FindMatchingTab %W %A
  94.     }
  95. }
  96.  
  97. # ----------------------------------------------------------------------
  98. #
  99. # FirstMatchingTab --
  100. #
  101. #    Find the first tab (from the tab that currently has focus) 
  102. #    starting with the same first letter as the tab.  It searches
  103. #    in order of the tab positions and wraps around. If no tab
  104. #    matches, it stops back at the current tab.
  105. #
  106. # Arguments:    
  107. #    widget        Tabnotebook widget.
  108. #    key        ASCII character of key pressed
  109. #
  110. # ----------------------------------------------------------------------
  111. proc blt::FindMatchingTab { widget key } {
  112.     set key [string tolower $key]
  113.     set itab [$widget index focus]
  114.     set numTabs [$widget size]
  115.     for { set i 0 } { $i < $numTabs } { incr i } {
  116.     if { [incr itab] >= $numTabs } {
  117.         set itab 0
  118.     }
  119.     set label [string tolower [$widget tab cget $itab -text]]
  120.     if { [string index $label 0] == $key } {
  121.         break
  122.     }
  123.     }
  124.     $widget focus $itab
  125.     $widget see focus
  126. }
  127.  
  128. # ----------------------------------------------------------------------
  129. #
  130. # SelectTab --
  131. #
  132. #    Invokes the command for the tab.  If the widget associated tab 
  133. #    is currently torn off, the tearoff is raised.
  134. #
  135. # Arguments:    
  136. #    widget        Tabnotebook widget.
  137. #    x y        Unused.
  138. #
  139. # ----------------------------------------------------------------------
  140. proc blt::SelectTab { widget tab } {
  141.     set index [$widget index $tab]
  142.     if { $index != "" } {
  143.     $widget select $index
  144.     $widget focus $index
  145.     $widget see $index
  146.     set w [$widget tab tearoff $index]
  147.     if { ($w != "") && ($w != "$widget") } {
  148.         raise [winfo toplevel $w]
  149.     }
  150.     $widget invoke $index
  151.     }
  152. }
  153.  
  154. # ----------------------------------------------------------------------
  155. #
  156. # DestroyTearoff --
  157. #
  158. #    Destroys the toplevel window and the container tearoff 
  159. #    window holding the embedded widget.  The widget is placed
  160. #    back inside the tab.
  161. #
  162. # Arguments:    
  163. #    widget        Tabnotebook widget.
  164. #    tab        Tab selected.
  165. #
  166. # ----------------------------------------------------------------------
  167. proc blt::DestroyTearoff { widget tab } {
  168.     set id [$widget id $tab]
  169.     set top "$widget.toplevel-$id"
  170.     if { [winfo exists $top] } {
  171.     wm withdraw $top
  172.     update
  173.     $widget tab tearoff $tab $widget
  174.     destroy $top
  175.     }
  176. }
  177.  
  178. # ----------------------------------------------------------------------
  179. #
  180. # CreateTearoff --
  181. #
  182. #    Creates a new toplevel window and moves the embedded widget
  183. #    into it.  The toplevel is placed just below the tab.  The
  184. #    DELETE WINDOW property is set so that if the toplevel window 
  185. #    is requested to be deleted by the window manager, the embedded
  186. #    widget is placed back inside of the tab.  Note also that 
  187. #    if the tabnotebook container is ever destroyed, the toplevel is
  188. #    also destroyed.  
  189. #
  190. # Arguments:    
  191. #    widget        Tabnotebook widget.
  192. #    tab        Tab selected.
  193. #    x y        The coordinates of the mouse pointer.
  194. #
  195. # ----------------------------------------------------------------------
  196. proc blt::CreateTearoff { widget tab rootX rootY } {
  197.  
  198.     # ------------------------------------------------------------------
  199.     # When reparenting the window contained in the tab, check if the
  200.     # window or any window in its hierarchy currently has focus.
  201.     # Since we're reparenting windows behind its back, Tk can
  202.     # mistakenly activate the keyboard focus when the mouse enters the
  203.     # old toplevel.  The simplest way to deal with this problem is to
  204.     # take the focus off the window and set it to the tabnotebook widget
  205.     # itself.
  206.     # ------------------------------------------------------------------
  207.  
  208.     set focus [focus]
  209.     set window [$widget tab cget $tab -window]
  210.     set index [$widget index $tab]
  211.     if { ($focus == $window) || ([string match  $window.* $focus]) } {
  212.     focus -force $widget
  213.     }
  214.     set id [$widget id $index]
  215.     set top "$widget.toplevel-$id"
  216.     toplevel $top
  217.     $widget tab tearoff $tab $top.container
  218.     table $top $top.container -fill both
  219.  
  220.     incr rootX 10 ; incr rootY 10
  221.     wm geometry $top +$rootX+$rootY
  222.  
  223.     set parent [winfo toplevel $widget]
  224.     wm title $top "[wm title $parent]: [$widget tab cget $index -text]"
  225.     wm transient $top $parent
  226.  
  227.     # If the user tries to delete the toplevel, put the window back
  228.     # into the tab folder.  
  229.  
  230.     wm protocol $top WM_DELETE_WINDOW [list blt::DestroyTearoff $widget $tab]
  231.  
  232.     # If the container is ever destroyed, automatically destroy the
  233.     # toplevel too.  
  234.  
  235.     bind $top.container <Destroy> [list destroy $top]
  236. }
  237.  
  238. # ----------------------------------------------------------------------
  239. #
  240. # ToggleTearoff --
  241. #
  242. #    Toggles the tab tearoff.  If the tab contains a embedded widget, 
  243. #    it is placed inside of a toplevel window.  If the widget has 
  244. #    already been torn off, the widget is replaced back in the tab.
  245. #
  246. # Arguments:    
  247. #    widget        tabnotebook widget.
  248. #    x y        The coordinates of the mouse pointer.
  249. #
  250. # ----------------------------------------------------------------------
  251. proc blt::ToggleTearoff { widget x y index } {
  252.     set tab [$widget index $index]
  253.     if { $tab == "" } {
  254.     return
  255.     }
  256.     $widget invoke $tab
  257.  
  258.     set container [$widget tab tearoff $index]
  259.     if { $container == "$widget" } {
  260.     blt::CreateTearoff $widget $tab $x $y
  261.     } elseif { $container != "" } {
  262.     blt::DestroyTearoff $widget $tab
  263.     }
  264. }
  265.  
  266. # ----------------------------------------------------------------------
  267. #
  268. # TabnotebookInit
  269. #
  270. #    Invoked from C whenever a new tabnotebook widget is created.
  271. #    Sets up the default bindings for the all tab entries.  
  272. #    These bindings are local to the widget, so they can't be 
  273. #    set through the usual widget class bind tags mechanism.
  274. #
  275. #    <Enter>        Activates the tab.
  276. #    <Leave>        Deactivates all tabs.
  277. #    <ButtonPress-1>    Selects the tab and invokes its command.
  278. #    <Control-ButtonPress-1>    
  279. #            Toggles the tab tearoff.  If the tab contains
  280. #            a embedded widget, it is placed inside of a
  281. #            toplevel window.  If the widget has already
  282. #            been torn off, the widget is replaced back
  283. #            in the tab.
  284. #
  285. # Arguments:    
  286. #    widget        tabnotebook widget
  287. #
  288. # ----------------------------------------------------------------------
  289. proc blt::TabnotebookInit { widget } {
  290.     $widget bind all <Enter> { 
  291.     if { $bltTabnotebook(activate) } {
  292.         %W activate current
  293.         }
  294.     }
  295.     $widget bind all <Leave> { 
  296.         %W activate "" 
  297.     }
  298.     $widget bind all <ButtonPress-1> { 
  299.     blt::SelectTab %W "current"
  300.     }
  301.     $widget bind all <Control-ButtonPress-1> { 
  302.     blt::ToggleTearoff %W %X %Y active
  303.     }
  304.     $widget configure -perforationcommand {
  305.     blt::ToggleTearoff %W $bltTabnotebook(x) $bltTabnotebook(y) select
  306.     }
  307.     $widget bind Perforation <Enter> { 
  308.     %W perforation activate on
  309.     }
  310.     $widget bind Perforation <Leave> { 
  311.     %W perforation activate off
  312.     }
  313.     $widget bind Perforation <ButtonPress-1> { 
  314.     set bltTabnotebook(x) %X
  315.     set bltTabnotebook(y) %Y
  316.     %W perforation invoke
  317.     }
  318. }
  319.