#!/usr/local/bin/wish
global env gv

set gv(version)		"Visual Program Launcher (Version 1.4 27jun96)"
set gv(program)		vprog
set gv(iconname)	[string toupper $gv(program)]
set gv(top)		.$gv(program)
set gv(author)		"John van Gulik"

proc errmess { pw {msg ""} } {
	global env gv
	pack [label .errmess -text $msg] -side top -expand true -fill both
	pack [button .ok -text "OK" -command "destroy .ok"] -side top
	tkwait window .ok
}

##############################################################################
#####	Set the required environment variables
##############################################################################

if {[info exists env(HOME)] && $env(HOME)=="/"} {set env(HOME) "/root"}

if {$tcl_platform(platform)=="windows"} {
	if {![info exists env(TKAPPS)]} {
		set env(TKAPPS) /TKAPPS
	}
	if {![file isdirectory $env(TKAPPS)]} {
		errmess . "Directory $env(TKAPPS) not found"
		exit 1
	}
} elseif {$tcl_platform(platform)=="unix"} {
	if {![info exists env(TKAPPS)]} {
		if {[file isdirectory $env(HOME)/TKAPPS]} {
			set env(TKAPPS) $env(HOME)/TKAPPS
		} elseif {[file isdirectory /opt/TKAPPS]} {
			set env(TKAPPS) /opt/TKAPPS
		} elseif {[file isdirectory /apps/TKAPPS]} {
			set env(TKAPPS) /apps/TKAPPS
		} else {
			set env(TKAPPS) /usr/local/TKAPPS
		}
	}
	if {![file isdirectory $env(TKAPPS)]} {
		errmess . "Directory $env(TKAPPS) not found"
		exit 1
	}
} else {
	errmess . "This application is not supported under $tcl_platform(platform)"
	exit 1
}

set auto_path [linsert $auto_path 0 $env(TKAPPS)/lib]

wm withdraw .

standard_startup $gv(program) $gv(version)
if {[winfo exists .startup]} {destroy .startup}
if {[info exists gv(startup.id)]} {image delete $gv(startup.id)}

##############################################################################
#####	Set required variables and options
##############################################################################

##############################################################################
#####	SUBROUTINES
##############################################################################

proc build_user_menu { } {
	global env gv

	$gv(top).bar.start.m.u delete 0 end
	$gv(top).bar.start.m.u add command -label "Add/Delete Programs..." \
		-command "f_touch $env(HOME)/.vprogrc ; \
			background $env(TKAPPS)/bin/vedit $env(HOME)/.vprogrc"
	$gv(top).bar.start.m.u add separator

	if {[file exists $env(HOME)/.vprogrc]} {
		catch {f_read $env(HOME)/.vprogrc} res
		regsub -all {[\n]*$} res {} $res
		foreach line [split $res "\n"] {
			set fields [split $line ":"]
			set name [lindex $fields 0]
			set command [lindex $fields 1]
			if {$command==""} {
				$gv(top).bar.start.m.u add separator
			} else {
				$gv(top).bar.start.m.u add command -label $name \
					-command "background $command"
			}
		}
	}
}

##############################################################################
#####	MAIN PROGRAM
##############################################################################

# start off in user's home directory
cd

toplevel	$gv(top)
wm overrideredirect $gv(top) true
wm positionfrom $gv(top) program
wm iconname	$gv(top) $gv(iconname)
wm iconbitmap	$gv(top) @$env(TKAPPS)/bitmaps/$gv(program).xbm
wm iconmask	$gv(top) @$env(TKAPPS)/bitmaps/$gv(program).msk
wm title	$gv(top) $gv(version)
wm minsize	$gv(top) [winfo screenwidth $gv(top)] 1
wm protocol	$gv(top) WM_DELETE_WINDOW exit

set side [lindex $argv 0]

if {$side=="bottom"} {
	wm geometry     $gv(top) +0-0
	set width [winfo screenwidth $gv(top)]
	set height 1
} elseif {$side=="left"} {
	wm geometry     $gv(top) +0+0
	set width 1
	set height [winfo screenheight $gv(top)]
} elseif {$side=="right"} {
	wm geometry     $gv(top) -0+0
	set width 1
	set height [winfo screenheight $gv(top)]
} else {
	wm geometry	$gv(top) +0+0
	set width [winfo screenwidth $gv(top)]
	set height 1
}

pack [frame $gv(top).bar -width $width -height $height] \
	-side top -fill both
bind $gv(top).bar <Enter> {
	$gv(top).bar.start.m post %X %Y
	bind $gv(top).bar.start.m <3> "$gv(top).bar.start.m unpost ; break"
}

menubutton $gv(top).bar.start -menu $gv(top).bar.start.m \
	-text [lang "Start..." "Demarrer..."]

menu $gv(top).bar.start.m
$gv(top).bar.start.m add cascade -label [lang "Standard Applications" "FRENCH"] \
	-menu $gv(top).bar.start.m.s
$gv(top).bar.start.m add cascade -label [lang "User Applications" "FRENCH"] \
	-menu $gv(top).bar.start.m.u
$gv(top).bar.start.m add separator
$gv(top).bar.start.m add command -label [lang "Show Program Bar" "FRENCH"] \
	-command "wm deiconify $gv(top).progs"
$gv(top).bar.start.m add command -label [lang "Dismiss" "FRENCH"] \
	-command "$gv(top).bar.start.m unpost"
$gv(top).bar.start.m add command -label [lang "Exit" "Abandonner"] \
	-command "exit"

toplevel	$gv(top).progs
wm withdraw	$gv(top).progs
wm transient	$gv(top).progs $gv(top)
wm minsize	$gv(top).progs 10 10

bind $gv(top).progs <3> {wm withdraw $gv(top).progs}

pack [label $gv(top).progs.help] \
	-side bottom -fill x
bind_help $gv(top).progs.help $gv(top).progs.help \
	[lang "Help text" "Texte d'aide"]

menu $gv(top).bar.start.m.s

foreach program {vmail3 vvac vbiff sb mpf vdir vquery fm vedit vdb vnews tkcustom zircon} {
	set file $env(TKAPPS)/bin/$program
	if {![file exists $file]} {continue}

	if {![file exists $env(TKAPPS)/bitmaps/${program}.xbm]} {continue}

	set helpline [lindex [split [lindex [f_grep version $file] 0] {"}] 1]
	set title [lindex [split $helpline {(}] 0]

	pack [frame $gv(top).progs.$program -bd 2 -relief raised] \
		-side left -expand true -fill both
	pack [button $gv(top).progs.$program.but -bitmap "@$env(TKAPPS)/bitmaps/${program}.xbm" \
		-command "background $file" ] \
		-side top -expand true -fill both
	pack [label $gv(top).progs.$program.lab -text "$program"] \
		-side top -fill x
	bind_help $gv(top).progs.$program $gv(top).progs.help $helpline

	$gv(top).bar.start.m.s add command -label $title \
		-command "background $file"

}

menu $gv(top).bar.start.m.u -postcommand "build_user_menu"

