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 / dnd.tcl < prev    next >
Encoding:
Text File  |  2009-12-04  |  3.2 KB  |  102 lines
  1. #
  2. # dnd.tcl
  3. #
  4. # ----------------------------------------------------------------------
  5. # Bindings for the BLT drag&drop command
  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. if { $tcl_version >= 8.0 } {
  35.     set cmd blt::dnd
  36. } else {
  37.     set cmd dnd
  38. }
  39. for { set i 1 } { $i <= 5 } { incr i } {
  40.     bind BltDndButton$i <ButtonPress-$i>  [list $cmd select %W %X %Y %t]
  41.     bind BltDndButton$i <B$i-Motion>      [list $cmd drag %W %X %Y]
  42.     bind BltDndButton$i <ButtonRelease-$i> [list $cmd drop %W %X %Y]
  43. }
  44.  
  45. # ----------------------------------------------------------------------
  46. #
  47. # DndInit --
  48. #
  49. #    Invoked from C whenever a new drag&drop source is created.
  50. #    Sets up the default bindings for the drag&drop source.
  51. #
  52. #    <ButtonPress-?>     Starts the drag operation.
  53. #    <B?-Motion>     Updates the drag.
  54. #    <ButtonRelease-?> Drop the data on the target.
  55. #
  56. # Arguments:    
  57. #    widget        source widget
  58. #    button        Mouse button used to activate drag.
  59. #    cmd        "dragdrop" or "blt::dragdrop"
  60. #
  61. # ----------------------------------------------------------------------
  62.  
  63. proc blt::DndInit { widget button } {
  64.     set tagList {}
  65.     if { $button > 0 } {
  66.     lappend tagList BltDndButton$button
  67.     }
  68.     foreach tag [bindtags $widget] {
  69.     if { ![string match BltDndButton* $tag] } {
  70.         lappend tagList $tag
  71.     }
  72.     }
  73.     bindtags $widget $tagList
  74. }
  75.  
  76. proc blt::DndStdDrop { widget args } {
  77.     array set info $args
  78.     set fmt [lindex $info(formats) 0]
  79.     dnd pull $widget $fmt 
  80.     return 0
  81. }
  82.  
  83. proc blt::PrintInfo { array } {
  84.     upvar $array state
  85.  
  86.     parray state
  87.     if { $info(state) & 0x01 } {
  88.     puts "Shift-Drop"
  89.     }
  90.     if { $info(state) & 0x02 } {
  91.     puts "CapsLock-Drop"
  92.     }
  93.     if { $info(state) & 0x04 } {
  94.     puts "Control-Drop"
  95.     }
  96.     if { $info(state) & 0x08 } {
  97.     puts "Alt-Drop"
  98.     }
  99.     if { $info(state) & 0x10 } {
  100.     puts "NumLock-Drop"
  101.     }
  102. }