Updated 2011-01-27 16:40:09 by AKgnome

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.
 #
 # Procedures:
 # -----------
 # 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.
 #
 # Procedures:
 # -----------
 # 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> {

  # do nothing if released within the original selection range
    if {[lsearch [%W tag name insert] drag]} {return}

    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
      %W tag delete drag
      set drag::drag 0
      %W configure -cursor $drag::old_cursor
    }
  }
 }

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

 [WJG] (10/May/05) Modified the Button-Release binding.

[Kite] (27/July/09) Fixed some errors, add drag move animation. Now work the same as Editplus.
 ############################################
 # text_drag.tcl
 # ------------------------
 # Written by: William J Giddings
 # 28/Apr/2006
 # Fixed by: Kitedriver
 # 27/July/2009
 ############################################
 # Description:
 # -----------
 # Rudimentary drag of selected text from one
 # location to another.
 #
 # Procedures:
 # -----------
 # drag
 #
 # 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 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} {
         # 當「點擊於選擇上」時, 「拖動」開始
         # remark the text selection and modify cursor
         $w tag bind sel <Button-1> {
                 puts dragbegin

                 # 用「選擇」建立「拖動標籤」, 并染色
                 set drag::dragstring [%W get sel.first sel.last] ;# %W表示控件$w, tcl語法
                 set drag::first [%W index sel.first]
                 set drag::last [%W index sel.last]
                 %W tag add drag $drag::first $drag::last
                 # give the impression that the selection is still applied
                 %W tag configure drag \
                         -background $::drag::bg \
                         -foreground $::drag::fg
                 selection clear

                 # 更改「鼠標」
                 set drag::old_cursor [%W cget -cursor]
                 %W configure -cursor arrow

                 # 舉起「拖動旗子」
                 set drag::drag 1
         }

         # 「拖動」時的定位, 動畫
         # if we're in 'drag' mode, prevent any new selection
         bind $w <B1-Motion> {
                 if {$drag::drag == 1} {
                         puts dragmove

                         # 移動「插入遊標」
                         %W mark set insert @%x,%y
                         break
                 }
         }

         # 「拖動」結束
         # move the selected text to the new location, reset cursor
         bind $w <ButtonRelease-1> {
                 if {$drag::drag==1} {
                         puts dragend

                         # 移動「插入遊標」
                         %W mark set insert @%x,%y

                         # 如果於原有「拖動標籤」內, 取消「拖動」
                         # Cancel dragging if released within the original selection range
                         if {[lsearch [%W tag names insert] drag]!=-1} {
                                 %W configure -cursor $drag::old_cursor
                                 %W tag delete drag
                                 set drag::drag 0
                                 return
                         }

                         # 進行實際的「文本移動」
                         set str [%W get $drag::first $drag::last]
                         %W delete $drag::first $drag::last

                         %W insert [%W index insert] $str

                         %W configure -cursor $drag::old_cursor

                         %W tag delete drag
                         set drag::drag 0
                 }
         }
 }

 #---------------
 # the ubiquitous demo
 #---------------
 if {$run_demo} {
         catch {console show}
         pack [text .txt]
         # attach drag bindings
         .txt insert 1.1 "hello world 1234567890"
         drag .txt
 }