[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 set ::text_drag::dragstring "" } } } #--------------- # the ubiqitous demo #--------------- proc demo {} { text .txt pack .txt ::text_drag::init .txt } if {$run_demo} {demo}