text.tcl

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

            set rng [${w} tag nextrange ${tagname} ${beg} ${stop}]
        } else {
            set rng [${w} tag nextrange ${tagname} ${start} ${stop}]
        }
        while {[llength ${rng}]} {
            if {[${w} compare [lindex ${rng} 1] >= ${start}]} {
                lappend tagspecs [tkTextGetTagOffsets ${w} ${tagname} ${start}\
                  ${stop} ${rng}]
            }
            set rng [${w} tag nextrange ${tagname} [lindex ${rng} 1] ${stop}]
        }
    }

    return [list [${w} get ${start} ${stop}] ${tagspecs}]
}

proc tkTextGetTagOffsets {w tagname anchor stop rng} {
    set rngbeg [lindex ${rng} 0]
    set rngend [lindex ${rng} 1]
    if [${w} compare ${rngend} < ${anchor}] return
    if [${w} compare ${rngend} > ${stop}] {
        set rngend ${stop}
    }
    if [${w} compare ${rngbeg} < ${anchor}] {
        set rngbeg ${anchor}
    }

    scan ${anchor} "%d.%d" aline achar
    scan ${rngbeg} "%d.%d" bline bchar
    scan ${rngend} "%d.%d" eline echar

    if {${aline} == ${bline}} {
        set boffset "+ [expr ${bchar}-${achar}] c"
    } else {
        set boffset "+ [expr ${bline}-${aline}] l linestart + ${bchar} c"
    }

    if {${aline} == ${eline}} {
        set eoffset "+ [expr ${echar}-${achar}] c"
    } else {
        set eoffset "+ [expr ${eline}-${aline}] l linestart + ${echar} c"
    }
    return [list ${tagname} ${boffset} ${eoffset}]
}

proc tkTextInsertTagBuffer {w ndx cutbuf {tlist {}}} {

    if {[${w} cget -state] == "disabled"} return
    set ndx [${w} index ${ndx}]
    ${w} mark set insert ${ndx}
    ${w} tag remove sel 1.0 end

    while {[llength ${cutbuf}]} {

        set start [${w} index insert]

        #$w insert insert [lvarpop cutbuf]
        SyncEditors $w insert insert [lindex ${cutbuf} 0]
        ${w} insert insert [lindex ${cutbuf} 0]
        set cutbuf [lrange ${cutbuf} 1 end]

        foreach tagname [${w} tag names] {
            ${w} tag remove ${tagname} ${start} insert
        }

        #set tagspecs [lvarpop cutbuf]
        set tagspecs [lindex ${cutbuf} 0]
        set cutbuf [lrange ${cutbuf} 1 end]

        foreach tagspec ${tagspecs} {
            set tagname [lindex ${tagspec} 0]
            if {[llength ${tlist}] && [lsearch -exact ${tlist} ${tagname}] <\
              0} continue
            set boffset [lindex ${tagspec} 1]
            set eoffset [lindex ${tagspec} 2]
            ${w} tag add ${tagname} "${start} ${boffset}" "${start} ${eoffset}"
        }
    }

    return [list ${ndx} [${w} index insert]]
}

proc tkTextPushTagBuffer {thiscut {where 0}} {
    global tkText tkBind

    if ${where} {
        #set lastcut [lvarpop tkBind(killRing) end]
        set len [llength $tkBind(killRing)]
        set lastcut [lindex $tkBind(killRing) end]
        set tkBind(killRing) [lrange $tkBind(killRing) 0 [expr ${len} - 2]]

        if {${where} < 0} {
            set thiscut [concat ${thiscut} ${lastcut}]
        } else {
            set thiscut [concat ${lastcut} ${thiscut}]
        }
        lappend tkBind(killRing) ${thiscut}
    } else {
        set tkBind(killLen) [llength [lappend tkBind(killRing) ${thiscut}]]
        if {$tkBind(killLen) > $tkBind(killMax)} {
            incr tkBind(killLen) -1

            #lvarpop tkBind(killRing)
            set tkBind(killRing) [lrange $tkBind(killRing) 1 end]
        }
    }
    set tkBind(killPtr) 0
}

proc tkTextPopTagBuffer {} {
    global tkText tkBind

    if {$tkBind(killLen) == 0} {
        return ""
    }

    #set lastcut [lvarpop tkBind(killRing) end]
    set len [llength $tkBind(killRing)]
    set lastcut [lindex $tkBind(killRing) end]
    set tkBind(killRing) [lrange $tkBind(killRing) 0 [expr ${len} - 2]]

    incr tkBind(killLen) -1
    set tkBind(killPtr) 0
    return ${lastcut}
}

proc tkTextGetTagBuffer {{ndx 1}} {
    global tkText tkBind

    if {$tkBind(killLen) == 0} {
        return ""
    }
    set ndx [expr ${ndx}+$tkBind(killPtr)]
    set tkBind(killPtr) [expr ${ndx}-1]
    set ndx [expr ${ndx}%$tkBind(killLen)]
    if {${ndx} == 0} {
        set ndx $tkBind(killLen)
    }
    return [lindex $tkBind(killRing) [expr $tkBind(killLen)-${ndx}]]
}

proc tkTextGetBufferText {{ndx 1}} {
    set cutbuf [tkTextGetTagBuffer ${ndx}]
    set txt {}
    #while {[llength $cutbuf]} {
    #	append txt [lvarpop cutbuf]
    #	lvarpop cutbuf
    #}
    set i 0
    foreach item ${cutbuf} {
        if {${i} > 0} {
            set i 0
            continue
        }
        append txt ${item}
        incr i
    }
    return ${txt}
}

######################################################################
# UNDO ROUTINES
######################################################################

# tkTextUndoSetup --
# Initialize globals for handling undo ring in given widget
#
# Arguments:
# w -		The text window 

proc tkTextUndoSetup {w} {
    global tkText

    set tkText(${w},undoCnt) 0
    set tkText(${w},undoPtr) 0
    set tkText(${w},undoCut) {}
    set tkText(${w},undoFirst) -1.0
    set tkText(${w},undoLast) -1.0
    set tkText(${w},undoList) {}
    set tkText(${w},undoSafe) 1
}

# tkTextUndoFree --
# Free globals for handling undo ring in given widget
#
# Arguments:
# w -		The text window 

proc tkTextUndoFree {w} {
    global tkText

    if {![info exists tkText(${w},undoCnt)]} return
    unset tkText(${w},undoCnt)
    unset tkText(${w},undoPtr)
    unset tkText(${w},undoCut)
    unset tkText(${w},undoFirst)
    unset tkText(${w},undoLast)
    unset tkText(${w},undoList)
    unset tkText(${w},undoSafe)
}

# tkTextUndo --
# Undo the last modification to the given text widget and
# reset text state globals
#
# Arguments:
# w -		The text window 

proc tkTextUndo {w} {
    global tkText tkBind

    set high_idx [${w} index insert]
    if {![info exists tkText(${w},undoCnt)] || ![info exists\
      tkText(${w},prevCmd)]} {
        return "no"
    }

    ${w} tag remove sel 1.0 end
    set tkBind(${w},mesg) {Undo.}
    if {$tkText(${w},prevCmd) != "Undo"} {
        set tkText(${w},undoPtr) $tkText(${w},undoCnt)
    }
    set tkText(${w},undoSafe) 0
    tkTextUndoPop ${w}
    set tkText(${w},undoSafe) 1
    set tkText(${w},markActive) 0
    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) Undo

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

# tkTextUndoPush --
# Push information on undo ring on how to undo a modification
#
# Arguments:
# w -		The text window 
# cutbuf -	Cut buffer of text that used to be between the
#			text indices first and last
# first, last - The start and ending text indices of affected
#			region of text widget

proc tkTextUndoPush {w cutbuf first last} {
    global tkText tkBind

    if {![info exists tkText(${w},undoCnt)]} {
        return "no"
    }

    if [${w} compare ${first} == ${last}] {
        if {![string length ${cutbuf}]} {
            return "no"
        }
    }

    set first [${w} index ${first}]
    set last [${w} index ${last}]

    lappend tkText(${w},undoList) [list $tkText(${w},undoCut)\
      $tkText(${w},undoFirst) $tkText(${w},undoLast)]
    set tkText(${w},undoCut) ${cutbuf}
    set tkText(${w},undoFirst) ${first}
    set tkText(${w},undoLast) ${last}

    incr tkText(${w},undoCnt)
    if {$tkText(${w},undoCnt) > $tkBind(undoMax) && $tkText(${w},undoSafe)} {
        set num [expr $tkText(${w},undoCnt)-$tkBind(undoMax)]
        set tkText(${w},undoList) [lreplace $tkText(${w},undoList) 1 ${num}]
        set tkText(${w},undoCnt) $tkBind(undoMax)
    }

    return ""
}

# tkTextUndoPop --
# Undo the last modification to the given text widget
#
# Arguments:
# w -		The text window 

proc tkTextUndoPop {w} {
    global tkText tkBind

    if {![info exists tkText(${w},undoCnt)]} {
        eval $tkBind(bell)
        error "Undo tracking is not turned on for this text widget!"
    }

    if {$tkText(${w},undoPtr) < 1} {
        eval $tkBind(bell)
        set tkBind(${w},mesg) {No more to undo.}
        tkTextUndoSetup ${w}
        return
    }

    if {$tkText(${w},undoPtr) == $tkText(${w},undoCnt)} {
        set undoCut $tkText(${w},undoCut)
        set undoFirst $tkText(${w},undoFirst)
        set undoLast $tkText(${w},undoLast)
    } else {
        #lassign [lindex $tkText($w,undoList) $tkText($w,undoPtr)] undoCut\
          undoFirst undoLast
        set bb [lindex $tkText(${w},undoList) $tkText(${w},undoPtr)]
        set undoCut [lindex ${bb} 0]
        set undoFirst [lindex ${bb} 1]
        set undoLast [lindex ${bb} 2]
    }

    set loop 0
    set retval {}
    if {${undoFirst} == "grp"} {
        set grp [lindex ${undoCut} 0]
        if {${undoLast} == -2.0} {
            set loop 1
        } else {
            ${w} mark set insert [lindex ${undoCut} 1]
            set retval ${grp}
        }
    } else {
        if {[${w} compare ${undoFirst} < ${undoLast}]} {
            set cutbuf [tkTextCopyTagBuffer ${w} ${undoFirst} ${undoLast}]
        } else {
            set cutbuf {}
        }

        ${w} mark set insert ${undoFirst}
        SyncEditors $w delete insert $undoLast
        ${w} delete insert ${undoLast}
        tkTextInsertTagBuffer ${w} insert ${undoCut}

        lappend tkText(${w},undoList) [list $tkText(${w},undoCut)\
          $tkText(${w},undoFirst) $tkText(${w},undoLast)]
        set tkText(${w},undoCut) ${cutbuf}
        set tkText(${w},undoFirst) ${undoFirst}
        set tkText(${w},undoLast) [${w} index insert]
        incr tkText(${w},undoCnt)
    }

    incr tkText(${w},undoPtr) -1
    if ${loop} {
        tkTextUndoBeginGroup ${w} ${grp} -1.0
        while {$tkText(${w},undoPtr) > 0 && [tkTextUndoPop ${w}] != ${grp}} { }
        tkTextUndoBeginGroup ${w} ${grp} -2.0
    }
    ${w} see insert

    # If this is the last undo we can tell the editor that
    # the file is no longer modified.
    if {$tkText($w,undoPtr) == 0} {
        # Find editor
        set undone_editor ""
        foreach editor_object [itcl::find objects -class Editor&] {
            if {[$editor_object editor]==$w} {
                $editor_object setmodified 0
                $editor_object SetTitle
                break
            }
        }
    }

    return ${retval}
}

# tkTextUndoBeginGroup --
# Signals to the undo ring that each subsequent undo push until an
# end group marker is found should be considered part of "one"
# operation when popped later
#
# Arguments:
# w -		The text window 
# grp -		A arbritrary but unique identifier for the group
#		which must match the one eventually given to 
#		tkTextUndoEndGroup
# signal -	-1.0 means begin group, -2.0 means end group

proc tkTextUndoBeginGroup {w grp {signal -1.0}} {
    global tkText tkBind

    if {![info exists tkText(${w},undoCnt)]} return
    lappend tkText(${w},undoList) [list $tkText(${w},undoCut)\
      $tkText(${w},undoFirst) $tkText(${w},undoLast)]
    set tkText(${w},undoCut) [list ${grp} [${w} index insert]]
    set tkText(${w},undoFirst) grp
    set tkText(${w},undoLast) ${signal}

    incr tkText(${w},undoCnt)
}

# tkTextUndoEndGroup --
# Signals to the undo ring that a grouping is to end
#
# Arguments:
# w -		The text window 
# grp -		A arbritrary but unique identifier for the group
#		which must match the one that was given to 
#		tkTextUndoBeginGroup to start the group

proc tkTextUndoEndGroup {w grp} {
    tkTextUndoBeginGroup ${w} ${grp} -2.0
}

######################################################################
# EXTRAS
######################################################################

proc tkTextGetFillWidth {w c} {

    #KHAMIS, very important, disable synch
    global SyncEditors_Disabled

    catch {incr SyncEditors_Disabled}

    set ndx [${w} index "@0,0 linestart"]
    ${w} see ${ndx}
    ${w} insert ${ndx} a
    set fw [expr ([lindex [${w} bbox ${ndx}] 2]*${c})+[lindex [${w} bbox\
      ${ndx}] 0]]
    ${w} delete ${ndx}

    #KHAMIS, reenable synch
    catch {incr SyncEditors_Disabled -1}

    return ${fw}
}

proc tkTextSetFillCol {w {n +}} {
    global tkText tkBind
    set n [tkBindDefArg ${w} ${n} -1]

    if {${n} < 0} {
        ${w} see insert
        set tkText(${w},fillWidth) [lindex [${w} bbox insert] 0]
        set margin [lindex [${w} bbox "insert linestart"] 0]
        set cw [expr [tkTextGetFillWidth ${w} 1]-${margin}]
        set tkText(${w},fillCol)\
          [expr round(($tkText(${w},fillWidth)-${margin})*1.0/${cw})]
    } else {
        set tkText(${w},fillCol) ${n}
        set tkText(${w},fillWidth) [tkTextGetFillWidth ${w} ${n}]
    }

    set tkBind(${w},arg) {}
    set tkText(${w},prevCmd) SetFillCol
    set tkBind(${w},mesg) "Fill column set to $tkText(${w},fillCol).\
      {$tkText(${w},fillWidth)}"
}

proc tkTextWrapWord {w {push 1}} {
    global tkText tkBind

    if {[${w} cget -state] == "disabled"} return
    if {[string first [${w} get "insert -1 c"] " \t"] < 0} {
        ${w} mark set insert insert-1c
        while {![regexp $tkBind(notWord) [${w} get insert]] &&