editor.tcl

是TCL的另外一个编译（解释）器

##############################################################################
#    editor.tcl --
#    Copyright (C) 1999-2002  Andreas Sievers
#    [e-mail]
#    Parts are based upon Tcl Developer Studio by Alexey Kakunin
#    last update: 2002/06/13: improvment for indentation
#
##############################################################################

namespace eval editorWindows {
    
    namespace export setBindings create selectAll
    namespace export gotoMark gotoProc findNext setCursor replace replaceAll
    namespace export enableHL disableHL onTabSize onFontChange
    
    variable This
    variable TxtWidget ""
    variable Text ""
    variable UndoID
}

proc editorWindows::setBindings {} {
    global tcl_platform
    global EditorData
    variable TxtWidget
    
    set tabSize [expr {$EditorData(options,tabSize)* [font measure $EditorData(options,fonts,editorFont) -displayof $TxtWidget " "]}]
    for {set i 1} {$i < 11} {incr i} {
        set tab [expr {$tabSize * $i}]
        set tabList [lappend tabList $tab]
    }
    $TxtWidget configure -wrap none -font $EditorData(options,fonts,editorFont) -tabs $tabList
    ConfigureTags
    
    # create bindings
    bind $TxtWidget <Tab> "editorWindows::OnTabPress; break"
    if {$tcl_platform(platform) != "windows"} {
        bind $TxtWidget <Control-Insert> "editorWindows::copy; break"
        bind $TxtWidget <Control-Delete> "editorWindows::cut; break"
        bind $TxtWidget <Shift-Insert>   "editorWindows::paste; break"
        bind $TxtWidget <Control-a> "editorWindows::selectAll; break"
    }
    bind $TxtWidget <KeyPress-Return> {[editorWindows::onKeyPressReturn %A ]}
    bind $TxtWidget <KeyRelease-Return> "editorWindows::IndentCurLine ; editorWindows::OnKeyRelease"
    bind $TxtWidget <KeyRelease-space> "editorWindows::OnSpaceRelease;editorWindows::OnKeyRelease"
    # bind $TxtWidget <KeyRelease-braceright> "editorWindows::IndentCurLine;editorWindows::OnKeyRelease"
    # bind $TxtWidget <KeyRelease-braceleft> "editorWindows::OnLeftBraceRelease;editorWindows::OnKeyRelease"
    bind $TxtWidget <KeyRelease-parenleft> "editorWindows::OnLeftParenRelease;editorWindows::OnKeyRelease"
    # bind $TxtWidget <KeyRelease-bracketleft> "editorWindows::OnLeftBracketRelease;editorWindows::OnKeyRelease"
    bind $TxtWidget <KeyRelease-quotedbl> "editorWindows::OnQuoteDblRelease;editorWindows::OnKeyRelease"
    bind $TxtWidget <KeyPress-Delete> {set Editor::current(char) %A; [ editorWindows::delete ] }
    bind $TxtWidget <Control-h> {set Editor::current(char) %A; [ editorWindows::delete bs ] }
    bind $TxtWidget <BackSpace> {set Editor::current(char) %A; [ editorWindows::delete bs ] }
    bind $TxtWidget <KeyRelease> {editorWindows::OnKeyRelease ; break}
    bind $TxtWidget <KeyPress> {[editorWindows::OnKeyPress %A ] }
    bind $TxtWidget <Button-3> {tk_popup $Editor::textMenu %X %Y ; break}
    bind $TxtWidget <ButtonRelease> editorWindows::OnMouseRelease
    bind $TxtWidget <Control-x> "Editor::cut; break"
    bind $TxtWidget <Control-c> "Editor::copy; break"
    bind $TxtWidget <Control-v> "Editor::paste; break"
    bind $TxtWidget <Control-y> "Editor::delLine ; break"
    bind $TxtWidget <KeyRelease-Home> "editorWindows::gotoFirstChar;break"
    bind $TxtWidget <Control-l> "repeat_last_search $TxtWidget"
    return
}

proc editorWindows::OnKeyPress {key} {
    variable TxtWidget
    global EditorData
    
    set Editor::current(char) $key
    switch -regexp -- $key {
        
        {.} {
            #printable chars and Return
            if {[$TxtWidget tag ranges sel] != "" && $EditorData(options,autoUpdate)} {
                set start [$TxtWidget index sel.first]
                set end [$TxtWidget index sel.last]
                set range [editorWindows::deleteMarks $start $end]
                $TxtWidget mark set delStart [lindex $range 0]
                $TxtWidget mark gravity delStart left
                $TxtWidget mark set delEnd [lindex $range 1]
                $TxtWidget delete sel.first sel.last
                $TxtWidget insert insert $key
                if {[$TxtWidget compare insert > delEnd]} {
                    $TxtWidget mark set delEnd insert
                }
                Editor::updateOnIdle [list [$TxtWidget index delStart] [$TxtWidget index delEnd]]
                $TxtWidget mark unset delStart
                $TxtWidget mark unset delEnd
                return break
            } else  {
                set rexp {^(( |\t|\;)*((namespace )|(class )|(proc )|(body )|(configbody )))|((( |\t|\;)*[^\#]*)((method )|(constructor )|(destructor )))}
                if {[regexp $rexp [$TxtWidget get "insert linestart" "insert lineend"]]} {
                    set Editor::current(isNode) 1
                } else  {
                    set Editor::current(isNode) 0
                }
            }
        }
        
        default  {
            #non printable chars
            return list
        }
    }
    return list
}

proc editorWindows::gotoFirstChar {} {
    variable TxtWidget
    
    set curPos [$Editor::current(text) index insert]
    set result [Editor::getFirstChar $curPos]
    $TxtWidget mark set insert [lindex $result 1]
    
}

# edit-copy
proc editorWindows::copy {} {
    variable TxtWidget
    
    if {[catch {$TxtWidget index sel.first}]} {
        return
    }
    
    set lineStart [lindex [split [$TxtWidget index sel.first] "."] 0]
    set lineEnd [lindex [split [$TxtWidget index sel.last] "."] 0]
    
    tk_textCopy $TxtWidget
    
    ReadCursor
    ColorizeLines $lineStart $lineEnd
    
    return
}

# edit-cut
proc editorWindows::cut {} {
    variable TxtWidget
    global EditorData
    
    if {$TxtWidget == ""} {
        return
    }
    if {[$TxtWidget tag ranges sel] != "" && $EditorData(options,autoUpdate)} {
        set start [$TxtWidget index sel.first]
        set end [$TxtWidget index sel.last]
        set rexp {(^( |\t|\;)*namespace )|(^( |\t|\;)*class )|(^( |\t|\;)*proc )|(method )|(^( |\t|\;)*body )|(constructor )|(destructor )}
        if {[regexp $rexp [$TxtWidget get $start $end]]} {
            set range [editorWindows::deleteMarks $start $end]
            $TxtWidget mark set delStart [lindex $range 0]
            $TxtWidget mark gravity delStart left
            $TxtWidget mark set delEnd [lindex $range 1]
            tk_textCut $TxtWidget
            Editor::updateOnIdle [list [$editorWindows::TxtWidget index delStart] [$TxtWidget index delEnd]]
            $TxtWidget mark unset delStart
            $TxtWidget mark unset delEnd
        } else  {
            tk_textCut $TxtWidget
            update
        }
    } else  {
        tk_textCut $TxtWidget
        update
    }
    ReadCursor
    
    set lineNum [lindex [split [$TxtWidget index insert] "."] 0]
    
    ColorizeLines $lineNum $lineNum
    
    return
}

# edit-paste
proc editorWindows::paste {} {
    global tcl_platform
    global EditorData
    variable TxtWidget
    
    if {$TxtWidget == "" || [focus] != $TxtWidget} {
        return
    }
    if {$EditorData(options,autoUpdate)} {
        if {[$TxtWidget tag ranges sel] == "" } {
            #get prev NodeIndex boundaries
            set range [getUpdateBoundaries insert]
            set start [lindex $range 0]
            set end [lindex $range 1]
            tk_textPaste $TxtWidget
            
            $TxtWidget see insert
            if {[$TxtWidget compare insert > $end]} {
                set end [$TxtWidget index insert]
            }
            Editor::updateOnIdle [list $start $end]
        } else  {
            set lineStart [lindex [split [$TxtWidget index sel.first] "."] 0]
            set start [$TxtWidget index sel.first]
            set end [$TxtWidget index sel.last]
            set range [editorWindows::deleteMarks $start $end]
            $TxtWidget mark set delStart [lindex $range 0]
            $TxtWidget mark gravity delStart left
            $TxtWidget mark set delEnd [lindex $range 1]
            if {"$tcl_platform(platform)" == "unix"} {
                catch { $TxtWidget delete sel.first sel.last }
            }
            tk_textPaste $TxtWidget
            $TxtWidget see insert
            if {[$TxtWidget compare insert > $end]} {
                set end [$TxtWidget index insert]
            }
            Editor::updateOnIdle [list $start $end]
            $TxtWidget mark unset delStart
            $TxtWidget mark unset delEnd
        }
    }
    update idletasks
    ReadCursor
    set lineStart [lindex [split [$TxtWidget index $start] "."] 0]
    set lineEnd [lindex [split [$TxtWidget index $end] "."] 0]
    ColorizeLines $lineStart $lineEnd
    autoIndent $lineStart.0 "$lineEnd.0 lineend"
    return
}

proc editorWindows::getMarkNames {start end} {
    variable TxtWidget
    
    if {[$TxtWidget index end] == $end} {
        set end "end -1c"
    }
    set markList [array names Editor::procMarks]
    set resultList ""
    set markIndex [$TxtWidget index $start]
    while {[$TxtWidget compare $markIndex <= $end]} {
        #get the right mark
        foreach { type markName index} [$TxtWidget dump -mark $markIndex] {
            set result [lsearch $markList $markName]
            if {$result != -1} {
                lappend resultList $markName
            }
        }
        set markName [$TxtWidget mark next "$markIndex +1c"]
        if {$markName == ""} {
            break
        } else  {
            set markIndex [$TxtWidget index $markName]
        }
    }
    return $resultList
}

proc editorWindows::getUpdateBoundaries {start {end insert}} {
    variable TxtWidget
    set start [$TxtWidget index "$start linestart"]
    set end [$TxtWidget index "$end lineend"]
    set markList [editorWindows::getMarkNames $start $end]
    if {$markList == ""} {
        return [list $start $end]
    }
    # set boundaries to start or end of a node array
    foreach markName $markList {
        #get counterMark
        set counterMark ""
        if {[regexp "(_end_of_proc)$" $markName]} {
            #this is an end mark
            regsub "(_end_of_proc)$" $markName "" counterMark
            if {[$TxtWidget compare $counterMark < $start]} {
                set start $counterMark
            }
        } else  {
            #this is a start mark
            append counterMark $markName "_end_of_proc"
            if {[$TxtWidget compare $counterMark > $end]} {
                set end $counterMark
            }
        }
    } ;#end of foreach
    #now we should have the correct boundaries
    set start [$TxtWidget index $start]
    set end [$TxtWidget index $end]
    return [list $start $end]
}

proc editorWindows::deleteMarks {start end} {
    global EditorData
    variable TxtWidget
    
    set range [getUpdateBoundaries $start $end]
    set start [lindex $range 0]
    set end [lindex $range 1]
    set markList [editorWindows::getMarkNames $start $end]
    if {$markList != ""} {
        foreach markName $markList {
            #do not delete duplicates or namespaces or classes with children
            if {[$TxtWidget compare $markName > $end] || [$TxtWidget compare $markName < $start]} {
                continue
            }
            set tempName $markName
            regsub {_end_of_proc} $markName "" tempName
            if {[$Editor::treeWindow exists $tempName]} {
                set type [lindex [$Editor::treeWindow itemcget $tempName -data] 0]
            } else  {
                set type normal
            }
            switch -- $type {
                "class" -
                "namespace" {
                    # if there are remaining nodes, don磘 delete namespace/class
                    if {[$Editor::treeWindow nodes $tempName] != ""} {
                        $TxtWidget mark set $markName 1.0
                    } else  {
                        if {$markName == $tempName} {
                            Editor::tdelNode $tempName
                        }
                        #get counterMark
                        set counterMark ""
                        if {[regexp "(_end_of_proc)$" $markName]} {
                            #this is an end mark
                            regsub "(_end_of_proc)$" $markName "" counterMark
                        } else  {
                            #this is a start mark
                            append counterMark $markName "_end_of_proc"
                        }
                        catch {$TxtWidget mark unset $markName}
                        catch {unset Editor::procMarks($markName)}
                    }
                }
                "file" -
                "code" {
                    #skip
                }
                default {
                    if {$markName == $tempName} {
                        Editor::tdelNode $markName
                    }
                    catch {$TxtWidget mark unset $markName}
                    catch {unset Editor::procMarks($markName)}
                }
            }
        }
    }
    return [list $start $end]
}

# edit-delete
proc editorWindows::delete {{backspace ""}} {
    global tcl_platform
    global EditorData
    variable TxtWidget
    
    if {$TxtWidget == "" || !$EditorData(options,autoUpdate)} {
        return list
    }
    set rexp {(^( |\t|\;)*namespace )|(^( |\t|\;)*class )|(^( |\t|\;)*proc )|(method )|(^( |\t|\;)*body )|(constructor )|(destructor )}
    if {[$TxtWidget tag ranges sel] != ""} {
        set start [$TxtWidget index "sel.first linestart"]
        set end [$TxtWidget index "sel.last lineend"]
        ColorizeLine [lindex [split [$TxtWidget index insert] "."] 0]
        if {![regexp $rexp [$TxtWidget get $start $end]]} {
            return list
        }
        $TxtWidget delete sel.first sel.last
        ColorizeLine [lindex [split [$TxtWidget index insert] "."] 0]
        Editor::updateOnIdle [list $start $end]
        return break
    }
    set start [$TxtWidget index "insert linestart"]
    set end [$TxtWidget index "insert lineend"]
    if {![regexp $rexp [$TxtWidget get $start $end]]} {
        ColorizeLine [lindex [split [$TxtWidget index insert] "."] 0]
        return list
    } else  {
        if {$backspace == {}} {
            $TxtWidget delete insert