[MSW] / 18. Feb 2003.

block-select allows you to use "block" (or "column") selecting in a textwidget. This can be interesting if you display a table of values, and want to allow the user to select some columns. In the current implementation, block-slecting is bound onto Control-Button-1 (and dragging to get a selection), which means the default binding (adjust insert index w/o touching selection) is overridden.
----
 #! /bin/sh
 # \
 exec wish "$0" "$@"

 # wrapping it up in an own namespace for sanity's sake.
 namespace eval block_select {
	package require Tk
	package provide block_select 1.0
	namespace export block_select

	array set selCoords {}
	array set block_selecting {}

 # selection handler for the text widget. win is the text-widget,
 # offset and len are provided by the selection caller. (see man selection)
 #
 # builds a list of lines in the text widget carrying the sel tag
 # and constructs a buffer, ending lines with newlines if necessary.
 # return that buffer.
 proc sel_text {win off len} {
	set start "0.0"
	set lines [list]
	set buf {}
	while {[string length [set start [$win tag nextrange sel $start]]]} {
		lappend lines [$win get [lindex $start 0] [lindex $start 1]]
		set start [lindex $start 1]
	}
	foreach l $lines {
		append buf $l
		if {[string index $l end] != "\n"} then { append buf "\n" }
	}
	return [string range $buf $off [expr $off + $len]]
 }

 # control proc to mark the current selection
 #
 proc mark_text {win x2 y2}  {
	variable selCoords
	selection clear

	foreach {x1 y1} $selCoords($win) {}

	if {$x1 > $x2} then {set x $x2; set endx $x1} else {set x $x1; set endx $x2}
	if {$y1 > $y2} then {set y $y2; set endy $y1} else {set y $y1; set endy $y2}

	while {$y <= $endy} {
		set bb [$win bbox "@$x,$y"]
		$win tag add sel "@$x,$y" "@$endx,$y"
		incr y [lindex $bb 3]
	}
 }

 proc block_select {win} {
	variable selCoords
	variable block_selecting
	selection handle -format STRING -type STRING -selection PRIMARY $win [namespace code "sel_text $win "]
	# start of selection
	bind $win <Control-ButtonPress-1> [namespace code {
		set selCoords(%W) [list %x %y]
		set block_selecting(%W) 1
		break; # stop default binding
	}]
	# during move
	bind $win <Control-Motion> [namespace code {
		if {[info exists block_selecting(%W)] && $block_selecting(%W)} then { 
			if {![info exists selCoords(%W)]} then { 
				set block_selecting(%W) 0
				break
			}
			mark_text %W %x %y
			break; # stop default binding
		}
	}]
	# end selecting
	bind $win <Control-ButtonRelease-1> [namespace code {
		if {[info exists block_selecting(%W)] && $block_selecting(%W)} then {
			mark_text %W %x %y
			catch {unset selCoords(%W)}
		}
		set block-selecting(%W) 0
		break; # stop default binding
	}]
	bind $win <KeyRelease-Control_L> [namespace code {
		if {[info exists block_selecting(%W)] && $block_selecting(%W)} then {
			set block-selecting(%W) 0
			catch {unset selCoords(%W)}
		}
	}]
	bind $win <KeyRelease-Control_R> [namespace code {
		if {[info exists block_selecting(%W)] && $block_selecting(%W)} then {
			set block-selecting(%W) 0
			catch {unset selCoords(%W)}
		}
	}]
 }

 } ;# end of namespace

 if {[info exists ::argv0] && $::argv0 == [info script]} then {

 # Testing
 proc build_text {parent} {
	text ${parent}.t -exportselection true
	pack ${parent}.t -expand yes -fill both
	${parent}.t insert 0.0 {
 block selecting fun: mult-table a*b

 a/b   7   8   9   10   11   12	tabs	mtabs
 1     7   8   9   10   11   12	one	one
 2    14  16  18   20   22   24	two	two
 3    21  24  27   30   33   36	three	three
 4    28  32  36   40   44   48	four	four
 5    35  40  45   50   55   60	five	five 
 6    42  48  54   60   66   72	six	six

	}
	return ${parent}.t
 }

 # for testing:
 wm withdraw .
 toplevel .test
 package require block_select
 block_select::block_select [build_text .test]

 }
----
MSW / 20. Feb 2003: block-select now works fine with tabs, be it user-defined global tabs, tag tabs, default tabs .... should've used the coordinates right from the beginning.
----
Remark: This (atm?) only works with exportselection true (the default). Thought I'd mention it :)

----
[Category Editor utility]