workspace.tcl

rtai-3.1-test3的源代码(Real-Time Application Interface )

#  This file is part of the XENOMAI project.
#
#  Copyright (C) 1997-2000 Realiant Systems.  All rights reserved.
#  Copyright (C) 2001,2002 Philippe Gerum <[e-mail]>.
# 
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License as
#  published by the Free Software Foundation; either version 2 of the
#  License, or (at your option) any later version.
# 
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
# 
#  Author(s): rpm
#  Contributor(s): ym
#
#  Adapted to XENOMAI by Philippe Gerum.

#  global tcl_traceExec
#  set tcl_traceExec 1
set Workspace:windowCache {}
set Workspace:statusBar {}
set Workspace:statusMsg {}
set Workspace:speedValue 0
set Workspace:statusFlip 0
set Workspace:runIcons(0) {}
set Workspace:runOnce false
set Workspace:geometry {}
set Workspace:errorLogFile {}

proc Workspace:initialize {context runOnce errorLogFile} {

    global Workspace:runOnce Workspace:errorLogFile

    set Workspace:runOnce $runOnce
    set Workspace:errorLogFile $errorLogFile

    toplevel $context
    bind $context <Destroy> "Workspace:cleanup %W $context"
    wm protocol $context WM_DELETE_WINDOW "Workspace:quit $context"

    set mbar [frame $context.mbar -bd 1 -relief raised]

    ### File

    menubutton $mbar.file -text File \
	-menu $mbar.file.m \
	-underline 0 \
	-takefocus 0
    menu $mbar.file.m -tearoff false

    $mbar.file.m add command -label Open... \
	-command "Workspace:visitFile $context" \
	-underline 0

    $mbar.file.m add sep

    $mbar.file.m add cascade -label "Projects" \
	-menu $mbar.file.m.projects \
	-underline 0

    menu $mbar.file.m.projects -tearoff false

    $mbar.file.m add sep

    ##YM
    $mbar.file.m add command -label Preferences... \
	-command "Workspace:updateSettings $context preferences" \
	-underline 0
    ##YM

    $mbar.file.m add command -label Quit \
	-command "Workspace:quit $context" \
	-underline 0

    ### Project

    menubutton $mbar.project -text Project \
	-menu $mbar.project.m \
	-underline 0 \
	-takefocus 0
    menu $mbar.project.m -tearoff false

    $mbar.project.m add command -label Open... \
	-command "Workspace:openProject $context" \
	-underline 0

    $mbar.project.m add command -label Edit... \
	-command "Workspace:editProject $context" \
	-underline 0

    $mbar.project.m add sep

    $mbar.project.m add command -label New... \
	-command "Workspace:newProject $context" \
	-underline 0

    $mbar.project.m add sep

    $mbar.project.m add command -label Settings... \
	-command "Workspace:updateSettings $context" \
	-underline 0

    $mbar.project.m add sep

    $mbar.project.m add command -label Close \
	-command "Workspace:closeProject $context" \
	-underline 0

    ### GDB

    menubutton $mbar.debug -text GDB \
	-menu $mbar.debug.m \
	-underline 0 \
	-takefocus 0
    menu $mbar.debug.m -tearoff false

    $mbar.debug.m add command -label Load \
	-command "Workspace:loadDebug $context" \
	-underline 0

    $mbar.debug.m add command -label Run \
	-command "Workspace:runDebug $context" \
	-underline 0

    $mbar.debug.m add sep

    $mbar.debug.m add command -label Stop \
	-command "Workspace:holdSimulation $context" \
	-underline 0

    $mbar.debug.m add sep

    $mbar.debug.m add command -label Restart \
	-command "Workspace:restartDebug $context" \
	-underline 1

    $mbar.debug.m add command -label Kill \
	-command "Workspace:killSimulation $context" \
	-underline 0

    ### MVM

    menubutton $mbar.simulation -text MVM \
	-menu $mbar.simulation.m \
	-underline 0 \
	-takefocus 0
    menu $mbar.simulation.m -tearoff false

    $mbar.simulation.m add command -label Run \
	-command "Workspace:startSimulation $context" \
	-underline 0

    $mbar.simulation.m add command -label Stop \
	-command "Workspace:holdSimulation $context" \
	-underline 0

    $mbar.simulation.m add command -label Continue \
	-command "Workspace:releaseSimulation $context" \
	-underline 0

    $mbar.simulation.m add command -label Inspect... \
	-command "Workspace:inspectSimulation $context" \
	-underline 0

    $mbar.simulation.m add command -label Traces... \
	-command "Workspace:traceSimulation $context" \
	-underline 0

    $mbar.simulation.m add command -label Timers... \
	-command "Workspace:timerManager $context" \
	-underline 2

    $mbar.simulation.m add sep

    $mbar.simulation.m add command -label Restart \
	-command "Workspace:restartSimulation $context" \
	-underline 1

    $mbar.simulation.m add command -label Kill \
	-command "Workspace:killSimulation $context" \
	-underline 0

    ### Window

    menubutton $mbar.window -text Window \
	-menu $mbar.window.m \
	-underline 0 \
	-takefocus 0
    menu $mbar.window.m -tearoff false

    ### About
    
    menubutton $mbar.about -text About \
	-menu $mbar.about.m \
	-underline 0 \
	-takefocus 0
    menu $mbar.about.m -tearoff false

    $mbar.about.m add command -label "About the MVM..." \
	-command "Workspace:displayAboutBox $context" \
	-underline 0

    pack $mbar.file $mbar.project $mbar.debug $mbar.simulation -side left

    pack $mbar.window -side left
    pack $mbar.about -side right
    pack $mbar -side top -fill x

    ### Main toolbar
    
    set mtoolbar [frame $context.mtoolbar -bd 1 -relief groove]
    pack $context.mtoolbar -side top -expand no -fill x

    ## Tools shortcuts

    set tools $mtoolbar.tools

    tixSelect $tools -allowzero true -radio true \
	-variable $context:mtools \
	-command "Workspace:toolbarExec $context"

    $tools add openProject -image [fetchImage openproj]
    Workspace:addToolTip $tools openProject Workspace:statusMsg \
	"Open project" "Open existing MVM project"

    $tools add updateSettings -image [fetchImage configure]
    Workspace:addToolTip $tools updateSettings Workspace:statusMsg \
	"Settings" "Edit current project settings"

    $tools add loadDebug -image [fetchImage debug]
    Workspace:addToolTip $tools loadDebug Workspace:statusMsg \
	"Debug" "Start GDB on the MVM" <F2>

    $tools add startSimulation -image [fetchImage start]
    Workspace:addToolTip $tools startSimulation Workspace:statusMsg \
	"Run" "Run standalone MVM (no GDB)"

    pack $tools -expand no -anchor w -padx 4 -pady 4 -side left

    ## MVM control shortcuts

    set controls $mtoolbar.controls

    tixSelect $controls -allowzero true -radio true \
	-variable $context:mcontrols \
	-command "Workspace:controlExec $context"

    $controls add inspectSimulation -image [fetchImage inspect]
    Workspace:addToolTip $controls inspectSimulation Workspace:statusMsg \
	"Inspect" "Display/Modify system objects"

    $controls add displayPlotter -image [fetchImage plotter]
    Workspace:addToolTip $controls displayPlotter Workspace:statusMsg \
	"Graphs" "Display graphs"

    $controls add traceSimulation -image [fetchImage traces]
    Workspace:addToolTip $controls traceSimulation Workspace:statusMsg \
	"API trace" "Trace system calls"

    $controls add timerManager -image [fetchImage timers]
    Workspace:addToolTip $controls timerManager Workspace:statusMsg \
	"Timers" "Set MVM timers"

    $controls add releaseSimulation -image [fetchImage cont]
    Workspace:addToolTip $controls releaseSimulation Workspace:statusMsg \
	"Continue" "Resume execution"

    $controls add holdSimulation -image [fetchImage break]
    Workspace:addToolTip $controls holdSimulation Workspace:statusMsg \
	"Stop" "Suspend execution"

    ## Simulation clock, speed spinbox and status icon
    global Workspace:speedValue Workspace:runIcons

    # Clock label
    set clock $mtoolbar.clock
    label $clock

    # Speed spinbox
    set speedf [frame $mtoolbar.speed -relief raised -bd 1]
    label $speedf.icon -image [fetchImage speedo] \
	-relief flat -bd 0 -takefocus 0
    pack $speedf.icon -side left -expand no -fill none -padx 1
    # note: although we do not want any title to be displayed for the
    # spinbox, we do not use -labelside none attribute because an
    # extra space at the left of the entry widget is still consumed for
    # the non-existent label (?!). Instead, we put an empty label at the
    # right of the entry widget, which gives a better visual effect.
    tixControl $speedf.control \
	-variable Workspace:speedValue \
	-value 10 \
	-integer true \
	-min 1 \
	-max 10 \
	-padx 0 \
	-allowempty false \
	-label {} \
	-labelside right \
	-command "Workspace:setSimulationSpeed $context" \
	-options {
	    entry.width 2
	    entry.relief ridge
	}
    pack $speedf.control -expand yes -fill both -padx 1
    # the following option must be configured after the widget is
    # built to bypass tix overrides... (i.e. want no icursor at all)
    $speedf.control subwidget entry config -insertontime 0
    Workspace:addToolTipSimple $speedf.icon Workspace:statusMsg \
	"Speed" "Set execution speed"

    # Simulation status
    button $mtoolbar.status -relief raised -bd 1 \
	-command "Workspace:openBreakContext $context"
    set Workspace:runIcons(0) [fetchImage runflip]
    set Workspace:runIcons(1) [fetchImage runflap]
    setDynamicTooltip $mtoolbar.status "Workspace:displayStatus $context" 0
    bind $mtoolbar.status <Leave> "+ set Workspace:statusMsg {}"

    # Status message bar
    global Workspace:statusBar
    set Workspace:statusBar \
	[frame $context.status -height 20 -relief groove -bd 1]
    pack $context.status -fill x
    label $context.status.message -textvariable Workspace:statusMsg
    pack $context.status.message -side left

    ### register trace hook to get informed of major context changes
    traceEvent Application:event \
	eventQueue:$context \
	"Workspace:processGlobalEvent $context"

    ### trigger initialization event
    pushEvent Application:event InitWorkspaceEvent
}

proc Workspace:addToolTip {toolbar cmd var shortmsg {longmsg {}} {fkey {}}} {

    set w [$toolbar subwidget $cmd]
    $w config -bd 1 -relief raised
    setStaticTooltip $w $shortmsg

    if {$longmsg != {}} {
	bind $w <Enter> "+ set $var \"$longmsg\""
	bind $w <Leave> "+ set $var {}"
    }

    if {$fkey != {}} {
	bind [winfo toplevel $toolbar] $fkey "$toolbar invoke $cmd"
    }
}

proc Workspace:addToolTipSimple {w var shortmsg longmsg} {

    setStaticTooltip $w $shortmsg
    bind $w <Enter> "+ set $var \"$longmsg\""
    bind $w <Leave> "+ set $var {}"
}

proc Workspace:displayStatus {context w X Y} {

    global Workspace:statusMsg
    global Monitor:simulationState Monitor:standaloneRun

    if {${Monitor:standaloneRun} == 0} {
	global Debugger:childState
	if {${Debugger:childState} == "zombie"} {
	    if {${Monitor:simulationState} == "zombie"} {
		# really zombie -- not crashed
		set status done
	    } {
		set status brkcrash
	    }
	} {
	    set status [Monitor:getStopIcon]
	}
    } {
	if {${Monitor:simulationState} == "zombie"} {
	    set status done
	} {
	    set status [Monitor:getStopIcon]
	}
    }

    switch $status {
	brkuncond {
	    set shortmsg "User break"
	    set longmsg "Execution has been stopped by user"
	}

	brktimer {
	    set shortmsg "Timer break"
	    set longmsg "A timer has elapsed"
	}

	brkgraph {
	    set shortmsg "State diagram break"
	    set longmsg "A state breakpoint was hit"
	}

	brktrace {
	    set shortmsg "Trace break"
	    set longmsg "A traced syscall has returned"
	}
	
	brkerror {
	    set shortmsg "Error break"
	    set longmsg "An error condition was raised"
	}

	brkdebug {
	    set shortmsg "Debug break"
	    set longmsg "A debugger breakpoint was hit"
	}

	brkwatch {
	    set shortmsg "Watchpoint break"
	    set longmsg "A debugger watchpoint was hit"
	}

	brkcrash {
	    set shortmsg "Crashed!"
	    set longmsg "The MVM received an unexpected exception"
	}

	done {
	    set shortmsg "Finished"
	    set longmsg "The simulation is finished"
	}

	default {
	    set shortmsg "Running"
	    set longmsg "The MVM is running"
	}
    }

    set Workspace:statusMsg $longmsg

    return $shortmsg
}

proc Workspace:openBreakContext {context} {

    global Monitor:simulationState Monitor:standaloneRun

    if {${Monitor:standaloneRun} == 0} {
	global Debugger:childState
	if {${Debugger:childState} == "zombie" ||
	    ${Monitor:simulationState} == "zombie"} {
	    return
	}
    } {
	if {${Monitor:simulationState} == "zombie"} {
	    return
	}
    }

    set status [Monitor:getStopIcon]

    switch $status {
	brktimer {
	    Workspace:timerManager $context	    
	}

	brkgraph {
	    Workspace:displayPlotter $context	    
	}

	brktrace {
	    Workspace:traceSimulation $context
	}
	
	brkerror {
	    TkRequest $context DisplayErrorLog
	}

	brkdebug {
	    TkRequest $context EditBreakpoints
	}

	brkwatch {
	    TkRequest $context EditWatchpoints
	}
    }
}

proc Workspace:toolbarExec {context button state} {

    # a little trick to have the tix select widget
    # behave like a toolbar: a selected button is
    # immediately re-invoked to restore its initial
    # graphic state. This is why the button state is
    # checked to filter out "off" invocations.
    if {$state == 1} {
	global Workspace:statusMsg
	set Workspace:statusMsg {}
	$context.mtoolbar.tools invoke $button
	Workspace:$button $context
    }
}

proc Workspace:controlExec {context button state} {

    if {$state == 1} {
	global Workspace:statusMsg
	set Workspace:statusMsg {}
	$context.mtoolbar.controls invoke $button
	Workspace:$button $context
    }
}

# "File" Menu actions

proc Workspace:cleanup {w context} {

    if {$w == $context} {
	destroy .
    }
}

proc Workspace:visitFile {context {filename {}}} {
    # file will be displayed in the main
    # debugging frame
    TkRequest $context VisitFile $filename