text.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

#
# Arguments:
# w -		The text window.
# pos -		The desired new position for the cursor in the window.

proc tkTextSetCursor {w pos} {
    global tkText tkBind

    if $tkText(${w},markActive) {
        return [tkTextKeySelect ${w} ${pos}]
    }

    if [${w} compare ${pos} == end] {
        set pos {end - 1 chars}
    }
    ${w} mark set insert ${pos}

    ${w} tag remove sel 1.0 end
    ${w} see insert

    set tkText(${w},prevPos) {}
    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) SetCursor
    set tkBind(${w},mesg) {}
}

# tkTextKeySelect
# This procedure is invoked when stroking out selections using the
# keyboard. It moves the cursor to a new position, then extends
# the selection to that position.
#
# Arguments:
# w -		The text window.
# new -		A new position for the insertion cursor (the cursor hasn't
#		actually been moved to this position yet).

proc tkTextKeySelect {w new} {
    global tkText tkBind

    if {[${w} tag nextrange sel 1.0 end] == ""} {
        if [${w} compare ${new} < insert] {
            ${w} tag add sel ${new} insert
        } else {
            ${w} tag add sel insert ${new}
        }
        ${w} mark set anchor insert
    } else {
        if [${w} compare ${new} < anchor] {
            set first ${new}
            set last anchor
        } else {
            set first anchor
            set last ${new}
        }
        ${w} tag remove sel 1.0 ${first}
        ${w} tag add sel ${first} ${last}
        ${w} tag remove sel ${last} end
    }
    ${w} tag raise sel
    ${w} mark set insert ${new}
    ${w} see insert
    update idletasks

    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) KeySelect
    set tkBind(${w},mesg) {}
}

# tkTextResetAnchor --
# Set the selection anchor to whichever end is farthest from the
# index argument. One special trick: if the selection has two or
# fewer characters, just leave the anchor where it is. In this
# case it doesn't matter which point gets chosen for the anchor,
# and for the things like Shift-Left and Shift-Right this produces
# better behavior when the cursor moves back and forth across the
# anchor.
#
# Arguments:
# w -		The text widget.
# index -	Position at which mouse button was pressed, which determines
#		which end of selection should be used as anchor point.

proc tkTextResetAnchor {w index} {
    global tkText tkBind

    if {[${w} tag ranges sel] == ""} {
        ${w} mark set anchor ${index}
        return
    }
    set a [${w} index ${index}]
    set b [${w} index sel.first]
    set c [${w} index sel.last]
    if [${w} compare ${a} < ${b}] {
        ${w} mark set anchor sel.last
        return
    }
    if [${w} compare ${a} > ${c}] {
        ${w} mark set anchor sel.first
        return
    }
    scan ${a} "%d.%d" lineA chA
    scan ${b} "%d.%d" lineB chB
    scan ${c} "%d.%d" lineC chC
    if {${lineB} < ${lineC}+2} {
        set total [string length [${w} get ${b} ${c}]]
        if {${total} <= 2} {
            return
        }
        if {[string length [${w} get ${b} ${a}]] <(${total}/2)} {
            ${w} mark set anchor sel.last
        } else {
            ${w} mark set anchor sel.first
        }
        return
    }
    if {(${lineA}-${lineB}) <(${lineC}-${lineA})} {
        ${w} mark set anchor sel.last
    } else {
        ${w} mark set anchor sel.first
    }

    set tkText(${w},markActive) 0
    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) ResetAnchor
    set tkBind(${w},mesg) {}
}

# tkTextInsertChar --
# Insert a string into a text at the point of the insertion cursor.
# If there is a selection in the text, and it covers the point of the
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w -		The text window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkTextInsertChar {w s} {
    global tkText tkBind

    if {${s} == "" || ${s} == "{}" || [${w} cget -state] == "disabled"} {
        return "no"
    }

    set txt {}
    set cutbuf {}
    for {set n [tkBindDefArg ${w} +]} {${n} > 0} {incr n -1} {
        append txt ${s}
    }
    if {$tkBind(delSel) && [${w} tag nextrange sel 1.0 end] != "" &&\
      [${w} compare sel.first <= insert] && [${w} compare sel.last >= insert]} {
        set cutbuf [tkTextCopyTagBuffer ${w} sel.first sel.last]
        SyncEditors $w delete sel.first sel.last
        catch {${w} delete sel.first sel.last}
    }\
    elseif $tkText(${w},ovwrt) {
        set ndx [${w} index "insert + [string length ${txt}] chars"]
        if [${w} compare ${ndx} > "insert lineend"] {
            set ndx "insert lineend"
        }
        set cutbuf [tkTextCopyTagBuffer ${w} insert ${ndx}]
        ${w} delete insert ${ndx}
    }

    set start [${w} index insert]
    set high_idx ${start}
    SyncEditors $w insert insert $txt
    ${w} insert insert ${txt}
    ${w} see insert
    #update idletasks
    set y [lindex [${w} bbox insert] 1]
    if {$tkText(${w},fillCol) && [lindex [${w} bbox insert] 0] >\
      $tkText(${w},fillWidth)} {
        tkTextUndoBeginGroup ${w} wrap
        set wrap 1
    } else {
        set wrap 0
    }

    if {[info exists tkText(${w},undoCnt)]} {
        if {$tkText(${w},ovwrt) || $tkText(${w},prevCmd) != "InsertChar" ||\
          $tkText(${w},undoLast) != ${start} || [string length\
          $tkText(${w},undoCut)]} {
            tkTextUndoPush ${w} ${cutbuf} ${start} insert
        } else {
            set tkText(${w},undoLast) [${w} index insert]
        }
    }

    if ${wrap} {
        ${w} mark set fillstart insert
        ${w} mark set insert "@$tkText(${w},fillWidth),${y}"
        tkTextWrapWord ${w}
        tkTextUndoEndGroup ${w} wrap
        ${w} mark set insert fillstart
    }

    uplevel #0 "set tkText(${w},toplevel).linenum \[${w} index insert\]"

    ${w} see insert
    ${w} tag remove sel 1.0 end
    set tkText(${w},markActive) 0
    set tkText(${w},prevCmd) InsertChar
    set tkBind(${w},mesg) {}

    synch_highlight ${w} ${high_idx}
    return ""
}

# tkTextInsert --
# Wrapper around normal text insert to handle undo and stuff
#
# Arguments:
# w -		The text window in which to insert the string
# ndx -		Point to insert text at.
# args -	As in 'text insert' -> string taglist ...

proc tkTextInsert {w ndx args} {
    global tkText tkBind

    if {([${w} cget -state] == "disabled") || ![llength ${args}]} return
    set ins [${w} index insert]
    set ndx [${w} index ${ndx}]
    ${w} mark set insert ${ndx}

    eval "SyncEditors $w insert insert ${args}"
    eval "${w} insert insert ${args}"
    synch_highlight ${w} ${ndx}

    tkTextUndoPush ${w} {} ${ndx} insert

    ${w} see insert

    #	$w mark set insert $ins
    set tkText(${w},markActive) 0
    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) Insert
}

# tkTextReplace --
# Wrapper around normal text insert & delete to handle undo and stuff
#
# Arguments:
# w -		The text window in which to insert the string
# ndx1 -	Start point of text to replace.
# ndx2 -	End point of text to replace.
# s -		The string to insert
# t -		List of tags to apply to inserted text

proc tkTextReplace {w ndx1 ndx2 s {t {}}} {
    global tkText tkBind

    if {[${w} cget -state] == "disabled"} return
    if [${w} compare ${ndx1} < ${ndx2}] {
        set cutbuf [tkTextCopyTagBuffer ${w} ${ndx1} ${ndx2}]
	SyncEditors $w delete ${ndx1} ${ndx2}
        ${w} delete ${ndx1} ${ndx2}
    } else {
        set cutbuf [tkTextCopyTagBuffer ${w} ${ndx2} ${ndx1}]
	SyncEditors $w delete ${ndx2} ${ndx1}
        ${w} delete ${ndx2} ${ndx1}
    }

    set ndx1 [${w} index ${ndx1}]
    ${w} mark set insert ${ndx1}
    SyncEditors $w insert ${ndx1} $s $t
    ${w} insert ${ndx1} ${s} ${t}
    tkTextUndoPush ${w} ${cutbuf} ${ndx1} insert
    ${w} see insert

    ${w} tag remove sel 1.0 end
    set tkText(${w},markActive) 0
    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) Replace
    set tkBind(${w},mesg) {}
    synch_highlight ${w} ${ndx1}
}

# tkTextDelete --
# Deletes characters between text indices 'ndx1' and 'ndx2'.
#
# Arguments:
# w -		The text window in which to delete
# ndx1,ndx2 -	Text indices surrounding text to delete
# dsel		If true, delete selection instead if it exists
# cut -		If true, add deletion to kill ri

proc tkTextDelete {w ndx1 {ndx2 {}} {dsel 0} {cut 0}} {
    global tkText tkBind

    if {[${w} cget -state] == "disabled"} return
    if {![string length ${ndx2}]} {
        set ndx2 ${ndx1}
    }

    if {$tkText(${w},prevCmd) == "Delete" && [${w} compare\
      $tkText(${w},killLast) == insert]} {
        set where 1
    } else {
        set where 0
    }

    if {${dsel} && ![catch {set cuttxt [${w} get sel.first sel.last]}] &&\
      [${w} compare sel.first <= insert] && [${w} compare sel.last >= insert]} {
        set start [${w} index sel.first]
        set cutbuf [tkTextCopyTagBuffer ${w} sel.first sel.last]
        SyncEditors $w delete sel.first sel.last
        ${w} delete sel.first sel.last
    } else {
        if [${w} compare ${ndx1} < ${ndx2}] {
            set start [${w} index ${ndx1}]
            set cuttxt [${w} get ${ndx1} ${ndx2}]
            set cutbuf [tkTextCopyTagBuffer ${w} ${ndx1} ${ndx2}]
            SyncEditors $w delete $ndx1 $ndx2
            ${w} delete ${ndx1} ${ndx2}
        } else {
            set start [${w} index ${ndx2}]
            set cuttxt [${w} get ${ndx1} ${ndx2}]

            set cutbuf [tkTextCopyTagBuffer ${w} ${ndx2} ${ndx1}]
            SyncEditors $w delete $ndx2 $ndx1
            ${w} delete ${ndx2} ${ndx1}
        }
        ${w} see insert
    }
    synch_highlight ${w} [${w} index insert]

    tkTextUndoPush ${w} ${cutbuf} ${start} ${start}
    if ${cut} {
        tkTextPushTagBuffer ${cutbuf} ${where}
        set tkText(${w},killLast) [${w} index insert]
        clipboard clear -displayof ${w}
        clipboard append -displayof ${w} ${cuttxt}
    }
    set tkText(${w},markActive) 0
    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) Delete
    set tkBind(${w},mesg) {}

    uplevel #0 "set tkText(${w},toplevel).linenum \[${w} index insert\]"
}

# tkTextEatSpace --
# Deletes whitespace characters around insert mark
#
# Arguments:
# w -		The text window in which to eat space

proc tkTextEatSpace {w} {
    global tkText

    if {[${w} cget -state] == "disabled"} return
    set ndx [${w} index insert]
    while {[string match "\[ \t\]" [${w} get ${ndx}]]} {
        set ndx [${w} index "${ndx} +1 char"]
    }
    while {[string match "\[ \t\]" [${w} get "insert -1 char"]]} {
        ${w} mark set insert "insert -1 char"
    }
    if {[${w} compare insert < ${ndx}]} {
        tkTextDelete ${w} insert ${ndx} 0 0
    }
}

# tkTextEatLines --
# Deletes blank lines around current line
#
# Arguments:
# w -		The text window in which to eat lines

proc tkTextEatLines {w} {
    global tkText

    if {[${w} cget -state] == "disabled"} return
    set ndx [${w} index insert]
    ${w} mark set insert "insert linestart"
    while {[${w} get "insert +1 line"] == "\n"} {
        ${w} mark set insert "insert +1 line"
    }
    set last [${w} index "insert + 1 line"]
    ${w} mark set insert "${ndx} linestart"
    if {[${w} get insert] == "\n"} {
        while {[${w} get "insert -1 line"] == "\n"} {
            ${w} mark set insert "insert -1 line"
        }
        set start [${w} index insert]
    } else {
        set start [${w} index "insert +1 line"]
    }

    ${w} mark set insert ${ndx}
    if {[${w} compare ${start} < ${last}]} {
        tkTextDelete ${w} ${start} ${last} 0 0
    }
}

# tkTextYank --
# Paste contents from kill buffer stack in to text widget
#
# Arguments:
# w -		The text window in which to yank
# n -		Depth in to kill buffer stack

proc tkTextYank {w {n 1}} {
    global tkText tkBind

    if {[${w} cget -state] == "disabled"} return

    set n [tkBindDefArg ${w} ${n}]
    set rng [tkTextInsertTagBuffer ${w} insert [tkTextGetTagBuffer ${n}]]
    set ndx [lindex ${rng} 0]
    ${w} mark set emacs ${ndx}
    ${w} mark set anchor ${ndx}
    tkTextUndoPush ${w} {} ${ndx} [lindex ${rng} 1]
    ${w} see insert

    ${w} tag remove sel 1.0 end
    set tkText(${w},markActive) 0
    set tkText(${w},prevCmd) Yank
    set tkBind(${w},mesg) {}
}

# tkTextYank --
# Replace previous yank with next contents of kill buffer stack
#
# Arguments:
# w -		The text window in which to yank
# n -		Depth in to kill buffer stack

proc tkTextYankPop {w {n 1}} {
    global tkText tkBind

    if {$tkText(${w},prevCmd) != "Yank"} {
        eval $tkBind(bell)
        return
    }
    set n [tkBindDefArg ${w} ${n}]

    ${w} delete emacs insert

    set rng [tkTextInsertTagBuffer ${w} insert [tkTextGetTagBuffer [incr n]]]
    set ndx [lindex ${rng} 0]
    ${w} mark set emacs ${ndx}
    ${w} mark set anchor ${ndx}

    if {[info exists tkText(${w},undoCnt)]} {
        set tkText(${w},undoFirst) ${ndx}
        set tkText(${w},undoLast) [lindex ${rng} 1]
    }

    set tkText(${w},prevCmd) Yank
    set tkBind(${w},mesg) {}
}

# tkTextCopy --
# Place currently marked region onto kill buffer stack
#
# Arguments: