ecosynth.tcl

开放源码实时操作系统源码.

}

# }}}
# {{{  Output                                                   

# ----------------------------------------------------------------------------
# The usual set of utilities for issuing warnings, errors, ...
#
# There are three possibilities to consider:
#
#   1) running in text-only mode. The output should just go to stdout
#
#   2) running in GUI mode and the text window exists. Just update the
#      window
#
#   3) running in GUI mode but the text window is not yet ready. The
#      output needs to be buffered for now, and will be flushed
#      later.
#
# Also, if for some reason this program exits while there is output still
# buffered that output should also go to stdout.
#
# If any errors occur during initialization, e.g. an invalid device script
# or user initialization scripts, those get reported and an error count
# is maintained. When the eCos application reports that initialization is
# complete it will be sent back a status for the auxiliary, and will
# exit if things have not started up correctly. This tries to ensure that
# if there are multiple errors the user sees all of them.

namespace eval synth {

    variable _pending_output [list]
    variable _logfd ""
    variable _error_count 0

    proc logfile_open { } {
	synth::report "Opening logfile $synth::logfile"
	set msg ""
	if { [catch { set synth::_logfd [open $synth::logfile "w"] } msg ] } {
	    synth::report_error "Unable to open logfile \"$synth::logfile\"\n    $msg\n"
	}
    }

    # A default implementation of output. This gets overwritten later when running
    # in GUI mode, so if GUI mode is enabled then this proc must be called before
    # the GUI is ready and the data must be queued.
    proc output { msg filter } {
	if { ! $synth::flag_gui } {
	    # If a logfile exists, output normally goes there rather than
	    # to standard output. The exception is for errors which
            # always go to stderr, in addition to the logfile.
	    if { "" != $synth::_logfd } {
		puts -nonewline $synth::_logfd $msg
		if { "error" == $filter } {
		    puts -nonewline stderr $msg
		}
	    } else {
		if { "error" == $filter } {
		    puts -nonewline stderr $msg
		} else {
		    puts -nonewline $msg
		}
	    }
	} else {
	    lappend synth::_pending_output [list $msg $filter]
	}
    }
    
    # Invoked by the text window code once everything is ready
    # and synth::output has been redefined.
    proc _flush_output { } {
	foreach msg $synth::_pending_output {
	    synth::output [lindex $msg 0] [lindex $msg 1]
	}
	set synth::_pending_output [list]
    }

    # Cope with early exits. This will only have an effect if
    # _flush_output has not been called yet, and by implication
    # if synth::output has not yet been redefined.
    proc _exit_flush_output { arg_list } {
	if { 0 != [llength $synth::_pending_output] } {
	    set synth::flag_gui 0
	    synth::_flush_output
	}
    }
    synth::hook_add "exit" synth::_exit_flush_output
    
    proc report { msg } {
	synth::output $msg "report"
    }

    proc report_warning { msg } {
	synth::output "Warning: $msg" "warning"
    }

    proc report_error { msg } {
	incr synth::_error_count
	synth::output "Error: $msg" "error"
    }

    # Internal errors indicate a serious problem within ecosynth or
    # a device-specific script. For now this results in output to
    # stderr, a backtrace, and termination of the auxiliary, which
    # should also cause the eCos application to shut down.
    #
    # An alternative approach would involve calling ::error and
    # benefitting from its backtrace generation, but there are various
    # places where it makes to sense to catch problems and call
    # synth::error rather than internal_error
    proc internal_error { msg } {
	puts stderr "ecosynth, an internal error has occurred:"
	puts stderr "    $msg"
	puts stderr "---------- backtrace -------------------------------------------------"
	for { set level [info level] } { $level > 0 } { incr level -1 } {
	    puts stderr [info level $level]
	}
	puts stderr "----------------------------------------------------------------------"
	puts stderr "ecosynth, exiting."
	exit 1
    }

    # Dummy implementations of the exported filter routines, in case a script
    # tries to create a filter even when not running in graphical mode
    variable _dummy_filters [list]
    
    proc filter_exists { name } {
	set result 0
	if { -1 != [lsearch -exact $synth::_dummy_filters $name] } {
	    set result 1
	}
	return $result
    }

    proc filter_get_list { } {
	return $synth::_dummy_filters
    }

    proc filter_add { name args } {
	if { [synth::filter_exists $name] } {
	    synth::internal_error "attempt to install filter $name twice.\n"
	}
	lappend synth::_dummy_filters $name
    }
}

# }}}
# {{{  Argument processing and global options                   

# ----------------------------------------------------------------------------
# Argument processing. The eCos application will usually just pass its
# command line arguments to the auxiliary. Four special arguments will
# have been examined already:
#
#    -io, --io
#        I/O facilities, i.e. the auxiliary should run
#    -ni, -nio, --ni, --nio
#        No I/O facilities, i.e. the auxiliary should not be run.
#    -nw, --nw, --no-windows
#        No windows, i.e. disable the GUI
#    -w, --w, --windows
#        Enable the GUI
#
# There are a number of additional flags available as standard:
#
#    -v, --version
#        The usual
#    -h, --help
#        Ditto
#    -k, --k, --keep-going
#        Ignore errors as much as possible
#    -nr, --no-rc
#        Skip the initrc and mainrc files
#    -x, --exit
#        The auxiliary should exit at the same time as the eCos application.
#    -nx, --no-exit
#        Inverse of the above
#    -V, --verbose
#        The usual
#    --debug
#        Not intended for end users
#    -l <file>, -l=<file>, --logfile <file>, --logfile=<file>
#        Send all output to the specified file. In GUI mode this is in addition
#        to the main text window. In non-GUI mode this is instead of stdout.
#    -t <file>, -t=<file>, --target <file>, --target=<file>
#        Specify the target definition file.
#
# Many X applications accept a common set of options, e.g. -display,
# -geometry, etc. Although usually Tk will process these, there are
# some problems - see ecosynth.c, ecosynth_appinit() for details.
# Hence -geometry has to be processed here.
#
#    -geometry <geom>
#
#
# Some device-specific scripts may want to support additional
# command line arguments. This is somewhat messy, since the core
# code has no way of knowing what devices might be available and
# hence what the actual valid arguments are. It would be possible
# to just ignore any arguments that are not used by any device,
# but that could really confuse a user who has made a typo. Instead
# the code below keeps track of which arguments have been "consumed",
# allowing it to issue a warning about unconsumed arguments after
# initialization.
#
# Arguments can take the following forms:
#
#    1) -flag or --flag.
#    2) -name=value or --name=value
#    3) -name value or --name value
#
# There is a possibility of confusion if any of the values begin with a hyphen.
# It is hard to do anything about this without advance knowledge of what all
# the valid arguments are. Instead the user can avoid problems by using
# the -name=value variant on the command line.
#
# There is also possible confusion if a single argument can occur multiple
# times. If that is permitted then things can get rather messy, and
# the current API does not really handle it.

namespace eval synth {

    # Keep track of all arguments which have not yet been consumed.
    array set _argv_unconsumed [list]
    for { set i 0 } { $i < $::argc } { incr i } {
	set synth::_argv_unconsumed($i) [lindex $::argv $i]
    }

    # Provide a list of just those arguments that have not yet
    # been consumed.
    proc argv_get_unconsumed { } {
	set result [list]
	for { set i 0 } { $i < $::argc } {incr i } {
	    if { [info exists synth::_argv_unconsumed($i)] } {
		lappend result $synth::_argv_unconsumed($i)
	    }
	}
	return $result
    }

    proc _argv_consume { index } {
	if { [info exists synth::_argv_unconsumed($index)] } {
	    unset synth::_argv_unconsumed($index)
	}
    }
    
    # Internal routine. Given a string of the form "-flag" or "-name=",
    # return an index within argv or -1 if not found. As a side effect
    # this "consumes" the argument.
    proc _argv_lookup { name } {
	set result -1
	if { "=" != [string index $name end] } {
	    for { set i 0 } { $i < $::argc } { incr i } {
		set arg [lindex $::argv $i]
		if { [string equal $arg $name] || [string equal $arg "-[set name]"] } {
		    set result $i
		    synth::_argv_consume $i
		    break
		}
	    }
	} else {
	    set name [string range $name 0 end-1]
	    set len  [string length $name]
	    for { set i 0 } { $i < $::argc } { incr i } {
		set arg [lindex $::argv $i]
		if { [string equal -length $len $arg $name] } {
		    if { "=" == [string index $arg $len] } {
			set result $i
			synth::_argv_consume $i
			break;
		    } elseif { ([string length $arg] == $len) && ($i < ($::argc - 1)) } {
			set result $i
			synth::_argv_consume $i
			synth::_argv_consume [expr $i + 1]
			break
		    }
		} elseif { [string equal -length [expr $len + 1] $arg "-[set name]"] } {
		    if { "=" == [string index $arg [expr $len + 1]] } {
			set result $i
			synth::_argv_consume $i
			break
		    } elseif { ([string length $arg] == [expr $len + 1]) && ($i < ($::argc - 1)) } {
			set result $i
			synth::_argv_consume $i
			synth::_argv_consume [expr $i + 1]
			break
		    }
		}
	    }
	}
	return $result
    }

    # Look for a given argument on the command line.
    proc argv_defined { name } {
	set result 0
	set index [synth::_argv_lookup $name]
	if { -1 != $index } {
	    set result 1
	}
	return $result
    }
    
    # Return the value associated with a given argument, which must be present.
    proc argv_get_value { name } {
	if { "=" != [string index $name end] } {
	    synth::internal_error "attempt to get a value for a simple flag argument \"$name\".\n"
	}
	set result ""
	set index [synth::_argv_lookup $name]
	if { -1 == $index } {
	    synth::internal_error "attempt to get the value associated with a non-existent argument \"$name\".\n"
	}
	set arg [lindex $::argv $index]
	set len [string length $name]
	if { [string equal -length $len $arg $name] } {
	    set result [string range $arg $len end]
	} elseif { [string equal -length [expr $len + 1] $arg "-[set name]"] } {
	    set result [string range $arg [expr $len + 1] end]
	} else {
	    set result [lindex $::argv [expr $index + 1]]
	}
	return $result
    }

    # -ni/-nio are not relevant. If present then they would have been handled
    # within the eCos application, the auxiliary would not have been spawned,
    # and this script would not be running.

    # -io will have been processed by the eCos application.