workspace.tcl

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

}

proc Workspace:quit {context} {

    global Monitor:channel

    # Be a good boy, ask confirmation if a debug session
    # is in progress before exiting...

     if {${Monitor:channel} != {}} {
 	set answer [tk_messageBox -parent $context \
 			-message "Simulation in progress... Really quit?" \
 			-type yesno -icon warning -title Warning]
 	if {$answer == "no"} {
 	    return
 	}
	 TkRequest $context KillSimulation
     }

    pushEvent Application:event WorkspaceQuitEvent
    Workspace:saveProject $context
    destroy $context
}

# "Project" Menu actions

proc Workspace:newProject {context} {

    global Workspace:session Project:settings

    set w $context.newproj

    if {[winfo exists $w]} {
	# Cannot grab focus for this toplevel (i.e. Tix FileDlg
	# is not a member of this window hierarchy); thus we
	# need to check for a currently open context; we could
	# have disabled the "New" menu item instead, but this
	# would have been much more "complex" to handle
	# menu enable/disable actions than doing this.
	wm deiconify $w
	raise $w
	return;
    }

    toplevel $w
    wm title $w "New Project"
    cascadeWindow $w $context
    
    set f [frame $w.f]
    pack $f -side top -expand yes -fill both

    global $context:projfile
    set $context:projfile ""

    set dialog [tix filedialog tixFileSelectDialog]
    $dialog config -title "Select a Project file"

    catch {
	$dialog subwidget fsbox config -directory [set Workspace:session(DefaultProjectDir)]
    }

    tixFileEntry $f.projfile -label "Project file: " \
 	-variable $context:projfile \
	-validatecmd "Workspace:valProjectFile" \
	-dialogtype tixFileSelectDialog \
 	-options {
 	    entry.width 30
 	    label.anchor w
	}

    global $context:projexe
    set $context:projexe ""

    set dialog [tix filedialog tixExFileSelectDialog]
    $dialog config -title "Select an executable file"

    catch {
	$dialog subwidget fsbox config -directory \
	    [TkRequest $context CanonicalizePath [set Workspace:session(DefaultExecDir)]]
    }

    $dialog subwidget fsbox config -filetypes { \
		{{*}		{*      -- All files}}
    }

    $dialog subwidget fsbox subwidget types pick 0

    tixFileEntry $f.projexe -label "Executable file: " \
 	-variable $context:projexe \
	-validatecmd "Workspace:valExecName" \
	-dialogtype tixExFileSelectDialog \
 	-options {
 	    entry.width 30
 	    label.anchor w
	}

    pack $f.projfile $f.projexe \
	-anchor w -expand yes -fill x -padx 10 -pady 10

    tixButtonBox $w.bbox -orientation horizontal -relief flat -bd 0
    $w.bbox add update -text Create \
 	-command "Workspace:newProjectOk $context"
    $w.bbox add cancel -text Cancel -command "destroy $w"
    pack $w.bbox -side bottom -fill x

    focus [$f.projfile subwidget entry]
}

proc Workspace:newProjectOk {context} {

    global $context:projfile $context:projexe
    global Project:settings Workspace:session

    set w $context.newproj
    set f $w.f
    $f.projfile update
    set projfile [getAbsolutePath [set $context:projfile]]

    if {$projfile == ""} {
	tk_messageBox -parent $context \
	    -message "No project file selected" \
	    -type ok -icon error -title Error
	raise $w
	return
    }

    if {[file exists $projfile]} {
	tk_messageBox -parent $context \
	    -message "Project file already exists" \
	    -type ok -icon error -title Error
	raise $w
	return
    }

    $f.projexe update

    Project:resetSettings
    set Project:settings(Executable) [set $context:projexe]

    if {[Workspace:saveProject $context $projfile] == "false"} {
	tk_messageBox -parent $context \
	    -message "$projfile: cannot open project file for writing" \
	    -type ok -icon error -title Error
	return
    }

    set Workspace:session(DefaultProjectDir) [file dirname $projfile]
    set executable [getAbsolutePath [set $context:projexe]]
    set Workspace:session(DefaultExecDir) [file dirname $executable]
    Workspace:openProjectOk $context $projfile

    destroy $w
}

proc Workspace:valProjectFile {path} {

    if {[catch {if {$path != ""} {
	if {[file isdirectory $path] == 1} {
	    return ""
	}
	if {[file extension $path] == {}} {
	    append path ".mvm"
	}
    }}] == 1} {
	# may be an invalid ~user syntax
	return ""
    }

    return $path
}

proc Workspace:openProject {context {projfile {}}} {

    global Workspace:session

    if {$projfile != {}} {
	# if a filename has been given, open the
	# corresponding project directly.
	if {[Workspace:openProjectOk $context $projfile] == "false"} {
	    # we failed to open the specified project...
	    # remove it from the fast access menu (if present).
	    Workspace:uncacheRecentProject $context $projfile
	}
	return
    }

    # otherwise, prompt for a valid project
    set dialog [tix filedialog tixExFileSelectDialog]
    $dialog config -command "Workspace:openProjectOk $context" \
	-title "Select a Project"

    catch {
	$dialog subwidget fsbox config -directory [set Workspace:session(DefaultProjectDir)]
    }

    $dialog subwidget fsbox config -filetypes { \
	{{*.mvm} {*.mvm  -- Xenoscope project files}}
	{{*} {*      -- All files}}
    }

    $dialog subwidget fsbox subwidget types pick 0
    cascadeWindow $dialog $context
    $dialog popup
}

proc Workspace:openProjectOk {context projfile} {

    global Workspace:session

    if {[set Workspace:session(CurrentProject)] != {} &&
	[set Workspace:session(CurrentProject)] != $projfile} {
	# close currently active project
	Workspace:closeProject $context
    }

    # Just in case further tk_messageBox are involved -- ensure the
    # toplevel is visible before attempting to grab the focus.
    # update idletasks

    set projfile [TkRequest $context CanonicalizePath [getAbsolutePath $projfile]]
    set Workspace:session(CurrentProject) $projfile

    if {[Workspace:restoreProject $context $projfile] == "false"} {
	tk_messageBox -parent $context \
	    -message "$projfile: cannot open project file for reading" \
	    -type ok -icon error -title Error
	return false
    }

    pushEvent Application:event OpenProjectEvent
    Workspace:cacheRecentProject $context $projfile

    # Finally, save the project directory for the next OpenProject
    # request.
    set Workspace:session(DefaultProjectDir) [file dirname $projfile]

    pushEvent Application:event ConfigureWallpaperEvent

    return true
}

proc Workspace:closeProject {context} {

    global Workspace:session
    Workspace:saveProject $context
    set Workspace:session(CurrentProject) {}
    pushEvent Application:event CloseProjectEvent
}

proc Workspace:editProject {context} {

    global Workspace:session Project:settings

    set w $context.editproj

    if {[winfo exists $w]} {
	wm deiconify $w
	raise $w
	return
    }

    toplevel $w
    wm title $w "Edit Project"
    cascadeWindow $w $context
    
    set f [frame $w.f]
    pack $f -side top -expand yes -fill both

    tixLabelEntry $f.projfile -label "Filename: " \
 	-options {
 	    label.anchor w
	}

    set e [$f.projfile subwidget entry]
    $e insert 0 [set Workspace:session(CurrentProject)]
    $e config -state disabled
    bind $e <1> "+ focus $e"

    global $context:projexe
    set $context:projexe [set Project:settings(Executable)]

    set dialog [tix filedialog tixExFileSelectDialog]
    $dialog config -title "Select the executable file"

    catch {
	$dialog subwidget fsbox config -directory \
	    [TkRequest $context CanonicalizePath [set Workspace:session(DefaultExecdir)]]
    }

    $dialog subwidget fsbox config -filetypes { \
		{{*}		{*      -- All files}}
    }

    $dialog subwidget fsbox subwidget types pick 0

    tixFileEntry $f.projexe -label "Executable file: " \
 	-variable $context:projexe \
	-validatecmd "Workspace:valExecName" \
	-dialogtype tixExFileSelectDialog \
 	-options {
 	    entry.width 30
 	    label.anchor w
	}

    set e [$f.projexe subwidget entry]
    bind $e <Return> "Workspace:editProjectOk $context"
    bind $e <Escape> "destroy $w"
    focus $e

    pack $f.projfile $f.projexe -side top \
	-anchor w -padx 10 -pady 10 -fill x -expand yes

    tixButtonBox $w.bbox -orientation horizontal -relief flat -bd 0
    $w.bbox add update -text Save \
 	-command "Workspace:editProjectOk $context"
    $w.bbox add cancel -text Cancel -command "destroy $w"
    pack $w.bbox -side bottom -fill x
}

proc Workspace:valExecName {path} {
    
    if {[catch { if {$path != ""} {
	if {[file isdirectory $path] == 1} {
	    return ""
	}
    }}] == 1} {
	# may be an invalid ~user syntax
	return ""
    }

    return $path
}

proc Workspace:editProjectOk {context} {

    global $context:projexe Workspace:session Project:settings

    set w $context.editproj
    set f $w.f
    $f.projexe update

    # Do not verify executable path; user should be able
    # to select it later...

    # getAbsolutePath() does not expand the environment variables,
    # this is ok for us.
    set executable [getAbsolutePath [set $context:projexe]]
    set Workspace:session(DefaultExecdir) [file dirname $executable]
    set Project:settings(Executable) $executable
    Workspace:saveProject $context
    pushEvent Application:event ProjectUpdateEvent

    destroy $w
}

# "Debug" Menu actions

proc Workspace:loadDebug {context} {

    global Debugger:main
    Debugger:run ${Debugger:main} bt
}

proc Workspace:runDebug {context} {

    global Debugger:main
    Debugger:run ${Debugger:main} t
}

proc Workspace:restartDebug {context} {
    Workspace:killSimulation $context
    Workspace:loadDebug $context
}

proc Workspace:startSimulation {context} {
    
    global Monitor:main
    Monitor:run ${Monitor:main} b
}

proc Workspace:restartSimulation {context} {
    Workspace:killSimulation $context
    Workspace:startSimulation $context
}

proc Workspace:killSimulation {context} {
    TkRequest $context KillSimulation
}

proc Workspace:setSimulationSpeed {context v} {
    TkRequest $context SetSimulationSpeed $v
}

proc Workspace:holdSimulation {context} {

    # Plan for the program to enter the held state.
    # This means to hit the debugger's internal breakpoint
    # the next time the user code enters the preemption hook,
    # or make the monitoring thread enter a blocking read
    # state on the command channel, depending whether we
    # currently run with debugging support or not.
    TkRequest $context HoldSimulation
}

proc Workspace:releaseSimulation {context} {
    TkRequest $context ContSimulation
}

proc Workspace:inspectSimulation {context} {
    pushEvent Application:event InspectSimulationEvent
    TkRequest $context InspectSimulation {}
}

proc Workspace:traceSimulation {context} {
    pushEvent Application:event InspectSimulationEvent
    TkRequest $context InspectSimulation {System RT/Interfaces}
}

proc Workspace:timerManager {context} {
    TimerManager:popup $context
}

proc Workspace:displayPlotter {context} {
    pushEvent Application:event PlotterVisibleEvent
    TkRequest $context DisplayPlotter
}

proc Workspace:updateSettings {context {what {}}} {

    global Application:treeSeparator
    global Project:settings Workspace:session

    set w $context.settings
    toplevel $w
    wm title $w Settings
    cascadeWindow $w $context
    bind $w <Escape> "destroy $w"

    tixNoteBook $w.nb -ipadx 6 -ipady 6
    $w.nb subwidget nbframe config
    pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top

    set state disabled
    if {[set Workspace:session(CurrentProject)] != {}} {
	set state normal
    }

    ## Options configuration

    $w.nb add options -label Options -state $state
    set optab [$w.nb subwidget options]

    tixLabelFrame $optab.monlbf -label "MVM" \
	-labelside acrosstop

    pack $optab.monlbf -fill both -expand no
    set monlbf [$optab.monlbf subwidget frame]

    tixLabelFrame $optab.dbglbf -label "Debugger" \
	-labelside acrosstop

    pack $optab.dbglbf -fill both -expand no
    set dbglbf [$optab.dbglbf subwidget frame]

    checkbutton $monlbf.brkwarn -text "Break on warnings" \
	-variable Project:settings(Options,breakOnWarnings) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,breakOnWarnings)] == 1} {
	$monlbf.brkwarn select
    } {
	$monlbf.brkwarn deselect
    }
    checkbutton $monlbf.popwarn -text "Auto-raise error log" \
	-variable Project:settings(Options,popupOnWarnings) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,popupOnWarnings)] == 1} {
	$monlbf.popwarn select
    } {
	$monlbf.popwarn deselect
    }
    checkbutton $monlbf.threadqual -text "Fully qualify thread identifiers" \
	-variable Project:settings(Options,threadQualify) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,threadQualify)] == 1} {
	$monlbf.threadqual select
    } {
	$monlbf.threadqual deselect
    }
    checkbutton $monlbf.raisetops -text "Auto-raise trace windows" \
	-variable Project:settings(Options,autoRaise) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,autoRaise)] == 1} {
	$monlbf.raisetops select
    } {
	$monlbf.raisetops deselect
    }
    checkbutton $monlbf.brkalert -text "Break on trace alerts" \
	-variable Project:settings(Options,breakOnAlerts) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,breakOnAlerts)] == 1} {
	$monlbf.brkalert select
    } {
	$monlbf.brkalert deselect
    }
    checkbutton $dbglbf.ktrace -text "Trace Xenomai kernel" \
	-variable Project:settings(Options,traceKernel) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,traceKernel)] == 1} {
	$dbglbf.ktrace select
    } {
	$dbglbf.ktrace deselect
    }
    checkbutton $dbglbf.itrace -text "Trace real-time interface" \
	-variable Project:settings(Options,traceIface) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,traceIface)] == 1} {
	$dbglbf.itrace select
    } {
	$dbglbf.itrace deselect
    }
    checkbutton $dbglbf.utrace -text "Trace application" \
	-variable Project:settings(Options,traceApp) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,traceApp)] == 1} {
	$dbglbf.utrace select
    } {