asedmain.tcl

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

        } else  {
            if {$current(is_procline)} {
                set current(is_procline) 0
                set current(procSelectionChanged) 1
            } else {
                set current(is_procline) 0
                set current(procSelectionChanged) 0
            }
        }
    }
    return $result
}

proc Editor::updateOnIdle {range} {
    variable current
    # if there磗 a pending update only store new range
    if {$current(isUpdate)} {
        if {[$current(text) compare $current(updateStart) > [lindex $range 0]]} {
            set current(updateStart) [$current(text) index [lindex $range 0]]
        }
        if {[$current(text) compare $current(updateEnd) < [lindex $range 1]]} {
            set current(updateEnd) [$current(text) index [lindex $range 1]]
        }
    } else  {
        set current(isUpdate) 1
        set current(updateStart) [$current(text) index [lindex $range 0]]
        set current(updateEnd) [$current(text) index [lindex $range 1]]
        after idle {
            # wait for a longer idle period
            for {set i 0} {$i <= 10000} {incr i} {
                update
                set Editor::current(idleID) [after idle {
                    update
                    after idle {set Editor::current(idleID) ""}
                }]
                vwait Editor::current(idleID)
                if {$i == 100} {
                    set range [editorWindows::deleteMarks $Editor::current(updateStart) $Editor::current(updateEnd) ]
                    Editor::updateObjects $range
                    Editor::selectObject 0
                    set Editor::current(isUpdate) 0
                    break
                }
            }
        }
    }
}


################################################################################
#
#  proc Editor::updateObjects
#
#  reparse the complete file and rebuild object tree
#
# zerbst@tu-harburg.d
#
# adopted for ASED by A.Sievers, dated 02/06/00
#
################################################################################

proc Editor::updateObjects {{range {}}} {
    global EditorData
    variable current
    variable treeWindow
    
    if {!$EditorData(options,autoUpdate) || !$EditorData(options,showProcs)} {
        return
    }
    while {[llength $range] == 1} {
        eval set range $range
    }
    
    if {$range == {}} {
        # switch on progressbar
        set Editor::prgindic 0
        set current(checkRootNode) 0
        set start 1.0
        set end "end-1c"
        catch {
            editorWindows::deleteMarks "1.0" "end -1c"
        }
        Editor::tdelNode $current(file)
    } else  {
        set current(checkRootNode) 1
    }
    set code {
        set temp [expr int($nend / $end * 100)]
        if {!$recursion && $temp > $Editor::prgindic && [expr $temp % 10] == 0 } {
            set Editor::prgindic [expr int($nend / $end * 100)]
            set Editor::status "Parsing: $Editor::prgindic % "
            update idletasks
        }
    }
    
    # call parser
    set nodeList [Parser::parseCode $current(file) $current(text) $range $code]
    # switch off progressbar
    set Editor::prgindic -1
    set Editor::status ""
    
    foreach node $nodeList {
        catch {Editor::tnewNode $node}
    }
    update
    if {$Editor::options(sortProcs)} {catch {Editor::torder $current(file)}}
}

################################################################################
#
#  proc Editor::selectObject
#
#  selects an object by a given position in the text
#
# zerbst@tu-harburg.d
#
# adopted for ASED by A.Sievers, dated 02/06/00
#
################################################################################

proc Editor::selectObject {{update 1} {Idx insert}} {
    global EditorData
    variable current
    variable treeWindow
    variable procMarks

    if {!$EditorData(options,showProcs) || !$EditorData(options,showProc)} {
        set current(node) ""
        return ""
    }
    if {$update != 0} {
        set rexp {^(( |\t|\;)*((namespace )|(class )|(proc )|(body )|(configbody )))|((( |\t|\;)*[^\#]*)((method )|(constructor )|(destructor )))}
        if {[regexp $rexp [$current(text) get "$Idx linestart" "$Idx lineend"]]} {
            set start [$current(text) index "$Idx"]
            set end [$current(text) index "$Idx"]
            set range [editorWindows::deleteMarks $start $end]
            updateObjects $range
            set current(isNode) 1
        } else  {
            set current(isNode) 0
        }
    }
    set index [$current(text) index $Idx]
    # marknames equal nodenames
    set node $Idx
    set markList [array names procMarks]
    #get the right mark
    while {[lsearch $markList $node] == -1 || $procMarks($node) == "dummy"} {
        set index [$current(text) index $node]
        set result -1
        foreach { type node idx} [$current(text) dump -mark $index] {
            set result [lsearch $markList $node]
            if {$result != -1} {
                if {$procMarks([lindex $markList $result]) != "dummy"} {
                    break
                } else  {
                    set result -1
                }
            }
        }
        if {$result == -1 && $index != 1.0} {
            set node [$current(text) mark previous $index]
            if {$node == ""} {
                break
            }
        } elseif {$result == -1} {
            set node ""
            break
        }
    }
    if {$node == ""} {
        $treeWindow selection clear
        set current(node) $node
        return $node
    }
    #if it is an end_of_proc mark skip this proc
    if {[string match "*_end_of_proc" $node]} {
        set count -2
        while {$count != 0} {
            set node [$current(text) index $node]
            set node [$current(text) mark previous "$node -1c"]
            if {$node == ""} {
                break
            }
            while {[lsearch $markList $node] == -1 || $procMarks($node) == "dummy"} {
                set index [$current(text) index $node]
                foreach { type node idx} [$current(text) dump -mark $index] {
                    set result [lsearch $markList $node]
                    if {$result != -1} {
                        if {$procMarks($node) != "dummy"} {
                            break
                        } else  {
                            set result -1
                        }
                    }
                }
                if {$result == -1 && $index != 1.0} {
                    set node [$current(text) mark previous $index]
                    if {$node == ""} {
                        break
                    }
                } elseif {$result == -1}  {
                    set node ""
                    break
                }
            }
            if {$node == ""} {
                break
            }
            if {[string match "*_end_of_proc" $node]} {
                incr count -1
            } else {
                incr count
            }
        }
    }
    $treeWindow selection clear
    if {$node != ""} {
        $treeWindow selection set $node
        $treeWindow see $node
    }
    set current(node) $node
    return $node
}

################################################################################
#
# Gui components of the treewidget
#
#
#
################################################################################

################################################################################
#
#  proc Editor::tdelNode
#
#  deletes a node and its children from the tree
#
# zerbst@tu-harburg.d
################################################################################
proc Editor::tdelNode {node} {
    variable treeWindow
    
    regsub -all " " $node \306 node
    regsub ":$" $node \327 node
    regsub -all "\\\$" $node "