util/X86LINUX64/lib/blt2.5/dnd.tcl

   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 }