#
# shadow.tcl: Main Tcl script for the GUI.
#
# ------------------------------------------------
# Mumit Khan <khan@xraylith.wisc.edu>
# Center for X-ray Lithography
# University of Wisconsin-Madison
# 3731 Schneider Dr., Stoughton, WI, 53589
# ------------------------------------------------
#
# Copyright (c) 1994-1996 Mumit Khan
#
#

######################### Initialize options ##############################

global env
# Handle Tcl library environment variables
if [catch {set env(SHADOW_ROOT)} gvars(shadow_root)] {
    error "Startup error: SHADOW_ROOT environment variable not set!"
}
if [catch {set env(SHADOW_GUI_ROOT)} gvars(shadow_gui_root)] {
    set gvars(shadow_gui_root) $gvars(shadow_root)
}

global shadow_library
set gvars(shadow_tcl_library) $shadow_library

if [catch {set env(SHADOW_XMENU_FILE)} gvars(menufile)] {
    if {$tcl_version >= 7.5} {
	set gvars(menufile) \
	    [file join $gvars(shadow_gui_root) data shadow.xmen]
    } else {
	# NON-PORTABLE-HACK. WILL NOT WORK ON MACs.
	set gvars(menufile) \
	    $gvars(shadow_gui_root)/data/shadow.xmen
    }
}
if [catch {set env(SHADOW_LIBEXEC)} gvars(shadow_libexec)] {
    if {$tcl_version >= 7.5} {
	set gvars(shadow_libexec) \
	    [file join $gvars(shadow_gui_root) libexec]
    } else {
	# NON-PORTABLE-HACK. WILL NOT WORK ON MACs.
	set gvars(shadow_libexec) \
	    $gvars(shadow_gui_root)/libexec
    }
}

# Handle SHADOW environment variables
if [catch {set env(SHADOW_BIN)} gvars(shadow_bin)] {
    if {$tcl_version >= 7.5} {
	set gvars(shadow_bin) \
	    [file join $gvars(shadow_root) bin]
    } else {
	# NON-PORTABLE-HACK. WILL NOT WORK ON MACs.
	set gvars(shadow_bin) \
	    $gvars(shadow_root)/bin
    }
}

set tcl_precision 17

# Set-up various paths
lappend auto_path $gvars(shadow_tcl_library)

# Check for correct Tcl version
if {[info tclversion] < 7.0} {
    puts stderr "shadow: Tcl version < 7.0 cannot be used with shadow"
    exit 1
}

#
# Win32 lacks a few standard variables, so fix those here.
#
if {[tix platform] == "windows"} {
    if [catch {set env(HOME)} gvars(homedir)] {
	set gvars(homedir) [pwd]
    }
    if [catch {set env(USER)} gvars(username)] {set gvars(username) ""}
    if [catch {set env(TEMP)} gvars(tmpdir)] {
	if [file isdir c:/temp] {
	    set gvars(tmpdir) c:/temp
	} elseif [file isdir c:/tmp] {
	    set gvars(tmpdir) c:/tmp
	} else {
	    set gvars(tmpdir) .
	}
	# cygwin32 likes TMPDIR env variable; this way we avoid having to
	# have a /tmp (per P_tmpdir in <stdio.h>
	if ![info exists env(TMPDIR)] {set env(TMPDIR) $gvars(tmpdir)}
    }
    # sanitize pathnames for C strings.
    set gvars(homedir) [cvt_filename_to_tcl $gvars(homedir)]
    set gvars(tmpdir) [cvt_filename_to_tcl $gvars(tmpdir)]
} elseif {[tix platform] == "unix"} {
    if [catch {set env(HOME)} gvars(homedir)] {set gvars(homedir) [pwd]}
    if [catch {set env(USER)} gvars(username)] {set gvars(username) "unknown"}
    if [catch {set env(TMPDIR)} gvars(tmpdir)] {set gvars(tmpdir) "/tmp"}
} else {
    error "Only works on Unix and Windows platforms for now. Sorry"
}

#
# large, medium or small?
#
if ![info exists gvars(screentype)] {
    if {[winfo screenheight .] < 700 || [winfo screenwidth .] < 900} {
	set gvars(screentype) s
    } elseif {[winfo screenheight .] < 1000 || [winfo screenwidth .] < 1200} {
	set gvars(screentype) m
    } else {
	set gvars(screentype) l
    }
}

#
# if you want to override any extra X option resources, specify these here.
#
#option add *Frame*background 		lightgrey
#option add *Label*background 		lightgrey
#option add *Entry*background 		lightgrey
#option add *Entry*relief 		sunken
#option add *Scrollbar*foreground 	antiquewhite
#option add *Scrollbar*background 	lightgrey
#option add *Scrollbar*relief		sunken
#option add *Scrollbar*activeForeground	lightblue

#option add *XMenuToolBox*Font -*-courier-*-*-*-*-12-*-*-*-*-*-*-*
#option add *XMenuToolBox*Foreground Green
#option add *XMenuPage*Font -*-courier-*-r-*-*-18-*-*-*-*-*-*-*

#option add *XMenuToolBar*font -*-helvetica-medium-r-normal-*-10-*-*-*-*-*-*-*

######################### Initialize globals ##############################

# Set-up globals.
set gvars(cmdhelpfile)	"$gvars(shadow_tcl_library)/COMMANDS"
set gvars(verbose)	0		;# be annoyingly loud?
if {[tix platform] == "windows"} {
    set gvars(pref_file)	"$gvars(homedir)/shadow.ini"
    set gvars(startup_file)	"$gvars(homedir)/shadow.startup"
} else {
    set gvars(pref_file)	"$gvars(homedir)/.shadow-pref"
    set gvars(startup_file)	"$gvars(homedir)/.shadow-startup"
}
set gvars(wkspc_file)	""		;# for loading/saving workspace state
set gvars(loadsavedir)	"./"		;# for load/save system/source
set gvars(systemfile)	systemfile.dat	;# for load/save system/source
set gvars(startprefix)	start		;# for Namelist files.
set gvars(tmpfiles)	""		;# to be deleted at exit
set gvars(win_title)	"SHADOW GUI"	;# something for the WM title bar

# globals that simply cache the back-end values.
set gvars(cur_oe)	0		;# current OE being edited
set gvars(cur_scr)	0		;# current SCR being edited

# interface globals (various window paths typically)
set gvars(cur_page_w)	""		;# window path of current page
set gvars(page_w)	""		;# frame containing the page
set gvars(backbtn)	""		;# back button in every page
set gvars(msg_w)	""		;# message window
set gvars(statusbar)	""		;# for the balloon help
set gvars(cur_selectbar) ""		;# message to show current selection
set gvars(cur_editbar) ""		;# message to show current edit
set gvars(cur_directory) ""		;# current working directory
set gvars(msg_w_top_stub) ""		;# message window stub for top
set gvars(msg_w_bot_stub) ""		;# message window stub for bottom
set gvars(cmd_w_stub)	""		;# for toggling on/off cmd window
set gvars(cmd_w)	""		;# Tcl Command window
set gvars(toolbar_w_stub) ""		;# Tcl Command window
set gvars(toolbar)	""		;# Toolbar at top
set gvars(editbar)	""		;# toolbar for page edits
set gvars(tools_w)	""		;# tool listbox
set gvars(balloon)	""		;# main balloon help widget
set gvars(show_na)	0		;# show the n/a column?
if {$gvars(screentype) == "l"} {
    set gvars(page_w_ht)    "600"       ;# height of menu page (pixels)
    set gvars(page_w_wt)    "780"       ;# width of menu page (pixels)
} elseif {$gvars(screentype) == "m"} {
    set gvars(page_w_ht)    "500"       ;# height of menu page (pixels)
    set gvars(page_w_wt)    "620"       ;# width of menu page (pixels)
} elseif {$gvars(screentype) == "s"} {
    set gvars(page_w_ht)    "400"       ;# height of menu page (pixels)
    set gvars(page_w_wt)    "580"       ;# width of menu page (pixels)
} 
set gvars(beamline_popup) ""		;# popup menu for BEAMLINE
set gvars(page_popup)	""		;# popup menu for PAGE
set gvars(clipboard_w)  ""		;# clipboard info label
set gvars(plot_windows)	0		;# number of active plotting windows

set gvars(shadow_image) ""		;# GIF banner image

# programs that are used here to read/write SHADOW NAMELIST files.
set exeext ""
if {[tix platform] != "unix"} {
    set exeext ".exe"
}
set gvars(nml-to-g)	$gvars(shadow_bin)/nml-to-g${exeext}
set gvars(g-to-nml)	$gvars(shadow_bin)/g-to-nml${exeext}
set gvars(gen_source)	$gvars(shadow_bin)/gen_source${exeext}
set gvars(trace)	$gvars(shadow_bin)/trace${exeext}
set gvars(run_system)	$gvars(shadow_libexec)/run-system.sh
# set gvars(run_plotxy)	$gvars(shadow_libexec)/run-plotxy.sh
set gvars(run_plotxy)	$gvars(shadow_bin)/plotxy${exeext}
set gvars(run_mirinfo)	$gvars(shadow_bin)/mirinfo${exeext}
set gvars(run_srcinfo)	$gvars(shadow_bin)/sourcinfo${exeext}
set gvars(run_minmax)	$gvars(shadow_bin)/minmax${exeext}

# other globals (state variables)
set gvars(curpage)	{}		;# name of the current page
set gvars(curpageitem)	{}		;# name of the current item selected
set gvars(pagestack)	{}		;# stack of pages (for traversal)
set gvars(itemstack)	{}		;# stack of items (for traversal)
set gvars(pagestack_w)	{}		;# stack of pages window paths (cache)
set gvars(source_saved)	1		;# to warn before quitting
set gvars(system_saved)	1		;# to warn before quitting
set gvars(editing_what)	{}		;# now editing SOURCE/OE/SCREEN?
set gvars(clipboard)	""		;# what's in the clipboard now?
set gvars(modified)	0		;# workspace modified?

#
# hacks to map TOOL names and PAGE names (due to length limitation in
# current MENU file format, where the RECORD, ie., TOOL name, is <= 3
# characters!).
#
# HACK/FIXME/REMOVE: Not needed anymore, but need to make sure.
#
if 0 {
set gpage2tool(PLOTSRC)	PL1		;# PLOTXY is PLX in MENU file
set gpage2tool(PLOTOE)	PL2		;# PLOTXY is PLX in MENU file
set gpage2tool(PLOTSCR)	PL3		;# PLOTXY is PLX in MENU file
set gpage2tool(PLOTXY)	PLX		;# PLOTXY is PLX in MENU file
set gpage2tool(MIRINFO)	MIR		;# MIRINFO is MIR in MENU file
set gpage2tool(SRCINFO)	SRI		;# SRCINFO is SRI in MENU file
set gpage2tool(MINMAX)	MIN		;# MINMAX is MIN in MENU file

set gtool2page(PL1)	PLOTSRC
set gtool2page(PL2)	PLOTOE
set gtool2page(PL3)	PLOTSCR
set gtool2page(PLX)	PLOTXY
set gtool2page(MIR)	MIRINFO
set gtool2page(SRI)	SRCINFO
set gtool2page(MIN)	MINMAX

} else {

#
# Now we have a mapping section in the MENU file, so the following are
# basically no-ops. I'll remove these completely later.
#
set gpage2tool(PLOTSRC)	PLOTSRC	
set gpage2tool(PLOTOE)	PLOTOE
set gpage2tool(PLOTSCR)	PLOTSCR
set gpage2tool(PLOTXY)	PLOTXY
set gpage2tool(MIRINFO)	MIRINFO
set gpage2tool(SRCINFO)	SRCINFO
set gpage2tool(MINMAX)	MINMAX

set gtool2page(PLOTSRC)	PLOTSRC
set gtool2page(PLOTOE)	PLOTOE
set gtool2page(PLOTSCR)	PLOTSCR
set gtool2page(PLOTXY)	PLOTXY
set gtool2page(MIRINFO)	MIRINFO
set gtool2page(SRCINFO)	SRCINFO
set gtool2page(MINMAX)	MINMAX
}

# user defined option globals/preferences defaults
set gdefprefs(add_src_at_startup) 0	;# always add SRC at startup
set gdefprefs(edit_src_at_startup) 0	;# always pull up SRC menu on startup
set gdefprefs(edit_added_obj) 0		;# edit SRC/OE/SCR just added
set gdefprefs(show_cmd_window) 0	;# show Tcl/XMenu command window
set gdefprefs(msg_window_at_bottom) 1	;# show message window at bottom
set gdefprefs(balloon_help) 1		;# 0 if really hate these
set gdefprefs(show_toolbar) 1		;# 0 to hide toolbar
set gdefprefs(cache_pages)	0	;# cache the pages as they're created
set gdefprefs(font_family) helvetica
set gdefprefs(font_fixed_family) courier
if {$gvars(screentype) == "s"} {
    set gdefprefs(font_size) 10
    set gdefprefs(font_fixed_size) 10
} elseif {$gvars(screentype) == "m"} {
    set gdefprefs(font_size) 12
    set gdefprefs(font_fixed_size) 12
} else {
    set gdefprefs(font_size) 14
    set gdefprefs(font_fixed_size) 14
}


# user defined option globals/preferences (eg., set via Option menus)
set gprefs(add_src_at_startup)		$gdefprefs(add_src_at_startup)
set gprefs(edit_src_at_startup)		$gdefprefs(edit_src_at_startup)
set gprefs(edit_added_obj)		$gdefprefs(edit_added_obj)
set gprefs(show_cmd_window)		$gdefprefs(show_cmd_window)
set gprefs(msg_window_at_bottom)	$gdefprefs(msg_window_at_bottom)
set gprefs(balloon_help)		$gdefprefs(balloon_help)
set gprefs(show_toolbar)		$gdefprefs(show_toolbar)
set gprefs(cache_pages)			$gdefprefs(cache_pages)
#
# now the fonts. These are now set in preferences file, and init_fonts 
# sets the actual fonts after init_preferences is done with its duty.
# I still haven't put these into the preferences array -- TODO/FIXME
#
set gvars(font_family)			$gdefprefs(font_family)
set gvars(font_fixed_family)		$gdefprefs(font_fixed_family)
set gvars(font_size)			$gdefprefs(font_size)
set gvars(font_fixed_size)		$gdefprefs(font_fixed_size)

# Workspace variables. Really defined in state.tcl.
set workspace(filename)		""	;# file to load from
set workspace(username)		""	;#    user who created it
set workspace(timestamp)	""	;#    when
set workspace(machine)		""	;#    on what machine

# annotation support
set workspace(title)		""	;# set to be filename initially
set workspace(subtitle)		""	;# set to be filename initially
set workspace(annotation)	""	;# the actual annotation

######################### Utilities #######################################


#
# [beamline list system] enumerates the entire beamline and we get what we 
# need out of it.
#
# Here's the current output:
#
# 
#     {SOURCE <#i>} {2 1 i} {2 <#i> <#i> <#i>} {1 <#i> <#i> <#i>}
#        1     2     3 4 5   6  7    8    9     10 11   12   13
# 
#   1-2  SOURCE and # of SOURCE inspectors (empty list if no source)
#   3-5  Current OE, SCREEN and Inspector (0 if not applicable)
#   6    Number of Screens in this OE
#   7    Number of Inspectors in this OE
#   8-9  Number of Inspectors in SCREEN 1 of OE 1 and SCREEN 2 of OE 1
# 
#    

proc get_source {} {
    return [lindex [beamline list system] 0]
}

proc get_num_oe {} {
    return [expr [llength [beamline list system]] - 2]
}

proc get_num_scr {oe} {
    return [lindex [lindex [beamline list system] [expr $oe + 1]] 0]
}

proc get_inspectors {} {
    return beamline get inspector
}

proc get_source_inspectors {} {
    return beamline get inspector source
}

proc get_oe_inspectors oe {
    return beamline get inspector oe $oe
}

proc get_scr_inspectors {oe scr} {
    return beamline get inspector scr $oe $scr
}

proc get_current_oe {} {
    return [lindex [lindex [beamline list system] 1] 0]
}

proc get_current_scr {} {
    return [lindex [lindex [beamline list system] 1] 1]
}

proc get_current_inspector {} {
    return [lindex [lindex [beamline list system] 1] 2]
}

proc get_current_selection {} {
    global gvars
    return [editbar:selected $gvars(editbar).toolbox.a]
}

#
# find the OE number of the current selection. If Screen 5 of OE 1 is
# selection, then return 1.
#
proc get_oe_from_selection {} {
    set oe 0
    set cur_selection [string trim [get_current_selection]]
    set selection_type [string toupper [lindex $cur_selection 0]]
    switch -glob $selection_type {
	"OE" {
	    set oe [lindex $cur_selection 1]
	}
	"SCR*" {
	    set oe [lindex $cur_selection 1]
	}
	INSPECTOR {
	    set target [string toupper [lindex $cur_selection 1]]
	    switch -glob $target {
	        "OE" {
		    set oe [lindex $cur_selection 2]
		}
		"SCR*" {
		    set oe [lindex $cur_selection 2]
		}
	    }
	}
    }
    return $oe
}

#
# find the Screen number (of what OE) of the current selection. If Screen 5 
# of OE 1 is selection, then return "1 5".
#

proc get_scr_from_selection {} {
    set oe 0
    set scr 0
    set cur_selection [string trim [get_current_selection]]
    set selection_type [string toupper [lindex $cur_selection 0]]
    switch -glob $selection_type {
	"OE" {
	    set oe [lindex $cur_selection 1]
	}
	"SCR*" {
	    set oe [lindex $cur_selection 1]
	    set scr [lindex $cur_selection 2]
	}
	INSPECTOR {
	    set target [string toupper [lindex $cur_selection 1]]
	    switch -glob $target {
	        "OE" {
		    set oe [lindex $cur_selection 2]
		}
		"SCR*" {
		    set oe [lindex $cur_selection 2]
		    set scr [lindex $cur_selection 3]
		}
	    }
	}
    }
    return "$oe $scr"
}

#
# get a value for inspector.
#
#         {beamline <id> var}
#         {source <id> var}
#         {oe <oe#> <id> var}
#         {scr <oe#> <scr#> <id> var}
#
proc get_inspector_value {args} {
    set type [string tolower [lindex $args 0]]
    set value ""
    switch -glob -- $type {
        beamline {
	    puts stderr "get_inspector_value: $type not supported yet."
	}
        source {
	    set id [lindex $args 1]
	    set var [lindex $args 2]
	    set value [beamline vget inspector source $id $var]
	}
        oe {
	    set oe [lindex $args 1]
	    set id [lindex $args 2]
	    set var [lindex $args 3]
	    set value [beamline vget inspector oe $oe $id $var]
	}
	scr* {
	    set oe [lindex $args 1]
	    set scr [lindex $args 2]
	    set id [lindex $args 3]
	    set var [lindex $args 4]
	    set value [beamline vget inspector scr $oe $scr $id $var]
	}
	default {
	    puts stderr "get_inspector_value: $type not supported yet."
	}
    }
    return $value
}

#
# get a value for a tool.
#
# args == {beamline var}
#         {source var}
#         {oe <oe#> var}
#         {scr <oe#> <scr#> var}
#         {inspector beamline <id> var}
#         {inspector source <id> var}
#         {inspector oe <oe#> <id> var}
#         {inspector scr <oe#> <scr#> <id> var}
#
proc get_value {args} {
    set args [join $args]
    set type [string tolower [lindex $args 0]]
    set value ""
    switch -glob -- $type {
        beamline {
	    puts stderr "get_value: $type not supported yet."
	}
        source {
	    set var [lindex $args 1]
	    set value [beamline vget source $var]
	}
        oe {
	    set oe [lindex $args 1]
	    set var [lindex $args 2]
	    set value [beamline vget oe $oe $var]
	}
	scr* {
	    set oe [lindex $args 1]
	    set scr [lindex $args 2]
	    set var [lindex $args 3]
	    set value [beamline vget scr $oe $scr $var]
	}
	inspector {
	    set value [get_inspector_value [lrange $args 1 end]
	}
	default {
	    puts stderr "get_value: $type not supported yet."
	}
    }
    return $value
}

#
# set a value for inspector.
#
#         {beamline <id> var value}
#         {source <id> var value}
#         {oe <oe#> <id> var value}
#         {scr <oe#> <scr#> <id> var value}
#
proc set_inspector_value {args} {
    set type [string tolower [lindex $args 0]]
    set nargs [llength $args]
    set var [lindex $args [expr $nargs-2]]
    set value [lindex $args [expr $nargs-1]]
    switch -glob -- $type {
        beamline {
	    puts stderr "set_inspector_value: $type not supported yet."
	}
        source {
	    set id [lindex $args 1]
	    beamline vset inspector source $id $var $value
	}
        oe {
	    set oe [lindex $args 1]
	    set id [lindex $args 2]
	    set var [lindex $args 3]
	    beamline vset inspector oe $oe $id $var $value
	}
	scr* {
	    set oe [lindex $args 1]
	    set scr [lindex $args 2]
	    set id [lindex $args 3]
	    set var [lindex $args 4]
	    beamline vset inspector scr $oe $scr $id $var $value
	}
	default {
	    puts stderr "set_inspector_value: $type not supported yet."
	}
    }
}

#
# set a value for a tool.
#
# args == {beamline var value}
#         {source var value}
#         {oe <oe#> var value}
#         {scr <oe#> <scr#> var value}
#         {inspector beamline <id> var value}
#         {inspector source <id> var value}
#         {inspector oe <oe#> <id> var value}
#         {inspector scr <oe#> <scr#> <id> var value}
#
proc set_value {args} {
    set args [join $args]
    set type [string tolower [lindex $args 0]]
    set nargs [llength $args]
    set var [lindex $args [expr $nargs-2]]
    set value [lindex $args [expr $nargs-1]]
    switch -glob -- $type {
        beamline {
	    puts stderr "set_value: $type not supported yet."
	}
        source {
	    beamline vset source $var $value
	}
        oe {
	    set oe [lindex $args 1]
	    beamline vset oe $oe $var $value
	}
	scr* {
	    set oe [lindex $args 1]
	    set scr [lindex $args 2]
	    beamline vset scr $oe $scr $var $value
	}
	inspector {
	    set_inspector_value [lrange $args 1 end]
	}
	default {
	    puts stderr "set_value: $type not supported yet."
	}
    }
}

proc editing_what {} {
    global gvars
    return $gvars(editing_what)
}

#----------------------------------------------------------------------#
# Misc Routines 
#----------------------------------------------------------------------#

proc cleanup_and_exit {{status 0}} {
    global gvars
    foreach tmpfile $gvars(tmpfiles) {
	catch "remove_file $tmpfile"
    }
    exit $status
}

# effects - Print usage message and exist
proc shadow_usage {{status 1}} {
    puts stderr {
Usage: shadow [-hv] [-preference pref_file] [-startup startup_file]
	      [-m menufile] [-g gfile] [WorkspaceFile]
 
    -v:         turn on verbose mode (default: off)
    -h:         print this info
    -g:         gfile with parameters
    -preference:loads the preference file (default: ~/.shadow-pref)
    -startup:	loads the startup file (default: ~/.shadow-startup)
    -menu:      menu file to load (default: $HADOW_DATA/shadow.men)
    Workspace:  Loads an entire saved workspace from this file.
 
Examples:

    % shadow                  ;# Start up SHADOW workspace with def options.
    % shadow es5-beamline.dat ;# Start up and load state previously saved
                              ;#    from file "es5-beamline.dat"
    }
    exit $status
}


# verbose mode puts
proc vputs {args} {
    global gvars
    if {$gvars(verbose)} {
	puts stderr "shadow: [join $args]"
    }
}

proc read_gfile {file} {
    global gvars
    if {[catch "open $file r" fin] != 0} {
	puts stderr "cannot open gfile \"$file". Going ahead anyway."
	return 1
    }
    while {[gets $fin line] >= 0} {
	# is it a comment or empty line?
	if {[regexp {^[ \t]*#} $line] == 0 &&
	    [regexp {^[ \t]*$} $line] == 0} {
	    set line [split $line]
	    if {[lindex $line 1] != "="} {
		puts stderr \
		    "Illegal syntax in gfile \"$file\". wrong format file?"
		close $fin
		return 1
	    }
	    # use case-indepent variable names.
	    set lname [string tolower [lindex $line 0]]
	    set lvalue [lrange $line 2 end]
	    # take care of ``special'' variables in gfile
	    if {[string compare $lname verbose] == 0} {
		if {[string match {[yY]*} $lvalue]} {
		    set lvalue 1
		} else {
		    set lvalue 0
		}
	    }
	    #
	    # now simply add a variable in gvars array with the same
	    # name as the one in the gfile and the corresponding value.
	    set gvars($lname) $lvalue
	}
    }
    return 0
}

# parse the command line arguments and fill up the gvars array elements.
proc parse_args {} {
    global argv gvars gprefs
    vputs "parsing argv: $argv"
    while {[llength $argv] != 0} {
	set arg [lindex $argv 0]
	set argv [lrange $argv 1 end]
	vputs "arg = $arg, argv = $argv"

	case $arg in {
	    -g {
		if {[llength $argv] < 1} {
		    puts stderr "Error: -g option requires a <gfile> name." 
		    shadow_usage
		}
		set gfile [lindex $argv 0]
		set argv [lrange $argv 1 end]

		if {[file isfile $gfile] && [file readable $gfile]} {
		    set gvars(gfile) $gfile
		    #
		    # now read the gfile. notice how the command line args
		    # following this will override the gfile parameters.
		    #
		    read_gfile $gfile
		} else {
		    puts stderr \
			"gfile $gfile not readable. permission problem?"
		}
	    }
	    -m* {
		if {[llength $argv] < 1} {
		    puts stderr "Error: -m option requires a menu filename." 
		    shadow_usage
		}
		set gvars(menufile) [lindex $argv 0]
		set argv [lrange $argv 1 end]
		vputs "setting menu file to $gvars(menufile)"
	    }
	    -pref* {
		if {[llength $argv] < 1} {
		    puts stderr \
			"Error: -preference option requires a filename." 
		    shadow_usage
		}
		set gvars(pref_file) [lindex $argv 0]
		set argv [lrange $argv 1 end]
		vputs "setting preference file to $gvars(pref_file)"
		if {![file readable $gvars(pref_file)]} {
		    puts stderr \
			"Error: cannot read preference file $gvars(pref_file)" 
		    shadow_usage
		}
	    }
	    -start* {
		if {[llength $argv] < 1} {
		    puts stderr \
			"Error: -startup option requires a filename." 
		    shadow_usage
		}
		set gvars(startup_file) [lindex $argv 0]
		set argv [lrange $argv 1 end]
		vputs "setting preference file to $gvars(startup_file)"
		if {![file readable $gvars(startup_file)]} {
		    puts stderr \
			"Error: cannot read startup file $gvars(startup_file)" 
		    shadow_usage
		}
	    }
	    -h {
		# don't exit with an error status - not an error
		shadow_usage 0
	    }
	    -v {
		set gvars(verbose) 1
		vputs "setting verbose mode to on"
	    }
	    -* {
		puts stderr "shadow: bad option \"$arg\"."
		shadow_usage 
	    }
	    * {
		if {$gvars(wkspc_file) != ""} {
		    puts stderr "shadow: Can only load Workspace from one file."
		    shadow_usage 
		} else {
		    set gvars(wkspc_file) "$arg"
		}
	    }
	}
    }

    vputs "menu file:       $gvars(menufile)"
    vputs "preference file: $gvars(pref_file)"
    vputs "startup file:    $gvars(startup_file)"
    vputs "Workspace:       $gvars(wkspc_file)"
}

#
# initialize user preferences
#
proc init_preferences {} {
    global gvars gprefs
    if [file readable $gvars(pref_file)] {
	load_prefs
    }
}

#
# initialize fonts. Should be called *after* init_preferences
# We should really use "tix resetoptions" and change the scheme used by
# Tix, but Tix only has 12 and 14 point font schemes and we need smaller
# ones esp on laptops.
#
proc init_fonts {} {
    global gvars gprefs
    set gvars(page_font) \
    "-*-$gvars(font_family)-medium-r-normal-*-$gvars(font_size)-*-*-*-*-*-*-*"
    set gvars(page_bold_font) \
    "-*-$gvars(font_family)-bold-r-normal-*-$gvars(font_size)-*-*-*-*-*-*-*"
    set gvars(page_italic_font) \
    "-*-$gvars(font_family)-bold-o-normal-*-$gvars(font_size)-*-*-*-*-*-*-*"
    set gvars(fixed_font) \
    "-*-$gvars(font_fixed_family)-medium-r-*-*-$gvars(font_fixed_size)-*-*-*-*-*-*-*"
    #
    # only set default font when the screen is a small one, otherwise
    # funny things happen with fonts on my linux box. BUG/FIXME/CHECK
    #
    if {$gvars(screentype) != "l"} {
	option add *font $gvars(page_bold_font)
    }
}


#
# load the initial menu file. Assume that the UI is already built.
#
proc init_menu {} {
    global gvars
    global gprefs
    vputs "Loading menu file \"$gvars(menufile)\" ..."
    if {![file exists $gvars(menufile)] || ![file readable $gvars(menufile)]} {
	dialog .info_d "Load Error" \
	    "Menu file \"$gvars(menufile)\" non-existent or unreadable" \
	    {} 0 Dismiss
	exit 1
    }
    if {[catch "xmenu load $gvars(menufile)" msg]} {
	dialog .info_d "Load Error" \
	    "Bad menu file format \"$gvars(menufile)\". Aborting." \
	    {} 0 Dismiss
	exit 1
    }
    vputs "Loaded menu file \"$gvars(menufile)\" ..."

    # now create a SOURCE if user wants it in preference file
    if {$gprefs(add_src_at_startup)} {
	vputs "Creating source at startup ..."
	add_src_cmd
	if {$gprefs(edit_src_at_startup)} {
	    vputs "Editing source at startup ..."
	    editbar_callback SOURCE
	}
    }
}

#
# initialize user-specific startup. This is run AFTER initialization.
#
proc init_startup {} {
    global gvars
    global gprefs

    if {[file readable $gvars(startup_file)] && \
        ![catch "open $gvars(startup_file) r" fid] \
    } {
	GUI:set_startup_msg "Reading Startup file ..."
	vputs "Loading startup from file $gvars(startup_file) ..."
	#
	# read the whole file in one shot we can put actual Tcl procs
	# and such things in the file, and Tcl can parse the damn thing
	# any way it wants.
	#
	set startup_buf [read $fid]
	if {[catch {uplevel #0 eval $startup_buf} msg]} {
	    set emsg [build_msg \
		"ERROR: error loading startup file `$gvars(startup_file)'" \
		"\n\t(file ignored) Tcl says: $msg\n" \
	    ]
	    puts stderr $emsg
	    return 1
	}
    }
    #
    # now do the initial GUI loading if specified.
    #
    if {$gvars(wkspc_file) != ""} {
	load_state_cmd $gvars(wkspc_file)
    } else {
	GUI:add_file_to_title ""
	new_state_cmd
	show_about_page
    }
    return 0
}

######################## Start program ####################################
#
# now the real thing.
#

wm withdraw .
set startup [GUI:make_startup]
busy_window hold $startup

GUI:set_startup_msg "Initializing fonts/preferences ..."

#
# parse the command line and initialize the interface
#
parse_args 
init_preferences
init_fonts

GUI:set_startup_msg "Creating GUI ..."

GUI:make
do_chdir [pwd]

GUI:set_startup_msg "Reading SHADOW menu  ..."

init_menu

GUI:set_startup_msg "Initializing startup sequence ..."

init_startup

GUI:set_startup_msg "SHADOW GUI Ready!"

wm deiconify .

clear_clipboard_cmd
reset_msg

busy_window release $startup
destroy $startup
raise .
