- Control-ButtonPress-1 to activate block selection
- Control-Button1-Motion to modify (increase/decrease) the selection
- Control-x to cut selection, Control-c to copy selection to clipboard
- Troubles when using Tabs
- Selection currently works only from top-left to bottom-right
##########################################################
# Name: blocksel.tcl
# Author: Martin Eder, [email protected]
# Description: Enables block selection for text widgets
##########################################################
variable spos
proc block_sel {wid x y} {
$wid tag remove sel 0.0 end
set fpos [split [$wid index "@$x,$y"] "."]
for {set sl [lindex $::spos 0]} {$sl <= [lindex $fpos 0]} {incr sl} {
$wid tag add sel "$sl.[lindex $::spos 1]" "$sl.[lindex $fpos 1]"
}
}
proc mouse_down {wid x y} {
$wid mark set insert "@$x,$y"
$wid tag remove sel 0.0 end
set ::spos [split [$wid index insert] "."]
}
proc copy_blocksel {txt {cutit 0}} {
set starttag [$txt index end]
set mseltxt ""
while {[set curmtag [$txt tag prevrange sel $starttag]] != ""} {
set msta [lindex $curmtag 0]
set msto [lindex $curmtag 1]
set mseltxt "[$txt get $msta $msto]\n$mseltxt"
if {$cutit == 1} {$txt delete $msta $msto}
set starttag [lindex $curmtag 0]
}
if {$mseltxt != ""} {
clipboard clear
clipboard append -- $mseltxt
}
}
bind Text <Control-ButtonPress-1> [list mouse_down %W %x %y]
bind Text <Control-Button1-Motion> [list block_sel %W %x %y]
bind Text <Control-Key-x> [list copy_blocksel .txt 1]
bind Text <Control-Key-c> [list copy_blocksel .txt 0]
# Testing the code:
pack [text .txt -font "Courier 10"]
.txt insert end "To activate block-selection press Ctrl + left mouse button
and keep pressed. Move the mouse to increase/decrease the block.
Press Ctrl+c to copy the selection to the clipboard.
Press Ctrl+x to cut the selection.
Known Issues: -Difficulties with <Tabs>
-Selection just works just from top-left to bottom-right"
### End Of ScriptSee also text .
SeS - 2010-02-01 12:09:21Hi, thank you for the script to enable block selection. I was able to improve the script to enable selection from bottom-right to top-left direction.(As implemented in tG2
v1.06.01)proc block_sel {wid x y} {
$wid tag remove sel 0.0 end
set fpos [split [$wid index "@$x,$y"] "."]
catch {
if {[lindex $fpos 0] > [lindex $::spos 0]} {
for {set sl [lindex $::spos 0]} {$sl <= [lindex $fpos 0]} {incr sl} {
$wid tag add sel "$sl.[lindex $::spos 1]" "$sl.[lindex $fpos 1]"
}
} else {
for {set sl [lindex $::spos 0]} {$sl >= [lindex $fpos 0]} {incr sl -1} {
$wid tag add sel "$sl.[lindex $fpos 1]" "$sl.[lindex $::spos 1]"
}
}
}
}
