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 / spinbox.tcl < prev    next >
Text File  |  2003-09-01  |  15KB  |  569 lines
  1. # spinbox.tcl --
  2. #
  3. # This file defines the default bindings for Tk spinbox widgets and provides
  4. # procedures that help in implementing those bindings.  The spinbox builds
  5. # off the entry widget, so it can reuse Entry bindings and procedures.
  6. #
  7. # RCS: @(#) $Id: spinbox.tcl,v 1.3 2003/01/21 20:24:46 hunt Exp $
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  11. # Copyright (c) 1999-2000 Jeffrey Hobbs
  12. # Copyright (c) 2000 Ajuba Solutions
  13. #
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17.  
  18. #-------------------------------------------------------------------------
  19. # Elements of tk::Priv that are used in this file:
  20. #
  21. # afterId -        If non-null, it means that auto-scanning is underway
  22. #            and it gives the "after" id for the next auto-scan
  23. #            command to be executed.
  24. # mouseMoved -        Non-zero means the mouse has moved a significant
  25. #            amount since the button went down (so, for example,
  26. #            start dragging out a selection).
  27. # pressX -        X-coordinate at which the mouse button was pressed.
  28. # selectMode -        The style of selection currently underway:
  29. #            char, word, or line.
  30. # x, y -        Last known mouse coordinates for scanning
  31. #            and auto-scanning.
  32. # data -        Used for Cut and Copy
  33. #-------------------------------------------------------------------------
  34.  
  35. # Initialize namespace
  36. namespace eval ::tk::spinbox {}
  37.  
  38. #-------------------------------------------------------------------------
  39. # The code below creates the default class bindings for entries.
  40. #-------------------------------------------------------------------------
  41. bind Spinbox <<Cut>> {
  42.     if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
  43.     clipboard clear -displayof %W
  44.     clipboard append -displayof %W $tk::Priv(data)
  45.     %W delete sel.first sel.last
  46.     unset tk::Priv(data)
  47.     }
  48. }
  49. bind Spinbox <<Copy>> {
  50.     if {![catch {::tk::spinbox::GetSelection %W} tk::Priv(data)]} {
  51.     clipboard clear -displayof %W
  52.     clipboard append -displayof %W $tk::Priv(data)
  53.     unset tk::Priv(data)
  54.     }
  55. }
  56. bind Spinbox <<Paste>> {
  57.     global tcl_platform
  58.     catch {
  59.     if {[tk windowingsystem] ne "x11"} {
  60.         catch {
  61.         %W delete sel.first sel.last
  62.         }
  63.     }
  64.     %W insert insert [::tk::GetSelection %W CLIPBOARD]
  65.     ::tk::EntrySeeInsert %W
  66.     }
  67. }
  68. bind Spinbox <<Clear>> {
  69.     %W delete sel.first sel.last
  70. }
  71. bind Spinbox <<PasteSelection>> {
  72.     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  73.     || !$tk::Priv(mouseMoved)} {
  74.     ::tk::spinbox::Paste %W %x
  75.     }
  76. }
  77.  
  78. # Standard Motif bindings:
  79.  
  80. bind Spinbox <1> {
  81.     ::tk::spinbox::ButtonDown %W %x %y
  82. }
  83. bind Spinbox <B1-Motion> {
  84.     ::tk::spinbox::Motion %W %x %y
  85. }
  86. bind Spinbox <Double-1> {
  87.     set tk::Priv(selectMode) word
  88.     ::tk::spinbox::MouseSelect %W %x sel.first
  89. }
  90. bind Spinbox <Triple-1> {
  91.     set tk::Priv(selectMode) line
  92.     ::tk::spinbox::MouseSelect %W %x 0
  93. }
  94. bind Spinbox <Shift-1> {
  95.     set tk::Priv(selectMode) char
  96.     %W selection adjust @%x
  97. }
  98. bind Spinbox <Double-Shift-1> {
  99.     set tk::Priv(selectMode) word
  100.     ::tk::spinbox::MouseSelect %W %x
  101. }
  102. bind Spinbox <Triple-Shift-1> {
  103.     set tk::Priv(selectMode) line
  104.     ::tk::spinbox::MouseSelect %W %x
  105. }
  106. bind Spinbox <B1-Leave> {
  107.     set tk::Priv(x) %x
  108.     ::tk::spinbox::AutoScan %W
  109. }
  110. bind Spinbox <B1-Enter> {
  111.     tk::CancelRepeat
  112. }
  113. bind Spinbox <ButtonRelease-1> {
  114.     ::tk::spinbox::ButtonUp %W %x %y
  115. }
  116. bind Spinbox <Control-1> {
  117.     %W icursor @%x
  118. }
  119.  
  120. bind Spinbox <Up> {
  121.     %W invoke buttonup
  122. }
  123. bind Spinbox <Down> {
  124.     %W invoke buttondown
  125. }
  126.  
  127. bind Spinbox <Left> {
  128.     ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  129. }
  130. bind Spinbox <Right> {
  131.     ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  132. }
  133. bind Spinbox <Shift-Left> {
  134.     ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
  135.     ::tk::EntrySeeInsert %W
  136. }
  137. bind Spinbox <Shift-Right> {
  138.     ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
  139.     ::tk::EntrySeeInsert %W
  140. }
  141. bind Spinbox <Control-Left> {
  142.     ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
  143. }
  144. bind Spinbox <Control-Right> {
  145.     ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
  146. }
  147. bind Spinbox <Shift-Control-Left> {
  148.     ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert]
  149.     ::tk::EntrySeeInsert %W
  150. }
  151. bind Spinbox <Shift-Control-Right> {
  152.     ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert]
  153.     ::tk::EntrySeeInsert %W
  154. }
  155. bind Spinbox <Home> {
  156.     ::tk::EntrySetCursor %W 0
  157. }
  158. bind Spinbox <Shift-Home> {
  159.     ::tk::EntryKeySelect %W 0
  160.     ::tk::EntrySeeInsert %W
  161. }
  162. bind Spinbox <End> {
  163.     ::tk::EntrySetCursor %W end
  164. }
  165. bind Spinbox <Shift-End> {
  166.     ::tk::EntryKeySelect %W end
  167.     ::tk::EntrySeeInsert %W
  168. }
  169.  
  170. bind Spinbox <Delete> {
  171.     if {[%W selection present]} {
  172.     %W delete sel.first sel.last
  173.     } else {
  174.     %W delete insert
  175.     }
  176. }
  177. bind Spinbox <BackSpace> {
  178.     ::tk::EntryBackspace %W
  179. }
  180.  
  181. bind Spinbox <Control-space> {
  182.     %W selection from insert
  183. }
  184. bind Spinbox <Select> {
  185.     %W selection from insert
  186. }
  187. bind Spinbox <Control-Shift-space> {
  188.     %W selection adjust insert
  189. }
  190. bind Spinbox <Shift-Select> {
  191.     %W selection adjust insert
  192. }
  193. bind Spinbox <Control-slash> {
  194.     %W selection range 0 end
  195. }
  196. bind Spinbox <Control-backslash> {
  197.     %W selection clear
  198. }
  199. bind Spinbox <KeyPress> {
  200.     ::tk::EntryInsert %W %A
  201. }
  202.  
  203. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  204. # Otherwise, if a widget binding for one of these is defined, the
  205. # <KeyPress> class binding will also fire and insert the character,
  206. # which is wrong.  Ditto for Escape, Return, and Tab.
  207.  
  208. bind Spinbox <Alt-KeyPress> {# nothing}
  209. bind Spinbox <Meta-KeyPress> {# nothing}
  210. bind Spinbox <Control-KeyPress> {# nothing}
  211. bind Spinbox <Escape> {# nothing}
  212. bind Spinbox <Return> {# nothing}
  213. bind Spinbox <KP_Enter> {# nothing}
  214. bind Spinbox <Tab> {# nothing}
  215. if {[string equal [tk windowingsystem] "classic"]
  216.     || [string equal [tk windowingsystem] "aqua"]} {
  217.     bind Spinbox <Command-KeyPress> {# nothing}
  218. }
  219.  
  220. # On Windows, paste is done using Shift-Insert.  Shift-Insert already
  221. # generates the <<Paste>> event, so we don't need to do anything here.
  222. if {[string compare $tcl_platform(platform) "windows"]} {
  223.     bind Spinbox <Insert> {
  224.     catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
  225.     }
  226. }
  227.  
  228. # Additional emacs-like bindings:
  229.  
  230. bind Spinbox <Control-a> {
  231.     if {!$tk_strictMotif} {
  232.     ::tk::EntrySetCursor %W 0
  233.     }
  234. }
  235. bind Spinbox <Control-b> {
  236.     if {!$tk_strictMotif} {
  237.     ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  238.     }
  239. }
  240. bind Spinbox <Control-d> {
  241.     if {!$tk_strictMotif} {
  242.     %W delete insert
  243.     }
  244. }
  245. bind Spinbox <Control-e> {
  246.     if {!$tk_strictMotif} {
  247.     ::tk::EntrySetCursor %W end
  248.     }
  249. }
  250. bind Spinbox <Control-f> {
  251.     if {!$tk_strictMotif} {
  252.     ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  253.     }
  254. }
  255. bind Spinbox <Control-h> {
  256.     if {!$tk_strictMotif} {
  257.     ::tk::EntryBackspace %W
  258.     }
  259. }
  260. bind Spinbox <Control-k> {
  261.     if {!$tk_strictMotif} {
  262.     %W delete insert end
  263.     }
  264. }
  265. bind Spinbox <Control-t> {
  266.     if {!$tk_strictMotif} {
  267.     ::tk::EntryTranspose %W
  268.     }
  269. }
  270. bind Spinbox <Meta-b> {
  271.     if {!$tk_strictMotif} {
  272.     ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert]
  273.     }
  274. }
  275. bind Spinbox <Meta-d> {
  276.     if {!$tk_strictMotif} {
  277.     %W delete insert [::tk::EntryNextWord %W insert]
  278.     }
  279. }
  280. bind Spinbox <Meta-f> {
  281.     if {!$tk_strictMotif} {
  282.     ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert]
  283.     }
  284. }
  285. bind Spinbox <Meta-BackSpace> {
  286.     if {!$tk_strictMotif} {
  287.     %W delete [::tk::EntryPreviousWord %W insert] insert
  288.     }
  289. }
  290. bind Spinbox <Meta-Delete> {
  291.     if {!$tk_strictMotif} {
  292.     %W delete [::tk::EntryPreviousWord %W insert] insert
  293.     }
  294. }
  295.  
  296. # A few additional bindings of my own.
  297.  
  298. bind Spinbox <2> {
  299.     if {!$tk_strictMotif} {
  300.     ::tk::EntryScanMark %W %x
  301.     }
  302. }
  303. bind Spinbox <B2-Motion> {
  304.     if {!$tk_strictMotif} {
  305.     ::tk::EntryScanDrag %W %x
  306.     }
  307. }
  308.  
  309. # ::tk::spinbox::Invoke --
  310. # Invoke an element of the spinbox
  311. #
  312. # Arguments:
  313. # w -        The spinbox window.
  314. # elem -    Element to invoke
  315.  
  316. proc ::tk::spinbox::Invoke {w elem} {
  317.     variable ::tk::Priv
  318.  
  319.     if {![info exists Priv(outsideElement)]} {
  320.     $w invoke $elem
  321.     incr Priv(repeated)
  322.     }
  323.     set delay [$w cget -repeatinterval]
  324.     if {$delay > 0} {
  325.     set Priv(afterId) [after $delay \
  326.         [list ::tk::spinbox::Invoke $w $elem]]
  327.     }
  328. }
  329.  
  330. # ::tk::spinbox::ClosestGap --
  331. # Given x and y coordinates, this procedure finds the closest boundary
  332. # between characters to the given coordinates and returns the index
  333. # of the character just after the boundary.
  334. #
  335. # Arguments:
  336. # w -        The spinbox window.
  337. # x -        X-coordinate within the window.
  338.  
  339. proc ::tk::spinbox::ClosestGap {w x} {
  340.     set pos [$w index @$x]
  341.     set bbox [$w bbox $pos]
  342.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  343.     return $pos
  344.     }
  345.     incr pos
  346. }
  347.  
  348. # ::tk::spinbox::ButtonDown --
  349. # This procedure is invoked to handle button-1 presses in spinbox
  350. # widgets.  It moves the insertion cursor, sets the selection anchor,
  351. # and claims the input focus.
  352. #
  353. # Arguments:
  354. # w -        The spinbox window in which the button was pressed.
  355. # x -        The x-coordinate of the button press.
  356.  
  357. proc ::tk::spinbox::ButtonDown {w x y} {
  358.     variable ::tk::Priv
  359.  
  360.     # Get the element that was clicked in.  If we are not directly over
  361.     # the spinbox, default to entry.  This is necessary for spinbox grabs.
  362.     #
  363.     set Priv(element) [$w identify $x $y]
  364.     if {$Priv(element) eq ""} {
  365.     set Priv(element) "entry"
  366.     }
  367.  
  368.     switch -exact $Priv(element) {
  369.     "buttonup" - "buttondown" {
  370.         if {"disabled" ne [$w cget -state]} {
  371.         $w selection element $Priv(element)
  372.         set Priv(repeated) 0
  373.         set Priv(relief) [$w cget -$Priv(element)relief]
  374.         catch {after cancel $Priv(afterId)}
  375.         set delay [$w cget -repeatdelay]
  376.         if {$delay > 0} {
  377.             set Priv(afterId) [after $delay \
  378.                 [list ::tk::spinbox::Invoke $w $Priv(element)]]
  379.         }
  380.         if {[info exists Priv(outsideElement)]} {
  381.             unset Priv(outsideElement)
  382.         }
  383.         }
  384.     }
  385.     "entry" {
  386.         set Priv(selectMode) char
  387.         set Priv(mouseMoved) 0
  388.         set Priv(pressX) $x
  389.         $w icursor [::tk::spinbox::ClosestGap $w $x]
  390.         $w selection from insert
  391.         if {"disabled" ne [$w cget -state]} {focus $w}
  392.         $w selection clear
  393.     }
  394.     default {
  395.         return -code error "unknown spinbox element \"$Priv(element)\""
  396.     }
  397.     }
  398. }
  399.  
  400. # ::tk::spinbox::ButtonUp --
  401. # This procedure is invoked to handle button-1 releases in spinbox
  402. # widgets.
  403. #
  404. # Arguments:
  405. # w -        The spinbox window in which the button was pressed.
  406. # x -        The x-coordinate of the button press.
  407.  
  408. proc ::tk::spinbox::ButtonUp {w x y} {
  409.     variable ::tk::Priv
  410.  
  411.     ::tk::CancelRepeat
  412.  
  413.     # Priv(relief) may not exist if the ButtonUp is not paired with
  414.     # a preceding ButtonDown
  415.     if {[info exists Priv(element)] && [info exists Priv(relief)] && \
  416.         [string match "button*" $Priv(element)]} {
  417.     if {[info exists Priv(repeated)] && !$Priv(repeated)} {
  418.         $w invoke $Priv(element)
  419.     }
  420.     $w configure -$Priv(element)relief $Priv(relief)
  421.     $w selection element none
  422.     }
  423. }
  424.  
  425. # ::tk::spinbox::MouseSelect --
  426. # This procedure is invoked when dragging out a selection with
  427. # the mouse.  Depending on the selection mode (character, word,
  428. # line) it selects in different-sized units.  This procedure
  429. # ignores mouse motions initially until the mouse has moved from
  430. # one character to another or until there have been multiple clicks.
  431. #
  432. # Arguments:
  433. # w -        The spinbox window in which the button was pressed.
  434. # x -        The x-coordinate of the mouse.
  435. # cursor -    optional place to set cursor.
  436.  
  437. proc ::tk::spinbox::MouseSelect {w x {cursor {}}} {
  438.     variable ::tk::Priv
  439.  
  440.     if {$Priv(element) ne "entry"} {
  441.     # The ButtonUp command triggered by ButtonRelease-1 handles
  442.     # invoking one of the spinbuttons.
  443.     return
  444.     }
  445.     set cur [::tk::spinbox::ClosestGap $w $x]
  446.     set anchor [$w index anchor]
  447.     if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  448.     set Priv(mouseMoved) 1
  449.     }
  450.     switch $Priv(selectMode) {
  451.     char {
  452.         if {$Priv(mouseMoved)} {
  453.         if {$cur < $anchor} {
  454.             $w selection range $cur $anchor
  455.         } elseif {$cur > $anchor} {
  456.             $w selection range $anchor $cur
  457.         } else {
  458.             $w selection clear
  459.         }
  460.         }
  461.     }
  462.     word {
  463.         if {$cur < [$w index anchor]} {
  464.         set before [tcl_wordBreakBefore [$w get] $cur]
  465.         set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
  466.         } else {
  467.         set before [tcl_wordBreakBefore [$w get] $anchor]
  468.         set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
  469.         }
  470.         if {$before < 0} {
  471.         set before 0
  472.         }
  473.         if {$after < 0} {
  474.         set after end
  475.         }
  476.         $w selection range $before $after
  477.     }
  478.     line {
  479.         $w selection range 0 end
  480.     }
  481.     }
  482.     if {$cursor ne {} && $cursor ne "ignore"} {
  483.     catch {$w icursor $cursor}
  484.     }
  485.     update idletasks
  486. }
  487.  
  488. # ::tk::spinbox::Paste --
  489. # This procedure sets the insertion cursor to the current mouse position,
  490. # pastes the selection there, and sets the focus to the window.
  491. #
  492. # Arguments:
  493. # w -        The spinbox window.
  494. # x -        X position of the mouse.
  495.  
  496. proc ::tk::spinbox::Paste {w x} {
  497.     $w icursor [::tk::spinbox::ClosestGap $w $x]
  498.     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
  499.     if {[string equal "disabled" [$w cget -state]]} {focus $w}
  500. }
  501.  
  502. # ::tk::spinbox::Motion --
  503. # This procedure is invoked when the mouse moves in a spinbox window
  504. # with button 1 down.
  505. #
  506. # Arguments:
  507. # w -        The spinbox window.
  508.  
  509. proc ::tk::spinbox::Motion {w x y} {
  510.     variable ::tk::Priv
  511.  
  512.     if {![info exists Priv(element)]} {
  513.     set Priv(element) [$w identify $x $y]
  514.     }
  515.  
  516.     set Priv(x) $x
  517.     if {"entry" eq $Priv(element)} {
  518.     ::tk::spinbox::MouseSelect $w $x ignore
  519.     } elseif {[$w identify $x $y] ne $Priv(element)} {
  520.     if {![info exists Priv(outsideElement)]} {
  521.         # We've wandered out of the spin button
  522.         # setting outside element will cause ::tk::spinbox::Invoke to
  523.         # loop without doing anything
  524.         set Priv(outsideElement) ""
  525.         $w selection element none
  526.     }
  527.     } elseif {[info exists Priv(outsideElement)]} {
  528.     unset Priv(outsideElement)
  529.     $w selection element $Priv(element)
  530.     }
  531. }
  532.  
  533. # ::tk::spinbox::AutoScan --
  534. # This procedure is invoked when the mouse leaves an spinbox window
  535. # with button 1 down.  It scrolls the window left or right,
  536. # depending on where the mouse is, and reschedules itself as an
  537. # "after" command so that the window continues to scroll until the
  538. # mouse moves back into the window or the mouse button is released.
  539. #
  540. # Arguments:
  541. # w -        The spinbox window.
  542.  
  543. proc ::tk::spinbox::AutoScan {w} {
  544.     variable ::tk::Priv
  545.  
  546.     set x $Priv(x)
  547.     if {$x >= [winfo width $w]} {
  548.     $w xview scroll 2 units
  549.     ::tk::spinbox::MouseSelect $w $x ignore
  550.     } elseif {$x < 0} {
  551.     $w xview scroll -2 units
  552.     ::tk::spinbox::MouseSelect $w $x ignore
  553.     }
  554.     set Priv(afterId) [after 50 [list ::tk::spinbox::AutoScan $w]]
  555. }
  556.  
  557. # ::tk::spinbox::GetSelection --
  558. #
  559. # Returns the selected text of the spinbox.  Differs from entry in that
  560. # a spinbox has no -show option to obscure contents.
  561. #
  562. # Arguments:
  563. # w -         The spinbox window from which the text to get
  564.  
  565. proc ::tk::spinbox::GetSelection {w} {
  566.     return [string range [$w get] [$w index sel.first] \
  567.         [expr {[$w index sel.last] - 1}]]
  568. }
  569.