Version 0 of block-select

Updated 2003-02-18 14:53:14

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" "[email protected]"
 #

 # 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 <Control-ButtonPress-1> {
                set ::selCoords(%W) [%W index "@%x,%y"]
                set ::block_selecting 1
                break; # stop default binding
        }
        # during move
        bind $win <Control-Motion> {
                if {[info exists ::block_selecting] && $::block_selecting} then { 
                        mark_text %W %x %y
                        break; # stop default binding
                }
        }
        # end selecting
        bind $win <Control-ButtonRelease-1> {
                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 :)