ecosynth.tcl

eCos操作系统源码

	# This is a mild error, because default.tdf should be installed
	# below libexec. However the default file does not actually
        # define anything, it is just a set of comments, so there is
	# nothing to be gained by issuing a warning.
    }
} else {

    set synth::target_definition $_config_file
    
    proc synth_device { name data } {
	if { "" != $synth::_tdf_current_device } {
	    error "synth_device $name is nested inside $synth::_tdf_current_device\nNesting of synth_device entries is not allowed."
	}
	if { -1 != [lsearch -exact $synth::_tdf_devices $name] } {
	    error "Duplicate entry for synth_device $name"
	}
	set synth::_tdf_current_device $name
	set synth::_tdf_current_index 0
	lappend synth::_tdf_devices $name
	eval $data
	# If the eval resulted in an error, propagate it immediately rather than attempt
	# any form of recovery. The downside is that only error per run will be
	# reported.
	set synth::_tdf_current_device ""
    }
    rename unknown _synth_unknown
    proc unknown { args } {
	if { "" == $synth::_tdf_current_device } {
	    # An unknown command at the toplevel. Pass this to the
	    # original "unknown" command, in the unlikely event that
	    # the user really did want to autoload a library or do
	    # something similar. 
	    eval _synth_unknown $arg
	    return
	}

	# Anything else is treated as an option within the synth_device
	set synth::_tdf_device_options($synth::_tdf_current_device,$synth::_tdf_current_index) $args
	incr synth::_tdf_current_index
    }

    set _config_file_msg ""
    set _result [catch { source $_config_file } _config_file_msg ]
    
    rename unknown ""
    rename synth_device ""
    rename _synth_unknown unknown

    if { $_result } {
	# Any problems reading in the target definition file should be
	# treated as an error: I/O is unlikely to behave in the way
	# that the user expects.
	set msg "An error occurred while reading in the target definition file\n    $_config_file\n    $_config_file_msg\n"
	synth::report_error $msg
	exit 1
    }
    unset _result _config_file_msg
}

unset _dirlist _tdf _config_file _candidate

# }}}

if { $synth::flag_gui } {
# {{{  Main GUI code                                            

# {{{  Session file                                             

# ----------------------------------------------------------------------------
# The tool manages a file ~/.ecos/synth/guisession, holding information
# such as the size and position of the main window. The aim is to give
# the user a fairly consistent interface between sessions. The information
# is saved during exit handling, and also in response to the window
# manager WM_SAVE_YOURSELF request. However note that the latter does
# not extend to user session information - restarting the eCos application
# the next time a user logs in is inappropriate for eCos, plus if
# the application is being run inside gdb (a likely scenario) it is gdb
# that should handle restarting the application.
#
# Using a single file has limitations. Specifically the user may be
# switching between a number of different target definition files,
# each resulting in a subtly different layout, and arguably there
# should be separate session information for each one. However
# distinguishing between per-target and global settings would be
# very complicated.
#
# The most obvious implementation involves the options database.
#
# FIXME: implement properly

namespace eval synth {
    # Make sure we are using the right options from .Xdefaults etc.
    tk appname "ecosynth"

    if { $synth::flag_debug } {
	# synth::report "Reading in session file ~/.ecos/synth/guisession\n"
    }
    
    # synth::report_warning "Support for reading session file ~/.ecos/synth/guisession not yet implemented.\n"
    
    if { [file exists "~/.ecos/synth/guisession"] } {
	if {0 != [catch { option readfile "~/.ecos/synth/guisession" userDefault} msg]} {
	    # synth::report_error "Failed to read GUI session information from file ~/.ecos/synth/guisession\n    $msg\n"
	}
    }

    proc _update_session_file { arg_list } {
	# synth::report_warning "Support for updating session file ~/.ecos/synth/guisession not yet implemented.\n"
    }
    proc _handle_wm_save_yourself { } {
	# synth::report_warning "Support for WM_SAVE_YOURSELF not yet implemented\n"
    }

    synth::hook_add "exit" synth::_update_session_file
}

# }}}
# {{{  Load images                                              

# ----------------------------------------------------------------------------
# Load various useful bitmaps etc. into memory, so that they can be accessed
# by any code that needs them.
#
# Running1 is a coloured version of the eCos logo. running2 and running3 are
# used by alternative implementations of the heartbeat: running2 has the
# red and black reversed, and running3 is mostly a mirror image of the normal
# logo.
namespace eval synth {

    proc load_image { image_name filename } {
	set result 0
	set type [file extension $filename]
	if { ! [file exists $filename] } {
	    synth::report_error "Image $filename has not been installed.\n"
	} elseif { ! [file readable $filename] } {
	    synth::report_error "Image $filename is not readable.\n"
	} elseif { (".xbm" == $type) } {
	    if { 0 == [catch { set $image_name [image create bitmap -file $filename] }] } {
		set result 1
	    } else {
		synth::report_error "Bitmap image $filename is invalid.\n"
	    }
	} else {
	    if { 0 == [catch { set $image_name [image create photo -file $filename] }] } {
		set result 1
	    } else {
		synth::report_error "Image $filename is invalid.\n"
	    }
	}
	return $result
    }
    
    set _images [list "tick_yes.xbm" "tick_no.xbm" "save.xbm" "cut.xbm" "copy.xbm" "paste.xbm" \
	    "help.xbm" "running1.ppm" "saveall.xbm" ]
    foreach _image $_images {
	variable image_[file rootname $_image]
	synth::load_image "synth::image_[file rootname $_image]" [file join $synth::install_dir $_image]
    }
    unset _images _image
}

# }}}
# {{{  Balloon help                                             

namespace eval synth {

    variable _balloon_messages
    variable _balloon_pending ""
    
    toplevel .balloon
    label .balloon.info -borderwidth 2 -relief groove -background "light yellow"
    pack .balloon.info -side left -fill both -expand 1
    wm overrideredirect .balloon 1
    wm withdraw .balloon
    
    proc register_balloon_help { widget message } {
	set synth::_balloon_messages($widget) $message
	bind $widget <Enter> { synth::_balloonhelp_pending %W }
	bind $widget <Leave> { synth::_balloonhelp_cancel }
    }
    
    proc _balloonhelp_pending { widget } {
	synth::_balloonhelp_cancel
	set synth::_balloon_pending [after 1200 [list synth::_balloonhelp_show $widget]]
    }
    
    proc _balloonhelp_cancel { } {
	if { "" != $synth::_balloon_pending } {
	    after cancel $synth::_balloon_pending
	    set synth::_balloon_pending ""
	} else {
	    wm withdraw .balloon
	}
    }

    proc _balloonhelp_show { widget } {
	.balloon.info configure -text $synth::_balloon_messages($widget)
	set x [expr [winfo rootx $widget] + 2]
	set y [expr [winfo rooty $widget] + [winfo height $widget] + 2]
	wm geometry .balloon +$x+$y
	wm deiconify .balloon
	raise .balloon
	set synth::_balloon_pending ""
    }
}

# }}}
# {{{  Window manager settings                                  

# ----------------------------------------------------------------------------
# Set up the current program name in the title bar etc.

namespace eval synth {

    if { $synth::flag_debug } {
	synth::report "Performing required interactions with window manager\n"
    }

    # The toplevel is withdrawn during startup. It is possible that
    # some of the windows and other objects created initially will end
    # up being deleted again before the system is fully up and running,
    # and the event loop is entered before then to accept requests from
    # the eCos application. This could cause confusing changes. The
    # toplevel is displayed in response to the constructors-done request.
    wm withdraw .

    # For now disable all attempts to use the "send" command. Leaving it
    # enabled would introduce security problems.
    rename "::send" {}
    
    variable title "eCos synthetic target"
    if { "" != $synth::ecos_appname} {
	append synth::title ": $synth::ecos_appname ($synth::_ppid)"
    }
    wm title . $synth::title

    # Use the specified geometry, or that from the last session.
    # Obviously how well this works depends very much on the
    # window manager being used.
    set _geometry ""
    if { "" ==  $synth::geometry} {
	# Command line request to suppress the preferences. Revert
	# to a default size.
	set _geometry "640x480"
    } elseif { "<none>" == $synth::geometry } {
	# No command line option, use the value from the preferences file
	# FIXME: implement
	set _geometry "640x480"
    } else {
	# There was an explicit -geometry option on the command line. Use it.
	set synth::_geometry $synth::geometry
	if { [regexp -- {^([0-9]+x[0-9]+).*$} $synth::_geometry] } {
	    wm sizefrom . "user"
	}
	if { [regexp -- {^.*([+-][0-9]+[+-][0-9]+)$} $synth::_geometry] } {
	    wm positionfrom . "user"
	}
    }
    wm geometry . $synth::_geometry
    unset synth::_geometry

    set _file [file join $synth::install_dir "ecosicon.xbm"]
    if { [file readable $synth::_file] } {
	wm iconbitmap . "@$synth::_file"
    }
    set _file [file join $synth::install_dir "ecosiconmask.xbm"]
    if { [file readable $synth::_file] } {
	wm iconmask . "@$synth::_file"
    }
    unset synth::_file
    
    if { "" != $synth::ecos_appname } {
	wm iconname . "ecosynth: $synth::ecos_appname"
    } else {
	wm iconname . "ecosynth"
    }

    wm protocol . "WM_DELETE_WINDOW" synth::_handle_exit_request
    wm protocol . "WM_SAVE_YOURSELF" synth::_handle_wm_save_yourself
}

# }}}
# {{{  Exit and kill handling                                   

# ----------------------------------------------------------------------------
# Exit handling. The user may request program termination using various
# different ways:
#   1) File->Exit
#   2) ctrl-Q, the shortcut for the above
#   3) the Window Manager's delete-window request
#
# If eCos has already exited then the request can be handled straightaway.
# The invocation of exit will go via the exit hooks so appropriate
# clean-ups will take place.
#
# If eCos has not already exited then it is assumed that the user wants
# the eCos application to terminate as well as the GUI. This can be achieved
# via the interrupt subsystem. However, there is a risk that the application
# has crashed, or is blocked in gdb, or has interrupts permanently disabled,
# in which case it is not going to respond to the SIGIO. To allow for this
# a number of retries are attempted, and after five seconds of this the
# application is killed off forcibly.

namespace eval synth {
    
    variable _handle_exit_retries 0
    variable _handle_exit_after   ""
    
    proc _handle_exit_request { } {

	if { !$synth::ecos_running } {
	    exit 0
	}
	# Setting this flag causes ecosynth to exit immediately once
	# the application terminates.
	set synth::flag_immediate_exit 1

	# Now ask the application to exit
	synth::request_application_exit

	# Set up a timer to retry this
	if { "" == $synth::_handle_exit_after } {
	    set synth::_handle_exit_after [after 1000 synth::_handle_exit_timer]

	    # And output something so the user knows the request has been received
	    synth::report "Waiting for the eCos application to exit.\n"
	}
    }

    # This routine requests termination of eCos, but not of 
    # ecosynth
    proc _handle_kill_request { } {
	if { $synth::ecos_running } {
	    synth::request_application_exit
	    if { "" == $synth::_handle_exit_after } {
		set synth::_handle_exit_after [after 1000 synth::_handle_exit_timer]
	    }
	}