workspace.tcl

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

	$dbglbf.utrace deselect
    }
    checkbutton $dbglbf.linenums -text "Display source line numbers" \
	-variable Project:settings(Options,lineNumbering) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,lineNumbering)] == 1} {
	$dbglbf.linenums select
    } {
	$dbglbf.linenums deselect
    }
    checkbutton $dbglbf.evbubbles -text "Activate evaluation bubbles" \
	-variable Project:settings(Options,evalBubbles) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,evalBubbles)] == 1} {
	$dbglbf.evbubbles select
    } {
	$dbglbf.evbubbles deselect
    }
    checkbutton $dbglbf.forcefocus -text "Force focus on breakpoint/watchpoint" \
	-variable Project:settings(Options,forceFocusOnBreak) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,forceFocusOnBreak)] == 1} {
	$dbglbf.forcefocus select
    } {
	$dbglbf.forcefocus deselect
    }
    checkbutton $dbglbf.useglyph -text "Use glyph cursor in source" \
	-variable Project:settings(Options,useGlyphCursor) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Options,useGlyphCursor)] == 1} {
	$dbglbf.useglyph select
    } {
	$dbglbf.useglyph deselect
    }

    pack $monlbf.brkwarn \
	$monlbf.brkalert \
	$monlbf.popwarn \
	$monlbf.threadqual \
	$monlbf.raisetops \
	$dbglbf.ktrace \
	$dbglbf.itrace \
	$dbglbf.utrace \
	$dbglbf.linenums \
	$dbglbf.evbubbles \
	$dbglbf.forcefocus \
	$dbglbf.useglyph \
	-side top -pady 0 -anchor w -padx 8

    ## Simulation parameters

    $w.nb add simulation -label Simulation -state $state
    set simtab [$w.nb subwidget simulation]

    tixLabelFrame $simtab.parlbf -label "Timing" \
	-labelside acrosstop

    pack $simtab.parlbf -fill both -expand false
    set f [$simtab.parlbf subwidget frame]

    # Simulation time limit

    global $f.stime:value
    set $f.stime:value [lindex [set Project:settings(SimulationTime)] 0]

    frame $f.f1
    tixControl $f.f1.stime \
	-label "Simulation time:" \
	-variable $f.stime:value \
	-value 0 \
	-min 0 \
	-allowempty false -options {
	    label.anchor e
	    label.width 16
	    entry.width 8
	}

    tixOptionMenu $f.f1.ustime -labelside none \
	-variable $f.ustime:unit -options {
	    menubutton.bd 0
	    menubutton.relief flat
	}

    $f.f1.ustime add command usc -label usc
    $f.f1.ustime add command msc -label msc
    $f.f1.ustime add command sec -label sec
    $f.f1.ustime configure -value [lindex [set Project:settings(SimulationTime)] 1]
    pack $f.f1 -anchor w -padx 5
    pack $f.f1.stime $f.f1.ustime -side left

    # Display tick

    global $f.dtick:value
    set $f.dtick:value [lindex [set Project:settings(DisplayTick)] 0]

    frame $f.f3
    tixControl $f.f3.dtick \
	-label "Display tick:" \
	-variable $f.dtick:value \
	-value 0 \
	-min 0 \
	-allowempty false -options {
	    label.anchor e
	    label.width 16
	    entry.width 8
	}

    tixOptionMenu $f.f3.udtick -labelside none \
	-variable $f.udtick:unit -options {
	    menubutton.bd 0
	    menubutton.relief flat
	}
			
    $f.f3.udtick add command usc -label usc
    $f.f3.udtick add command msc -label msc
    $f.f3.udtick add command sec -label sec
    $f.f3.udtick configure -value [lindex [set Project:settings(DisplayTick)] 1]
    pack $f.f3 -anchor w -padx 5
    pack $f.f3.dtick $f.f3.udtick -side left

    # Warp factor

    global $f.warp:value
    set $f.warp:value [set Project:settings(WarpFactor)]

    tixControl $f.warp \
	-label "Warp factor:" \
	-variable $f.warp:value \
	-value 3.0 \
	-integer false \
	-min 0.0 \
	-max 10.0 \
	-step 0.1 \
	-allowempty false -options {
	    label.anchor e
	    label.width 16
	    entry.width 8
	}

    pack $f.warp -anchor w -padx 5

    # Time unit

    tixOptionMenu $f.tunit -label "Time unit:" \
	-variable $f.tunit:value -options {
	    menubutton.bd 0
	    menubutton.relief flat
	    label.width 16
	    label.anchor e
	}

    $f.tunit add command usc -label usc
    $f.tunit add command msc -label msc
    $f.tunit add command sec -label sec
    $f.tunit configure -value [set Project:settings(TimeUnit)]
    pack $f.tunit -anchor w -padx 5

    checkbutton $f.vtime -text "Virtual time" \
	-variable Project:settings(Options,virtualTime) \
	-relief flat -bd 2 -pady 0 -width 30

    if {[set Project:settings(Options,virtualTime)] == 1} {
	$f.vtime select
    } {
	$f.vtime deselect
    }
    pack $f.vtime -anchor w

    ## General configuration

    $w.nb add tools -label General -state $state
    set tooltab [$w.nb subwidget tools]

    tixLabelFrame $tooltab.parlbf -label "Parameters" \
	-labelside acrosstop

    pack $tooltab.parlbf -fill both -expand no
    set parlbf [$tooltab.parlbf subwidget frame]

    tixControl $parlbf.tcp \
	-label "TCP/server port:" \
	-variable Project:settings(ServerPort) \
	-value 6545 \
	-min 1024 \
	-allowempty false \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 6
	}

    pack $parlbf.tcp -pady 5 -anchor w -padx 5

    tixControl $parlbf.wdog \
	-label "Watchdog timeout:" \
	-variable Project:settings(Watchdog) \
	-min 0 \
	-allowempty false \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 6
	}

    pack $parlbf.wdog -pady 5 -anchor w -padx 5

    tixControl $parlbf.tlogsz \
	-label "Trace buffer (lines):" \
	-variable Project:settings(TraceLogSize) \
	-min 0 \
	-allowempty false \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 6
	}

    pack $parlbf.tlogsz -pady 5 -anchor w -padx 5

    tixLabelEntry $parlbf.debugger -label "GDB path:" \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 25
	}

    $parlbf.debugger subwidget entry config -textvariable Project:settings(GdbPath)
    pack $parlbf.debugger -pady 5 -anchor w -padx 5 -fill x -expand yes

    tixLabelEntry $parlbf.srcdirs -label "Source directories:" \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 25
	}

    $parlbf.srcdirs subwidget entry config -textvariable Project:settings(SourceDirs)
    pack $parlbf.srcdirs -pady 5 -anchor w -padx 5 -fill x -expand yes

    tixLabelEntry $parlbf.wd -label "Working directory:" \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 25
	}

    $parlbf.wd subwidget entry config -textvariable Project:settings(WorkingDir)
    pack $parlbf.wd -pady 5 -anchor w -padx 5 -fill x -expand yes

    tixLabelEntry $parlbf.args -label "Local arguments:" \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 25
	}

    global Monitor:localArgs
    $parlbf.args subwidget entry config -textvariable Project:settings(LocalArgs)
    pack $parlbf.args -pady 5 -anchor w -padx 5 -fill x -expand yes

    tixLabelEntry $parlbf.printcmd -label "Print command:" \
	-options {
	    label.width 18
	    label.anchor e
	    entry.width 25
	}

    $parlbf.printcmd subwidget entry config -textvariable Project:settings(PrintCmd)
    pack $parlbf.printcmd -pady 5 -anchor w -padx 5 -fill x -expand yes

    ##YM
    ## Preferences

    global tkbridge_prefixdir

    $w.nb add preferences -label Preferences
    set preftab [$w.nb subwidget preferences]

    tixLabelFrame $preftab.prjlbf -label "Project" \
	-labelside acrosstop

    pack $preftab.prjlbf -fill both -expand no
    set prjlbf [$preftab.prjlbf subwidget frame]

    checkbutton $prjlbf.bgimagecb -text "Display wallpaper" \
	-variable Project:settings(Preferences,displaywp) \
	-relief flat -bd 2 -pady 0 -anchor w
    if {[set Project:settings(Preferences,displaywp)] == 1} {
	$prjlbf.bgimagecb select
    } {
	$prjlbf.bgimagecb deselect
    }

    tixComboBox $prjlbf.bgimagebox -label "Wallpaper:" \
	-variable Project:settings(Preferences,wallpaper) \
	-options {
	    label.width 18
	    label.anchor e
	}
    foreach file [glob -nocomplain -- $tkbridge_prefixdir/share/rtai-sim/images/bgnd*] {
	set fname [string range $file [expr 1 + [string last "/" $file]] [expr [string last "." $file] - 1]]
	if {$fname != {}} {
	    $prjlbf.bgimagebox insert end $fname
	}
    }

    pack $prjlbf.bgimagecb -side top -pady 0 -anchor w -padx 8
    pack $prjlbf.bgimagebox -expand yes -fill both -padx 10 -pady 10 -side left

    ##YM

    # get a copy of the old option settings
    set optlist {}
    global Workspace:opt2var Workspace:optNames
    foreach option ${Workspace:optNames} {
	set var [set Workspace:opt2var($option)]
	global $var
	lappend optlist [set $var]
    }

    ##YM
    ## If a particular page was specified,
    ## raise it now
    if {$what != {}} {
	$w.nb raise $what
    }
    ##YM

    ## Button box

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

    tkwait visibility $w
    grab $w
}

proc Workspace:updateSettingsOk {context} {

    global Project:settings

    set w $context.settings

    set simtab [$w.nb subwidget simulation]
    set parlbf [$simtab.parlbf subwidget frame]

    global $parlbf.stime:value $parlbf.ustime:unit
    $parlbf.f1.stime update
    set Project:settings(SimulationTime) \
	[list [set $parlbf.stime:value] [set $parlbf.ustime:unit]]

    global $parlbf.dtick:value $parlbf.udtick:unit
    $parlbf.f3.dtick update
    set Project:settings(DisplayTick) \
	[list [set $parlbf.dtick:value] [set $parlbf.udtick:unit]]

    global $parlbf.warp:value
    $parlbf.warp update
    set Project:settings(WarpFactor) [set $parlbf.warp:value]

    global $parlbf.tunit:value
    set Project:settings(TimeUnit) [set $parlbf.tunit:value]

    set tooltab [$w.nb subwidget tools]
    set parlbf [$tooltab.parlbf subwidget frame]

    $parlbf.tcp update
    $parlbf.wdog update

    destroy $w

    pushEvent Application:event ConfigurationChanged
    pushEvent Application:event ConfigureWallpaperEvent
    pushEvent Application:event OptionChanged
}

proc Workspace:getOptionValue {context option} {

    global Workspace:opt2var

    if {[catch {set var [set Workspace:opt2var($option)]}] == 1} {
	puts "Xenoscope: unknown option \"$option\""
	return 0
    }

    global $var
    return [set $var]
}

proc Workspace:cacheWindowIn {context w label} {

    global Workspace:windowCache

    bind $w <Destroy> "Workspace:cacheWindowOut $context $w %W"
    set nth [lsearch -exact ${Workspace:windowCache} $w]

    # prevent multiple caching

    if {$nth == -1} {
	if {${Workspace:windowCache} == {}} {
	    # 1st cached window available -- enable fast-access menu
	    $context.mbar.window configure -state normal
	}
	lappend Workspace:windowCache $w
	$context.mbar.window.m add command -label $label \
	    -command "wm deiconify $w; raise $w"
    }
}

proc Workspace:cacheWindowOut {context theW {w {}}} {
    
    global Workspace:windowCache

    if {$w != {} && $w != $theW} {
	return
    }

    set nth [lsearch -exact ${Workspace:windowCache} $theW]

    if {$nth != -1} {
	set Workspace:windowCache \
	    [lreplace ${Workspace:windowCache} $nth $nth]
	
	catch {
	    $context.mbar.window.m delete $nth

	    if {${Workspace:windowCache} == {}} {
		# no more cached windows -- disable fast-access menu
		$context.mbar.window configure -state disabled
	    }
	}
    }
}

proc Workspace:cacheRecentProject {context filepath} {

    global Workspace:session

    # insert the path of the just open project into the cache
    # list, ensuring that no more than 8 entries are
    # concurrently kept...

    set plist [set Workspace:session(RecentProjects)]
    set cacheix [lsearch -exact $plist $filepath]

    if {$cacheix != -1} {
	set plist [lreplace $plist $cacheix $cacheix]
    }
    if {[llength $plist] >= 8} {
	set plist [lreplace $plist end end]
    }
    # LIFO ordering
    set Workspace:session(RecentProjects) \
	[linsert $plist 0 $filepath]

    Workspace:updateRecentProjects $context
}

proc Workspace:uncacheRecentProject {context filepath} {

    global Workspace:session

    set plist [set Workspace:session(RecentProjects)]
    set cacheix [lsearch -exact $plist $filepath]

    if {$cacheix != -1} {
	set Workspace:session(RecentProjects) \
	    [lreplace $plist $cacheix $cacheix]
	Workspace:updateRecentProjects $context
    }
}

proc Workspace:updateRecentProjects {context} {

    global Workspace:session

    set mbar $context.mbar
    $mbar.file.m.projects delete 0 end
    set nentries 0

    foreach filename [set Workspace:session(RecentProjects)] {
	if {[file exists $filename]} {
	    set basename [file rootname [file tail $filename]]
	    $mbar.file.m.projects add command -label $basename \
		-command "Workspace:openProject $context $filename"
	    incr nentries
	}
    }

    if {$nentries > 0} {
	$mbar.file.m entryconfigure 2 -state normal
    } {
	$mbar.file.m entryconfigure 2 -state disabled
    }
}

proc Workspace:print {context file} {

    global Project:settings

    set cmd [set Project:settings(PrintCmd)]

    if {$cmd == {}} {
	tk_messageBox \
	    -message "Print command has not been defined.\n\
Please define one using the Project/Settings/General setup window." \
	    -type ok -icon error -title Error
	return
    }

    if {[regexp -indices ".*\(%f\).*" $cmd mvar fileph] == 1} {
	set head [string range $cmd 0 [expr [lindex $fileph 0] - 1]]
	set tail [string range $cmd [expr [lindex $fileph 1] + 1] end]
	set cmd $head$file$tail
    } {
	# if no file placeholder has been found, simply append file name
	# to the command...
	append cmd " $file"
    }

    if {[catch { eval exec -- $cmd } err] == 1} {
	tk_messageBox \
	    -message "Print command failed with the following message:\n$err" \
	    -type ok -icon error -title Error