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
}
