Version 8 of Move cursor by display line in a text widget

Updated 2004-11-22 01:10:35

Note: Tk 8.5 has this capability by default, with no need for the complications below. However, until you are willing to upgrade to 8.5, ...

Christian Heide Damm responded in comp.lang.tcl [L1 ] on how to move the cursor up and down visible lines instead of real text widget lines:

...namely binding up/down to something like this:

     # Find the coordinates of the cursor and set the new height
     # manually. Note: errors rounding off, since
     # coordinates don't match character positions exactly.
     lset {lines char} [split [$textWidget index insert] .]
     lset {x y textWidth textHeight} [$textWidget bbox [$textWidget
     index insert]]
     lset {_ maxy _ _} [$textWidget bbox "end - 1 char"]
     # When updating position, make sure y is within text boundaries
     switch -- $upOrDown {
       "up" {
          set y [max [expr $y-$textHeight] 0]
       }
       "down" {
          set y [min [expr $y+$textHeight] $maxy]
       }
     }
     lset {newx newy width _} [$textWidget bbox [$textWidget index
     @$x,$y]]
     # Test on which side of the character
     # we should position the cursor
     if {$x>[expr $newx+$width/2]} {
       set x [expr $newx+$width+1]
     }
     set newIndex [$textWidget index @$x,$y]

Here is the above code in a function, with definitions for missing functions min/max and with missing function lset replaced with calls to scan. The code has also been modified to correctly handle more than a screenful of text. This code still lacks the feature found in the default tkTextUpDownLine where the original column is maintained across repeated operations even though some lines passed through don't have enough columns -- Brian Theado:

 proc min args {lindex [lsort -real $args] 0}
 proc max args {lindex [lsort -real $args] end}
 proc moveUpDown {textWidget upOrDown} {
     # Make the insertion cursor visible so bbox doesn't return empty list
     $textWidget see insert

     # Find the coordinates of the cursor and set the new height
     # manually. Note: errors rounding off, since
     # coordinates don't match character positions exactly.
     scan [$textWidget index insert] {%d.%d} lines char
     scan [$textWidget bbox [$textWidget index insert]] {%d %d %d %d} x y textWidth textHeight
     scan [$textWidget bbox @[winfo width $textWidget],[winfo height $textWidget]] {%*d %d %*d %*d} maxy
     # When updating position, make sure y is within text boundaries
     switch -- $upOrDown {
       "up" {
           if {$y <= $textHeight} {
               $textWidget yview scroll -1 units
           } else {
               set y [max [expr $y-$textHeight] 0]
           }
       }
       "down" {
           if {$y >= $maxy} {
                $textWidget yview scroll 1 units
           } else {
                set y [min [expr $y+$textHeight] $maxy]
           }
       }
     }
     scan [$textWidget bbox [$textWidget index @$x,$y]] {%d %d %d %*d} newx newy width

     # Test on which side of the character
     # we should position the cursor
     if {$x>[expr $newx+$width/2]} {
       set x [expr $newx+$width+1]
     }
     return [$textWidget index @$x,$y]
 }

 # Replace the default Text widget bindings to try it out
 bind Text <Up> {
    tkTextSetCursor %W [moveUpDown %W up]
 }
 bind Text <Down> {
    tkTextSetCursor %W [moveUpDown %W down]
 }

 # Selection via the keyboard should be re-bound for consistency (added 12/18/02)
 bind Text <Shift-Up> {
    tkTextKeySelect %W [moveUpDown %W up]
 }
 bind Text <Shift-Down> {
    tkTextKeySelect %W [moveUpDown %W down]
 }

I had to tweak Brian's code to make it work. I replaced tkTextSetCursor with tk::TextSetCursor and tkTextKeySelect with tk::TextKeySelect. I also noted the code doesn't work when the text in the widget is formatted with spacing or superscripting, etc. I added the following code:

 set spacing 0
 foreach tagName [$textWidget tag names insert] {
    set tagSpacing [$textWidget tag cget $tagName -spacing2]
    if { $tagSpacing != "" } {
       set spacing [max $spacing $tagSpacing]
    }
 }
 incr textHeight $spacing

just after the scan which gets the value for the textHeight variable. This worked for my application, but it was around this point I realised how difficult it would be to do the job completely and how far out of my depth I was. :o}


Before I had found this great resource I had written my own function which actually replaces the ::tk::TextUpDownLine funtion and therefore 'all' the bindings should still work correctly. This includes the up/down and any special key with them, eg shift-up. I am not sure whose method is more efficient however I thought I would post it here for people to have a choice. It also handles the variable ::tk::Priv which the above code doesn't. -- Lio:

 # ::tk::TextUpDownLine --
 # Returns the index of the character one line above or below the
 # insertion cursor.  There are two tricky things here.  First,
 # we want to maintain the original column across repeated operations,
 # even though some lines that will get passed through don't have
 # enough characters to cover the original column.  Second, we need
 # to take into account wrapped lines.
 #
 # Arguments:
 # w -                The text window in which the cursor is to move.
 # n -                The number of lines to move: -1 for up one line,
 #                +1 for down one line.

 proc ::tk::TextUpDownLine {w n} {
    variable ::tk::Priv

    set bbox [$w bbox insert]
    set xpos [expr [lindex $bbox 0]+[lindex $bbox 2]/3]
    set ypos [lindex $bbox 1]
    set height [lindex $bbox 3]
    set weight [lindex [$w configure -height] end]

    set i [$w index insert]
    if {[string compare $Priv(prevPos) $i]} {
        set Priv(pos) $xpos
    }

    if { ($n < 0) && ($ypos <= $height) } {
        $w yview scroll $n units
        update
        set ypos [lindex [$w bbox insert] 1]
        set height [lindex [$w bbox insert] 3]
    } elseif { ($n > 0) && ([expr $ypos+$height] >= [expr $weight*$height]) } {
        $w yview scroll $n units
        update
        set ypos [lindex [$w bbox insert] 1]
        set height [lindex [$w bbox insert] 3]
        set weight [lindex [$w configure -height] end]
    }

    if { (($n < 0) && ($ypos > $height)) || (($n > 0) && ([expr $ypos+$height] < [expr $weight*$height])) } {
        set new [$w index "@$Priv(pos),[expr $ypos+($n)*$height]"]
    } else {
        set new $i
    }

    set Priv(prevPos) $new
    return $new
 }

Category GUI