[MSW] / 18. Feb 2003. I was stumbling over wanting to block select columns etc. from a text widget, and played around some until it finally worked. Well, more or less worked. ---- #! /bin/sh # -- restarting # \ exec wish "$0" "$@" # # block selecting fun: mult-table a*b # # a/b 7 8 9 10 11 12 # 1 7 8 9 10 11 12 # 2 14 16 18 20 22 24 # 3 21 24 27 30 33 36 # 4 28 32 36 40 44 48 # 5 35 40 45 50 55 60 # 6 42 48 54 60 66 72 # here some tabs to demonstrate tab # problem ..... happy jumping... # create text widget, fill it with the contents of # this file; return the pathname to the text widget. proc build_text {parent} { text ${parent}.t -exportselection true pack ${parent}.t -expand yes -fill both set fp [open block-select.tcl] ${parent}.t insert 0.0 [read $fp] close $fp return ${parent}.t } # 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]] } # quick and dirty control proc to mark the current selection # proc mark_text {win x y} { selection clear foreach {line1 char1} [split $::selCoords($win) {.}] {} foreach {line2 char2} [split [$win index "@$x,$y"] {.}] {} if {$line1>$line2} then { set line $line2 set endline $line1 } else { set line $line1 set endline $line2 } if {$char1>$char2} then { set char $char2 set endchar $char1 } else { set char $char1 set endchar $char2 } incr endchar; incr endline for {} {$line != $endline} {incr line} { $win tag add sel "$line.$char" "$line.$endchar" } } proc block_select {win} { selection handle -format STRING -type STRING -selection PRIMARY $win "sel_text $win " # start of selection bind $win { set ::selCoords(%W) [%W index "@%x,%y"] set ::block_selecting 1 break; # stop default binding } # during move bind $win { if {[info exists ::block_selecting] && $::block_selecting} then { mark_text %W %x %y break; # stop default binding } } # end selecting bind $win { mark_text %W %x %y unset ::selCoords(%W) set ::block-selecting 0 break; # stop default binding } } # for testing: wm withdraw . toplevel .test block_select [build_text .test] ---- When you paste that into block-select.tcl (shame on me, I hardcoded the path in the example :>) and run it, you can check it out with the multiplication table up there... Control + button-1, keep it pressed, drag your block selection, release button-1 when done. When you then ask for the selection (selection get, or e.g. pasting via the middle mouse button), you will get the block. So far so good... '''but''' - check the second one (uhm, not sure if the wiki preserves the tabs), the words are separated by tabs, not whitespace. Well, now tab counts as one char in the textwidget, but it's 8 (in the default setting) chars width. This means the block selection "jumps" when you try to select a column with tabs. Yup, you can use $win cget -tabs and either check how wide those tabs are or assume 8 if that returns a null list, and act accordingly in mark_text and sel_text. ''Ahem''. And that's still to come :) ---- Remark: This (atm) only works with exportselection true (the default). Thought I'd mention it :)