Version 5 of Text Drag -Drag and Drop for Text Widget Selections

Updated 2006-04-28 22:08:32

WJG 24-Oct-2005

 ############################################ 
 # text_drag.tcl
 # ------------------------
 # Written by: William J Giddings
 # 24th October, 2005
 ############################################ 
 # Description:
 # -----------
 # Rudimentary drag of selected text from one
 # location to another.
 #
 # Proceedures:
 # -----------
 # text_drag::init
 #
 # Note:
 # ----
 # This code sample does not handle formatting tags.
 # One possible solution to this would be to include ttd.
 ############################################

 set run_demo yes

 namespace eval text_drag {
  set dragstring ()
 }

 #---------------
 # a single proc to add new bindings
 #---------------
 proc text_drag::init {w} {
  # grab the text
  $w tag bind sel <Button-2> { 
    set text_drag::dragstring [%W get sel.first sel.last]
  }
  # and drop it
  bind $w <ButtonRelease-2> {
    if {$::text_drag::dragstring != ""} {
      %W delete sel.first sel.last
      %W insert @%x,%y $::text_drag::dragstring
      # move insert to end of the dragged selection
      %W mark set insert @%x,%y
      set tmp [%W index insert]
      %W mark set insert "$tmp + [string length $::text_drag::dragstring]c"
      # clear the dragged text
      set ::text_drag::dragstring ""
    }
  }
 }

 #---------------
 # the ubiqitous demo
 #---------------
 proc demo {} {
  text .txt
  pack .txt
  ::text_drag::init .txt
 }

 if {$run_demo} {demo}

ttd by Bryan Oakley '..is some experimental code investigating the possibility of defining a new file format capable of storing the contents of a Tk text widget.' Well recommended. I use it all the time.

WJG (28/Apr/2006) Here's a re-work of the above code. This time Button-1 can be used for the drag operations rather than Button-2. Also, the cursor changes from 'Xterm' to 'Arrow' when dragging the text around.

 ############################################
 # text_drag.tcl
 # ------------------------
 # Written by: William J Giddings
 # 28/Apr/2006
 ############################################
 # Description:
 # -----------
 # Rudimentary drag of selected text from one
 # location to another.
 #
 # Proceedures:
 # -----------
 # drag
 #
 # Note:
 # ----
 # This code sample does not handle formatting tags.
 # One possible solution to this would be to include ttd.
 ############################################

 namespace eval drag {
  set dragstring {}
  set drag 0
  set first 0
  set last 0
  set old_cursor {}

  # set tag colour settings for specific platforms 
  switch $tcl_platform(platform) {
    macintosh -
    windows {
      set fg systemHighlightText
      set bg systemHighlight
    }
    unix {
      set fg selectBackground 
      set bg selectForeground
    }
  }
 }

 #---------------
 # a single proc to add new bindings
 #---------------
 proc drag {w} {
   # if we're in 'drag' mode, prevent any new selection
   bind $w <B1-Motion> {
      if {$drag::drag == 1} {
        break
      }
    }

   # remark the text selection and modify cursor
   $w tag bind sel <Button-1> {
    set drag::dragstring [%W get sel.first sel.last]
    set drag::first [%W index sel.first]
    set drag::last [%W index sel.last]
    %W tag add drag sel.first sel.last
    # give the impression that the selection is still applied
    %W tag configure drag \
      -background $::drag::bg \
      -foreground $::drag::fg
    selection clear
    set drag::drag 1
    set drag::old_cursor [%W cget -cursor]
    %W configure -cursor arrow 
  }

  # move the selected text to the new location, reset cursor  
  bind $w <ButtonRelease-1> {
    if {$drag::drag==1} {
      set str [%W get $drag::first $drag::last]
      %W delete $drag::first $drag::last
      %W mark set insert @%x,%y
      set tmp [%W index insert]
      %W insert $tmp $str 
      # "$tmp + [string length $::drag::dragstring]c"
      %W tag delete drag
      set drag::drag 0
      %W configure -cursor $drag::old_cursor 
    }
  }
 }

 #---------------
 # the ubiqitous demo
 #---------------
 if {$run_demo} {
    catch {console show} 
    pack [text .txt]
    # attach drag bindings
    drag .txt
 }