[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 { set text_drag::dragstring [%W get sel.first sel.last] } # and drop it bind $w { 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 { if {$drag::drag == 1} { break } } # remark the text selection and modify cursor $w tag bind sel { 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 { # 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 ubiqitous 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 error, 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. # # Proceedures: # ----------- # 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 { 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 { 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 { 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 ubiqitous demo #--------------- if {$run_demo} { catch {console show} pack [text .txt] # attach drag bindings .txt insert 1.1 "hello world 1234567890" drag .txt }