#!/usr/bin/wish
##
## Ethan Gold <etgold@cs.columbia.edu> 5/25/99
##
## First shot at a launcher.map GUI configurator
##

## Globals
set etcdir "/etc"
set configfile $env(HOME)/.launcher.map
set optframe ""
set changeflag 0
set currwin -1
set optstring "Launcher Options"
set handlestring "Handler Definitions"
set mapstring "Type/Handler Mappings"

## Procedures

##################################################
## Read in the config file
##################################################
proc readconfig {filename} {
    global options handlers mappings comments
    
    if {![file readable $filename]} {
	puts "Config file \"$filename\" unreadable"
	puts "Should I create a new one??"
    }
    
    set fd [open $filename r]
    set lineno 0
    ## save all contiguous comments off the top
    while {[gets $fd line] >= 0} {
	if {[regexp {^#.*} $line]} {
	    lappend comments $line
	} else {break}
	incr lineno
    }

    ## read the config info
    while {[gets $fd line] >= 0} {
	if {[regexp {^launcher .+} $line]} {
	    ## launcher option
	    set options([lindex $line 1]) [lindex $line 2]
	} elseif {[regexp {^handler .+} $line]} {
	    ## handler definition
	    if {[llength $line] < 5} {
		lappend readerrs \
			"badly formed handler definition on line $lineno"
	    } else {
		set item [lindex $line 1]
		set handlers($item.macro) $item
		set handlers($item.multiple) [lindex $line 2]
		set handlers($item.prettyname) [lindex $line 3]
		set handlers($item.cmd) [lrange $line 4 end]
	    }
	} elseif {[regexp {^map .+} $line]} {
	    ## mapping declaration
	    if {[llength $line] < 2} {
		lappend readerrs \
			"badly formed mapping definition on line $lineno"
	    } else {
		set mappings([lindex $line 1]) [lrange $line 2 end]
	    }
	}
	incr lineno
    }
    
    if [info exists readerrs] {showerrs $readerrs}
    ## drop in the default type
    if {![info exists mappings("*/*")]} {
	set mappings(*/*) [list]
    }
    close $fd
}

##################################################
## Show errors in a message window
##################################################
proc showerrs {str} {
    puts "$str"
}

##################################################
## mark changes for saving purposes
##################################################
proc changed {} {
    global changeflag
    set changeflag 1
}

##################################################
## Pick an option window from the user's click
##################################################
proc pick_section {picked} {
    global optstring mapstring handlestring optframe
    if {![string compare $picked $optstring]} {
	options_win $optframe
    } elseif {![string compare $picked $handlestring]} {
	handlers_win $optframe
    } elseif {![string compare $picked $mapstring]} {
	mappings_win $optframe
    }
}

##################################################
## procedure to build the handler defs window
##################################################
proc handlers_win {frame} {
    global handlers currwin
    
    set w "$frame.handlerssub"
    if {[winfo exists $w]} {
	## fill with data and show the window
	catch {pack unpack $currwin}
	$w.parms.pf.entry delete 0 end
	$w.parms.mf.entry delete 0 end
	$w.parms.cf.entry delete 0 end
	fill_hlist $w.lframe.list
	pack $w -fill both -expand 1
	set currwin $w
    } else {
	## build the basic window structure
	frame $w
	frame $w.parms
	frame $w.lframe
	listbox $w.lframe.list -yscrollcommand "$w.lframe.scroll set" \
		-background white -exportselection 0
	scrollbar $w.lframe.scroll -takefocus 0 \
		-command "$w.lframe.list yview"

	pack $w.lframe.scroll -side left -fill y
	pack $w.lframe.list -side right -fill both -expand 1
	
	frame $w.parms.pf
	label $w.parms.pf.label -text "Pretty name"
	entry $w.parms.pf.entry -width 25
	
	frame $w.parms.mf
	label $w.parms.mf.label -text "Macro name"
	entry $w.parms.mf.entry -width 25
	
	frame $w.parms.cf
	label $w.parms.cf.label -text "Shell command"
	entry $w.parms.cf.entry -width 25

	checkbutton $w.parms.cbox -text "Handles multiple filenames" \
		-variable hmflag

	button $w.set -text "Set" -takefocus 0 -command "set_handler $w set"
	button $w.add -text "Add" -takefocus 0 -command "set_handler $w add"
	button $w.del -text "Del" -takefocus 0 -command "set_handler $w del"

	pack $w.parms.pf.entry -side left -anchor n -fill x
	pack $w.parms.pf.label -side right -anchor n
	pack $w.parms.pf -side top -anchor w

	pack $w.parms.mf.entry -side left -anchor n -fill x
	pack $w.parms.mf.label -side right -anchor n
	pack $w.parms.mf -side top -anchor w

	pack $w.parms.cf.entry -side left -anchor n -fill x
	pack $w.parms.cf.label -side right -anchor n
	pack $w.parms.cf -side top -anchor w

	pack $w.parms.cbox -side top -anchor w

	pack $w.lframe -side top -fill both
	pack $w.parms -side top -fill both -padx 20
	
	pack $w.set -side left -anchor s -fill x -expand 1
	pack $w.del -side right -anchor s -fill x -expand 1
	pack $w.add -side right -anchor s -fill x -expand 1

	bind $w.lframe.list <ButtonRelease-1> "fill_hfields $w"
	bind $w.lframe.list <Return> "event generate $w.lframe.list \
		<ButtonRelease-1>"
    }
    
}

##################################################
## fill in fields for handler window
##################################################
proc fill_hfields {w} {
    global handlers hmflag
    set got [$w.lframe.list get [$w.lframe.list curselection]]
    set got [lindex $got 0]
    $w.parms.pf.entry delete 0 end
    $w.parms.pf.entry insert 0 $handlers($got.prettyname)
    $w.parms.mf.entry delete 0 end
    $w.parms.mf.entry insert 0 $handlers($got.macro)
    $w.parms.cf.entry delete 0 end
    $w.parms.cf.entry insert 0 $handlers($got.cmd)
    set hmflag $handlers($got.multiple)
}

##################################################
## fill a listbox with handler information
##################################################
proc fill_hlist {list} {
    global handlers
    $list delete 0 end
    foreach item [lsort -dictionary [array names handlers "*.macro"]] {
	    set item [lindex [split $item .] 0]
	$list insert end "\
		$handlers($item.macro) - $handlers($item.prettyname)"
    }
}

##################################################
## add or change a launcher handler entry
##################################################
proc set_handler {w action} {
    global handlers hmflag mappings
    
    if {![string compare $action "set"] \
	    || ![string compare $action "del"]} {
	set hname [lindex \
		[$w.lframe.list get \
		[$w.lframe.list curselection]] 0]
	unset handlers($hname.macro)
	unset handlers($hname.prettyname)
	unset handlers($hname.multiple)
	unset handlers($hname.cmd)
    }
    
    if {![string compare $action "set"] \
	    || ![string compare $action "add"]} {
	set nhname [$w.parms.mf.entry get]
	set handlers($nhname.macro) [$w.parms.mf.entry get]
	set handlers($nhname.prettyname) [$w.parms.pf.entry get]
	set handlers($nhname.cmd) [$w.parms.cf.entry get]
	set handlers($nhname.multiple) $hmflag
    }

    ## update the mapping names so we don't shoot ourselves
    ## in the foot by changing macro names
    if {![string compare $action "set"]} {
	foreach type [array names mappings] {
	    set index [lsearch $mappings($type) $hname]
	    if {$index >= 0} {
		set mappings($type) \
			[lreplace $mappings($type) $index $index $nhname]
	    }
	}
    }
    if {![string compare $action "del"]} {
	foreach type [array names mappings] {
	    set index [lsearch $mappings($type) $hname]
	    if {$index >= 0} {
		set mappings($type) \
			[lreplace $mappings($type) $index $index]
	    }
	}
    }
    
    $w.parms.mf.entry delete 0 end
    $w.parms.pf.entry delete 0 end
    $w.parms.cf.entry delete 0 end

    fill_hlist $w.lframe.list
    changed
}

##################################################
## procedure to build the launcher options window
##################################################
proc options_win {frame} {
    global options currwin

    set w "$frame.optionssub"
    if {[winfo exists $w]} {
	catch {pack unpack $currwin}
	pack $w -fill both -expand 1
	set currwin $w
    } else {
	frame $w
	foreach item [lsort -dictionary [array names options]] {
	    checkbutton $w.$item -text $item \
		    -variable options($item) \
		    -command "changed"
	    pack $w.$item -side top -anchor w -padx 10
	}
    }
}

##################################################
## Build type->handler mapping window
##################################################
proc mappings_win {frame} {
    global mappings currwin
    
    set w "$frame.mapsub"
    if {[winfo exists $w]} {
	catch {pack unpack $currwin}
	fill_mlist $w
	pack $w -fill both -expand 1
	set currwin $w
    } else {
	frame $w
	frame $w.l
	frame $w.r
	listbox $w.l.maplist -background white \
		-yscrollcommand "$w.l.scroll set" -exportselection 0
	scrollbar $w.l.scroll -command "$w.l.maplist yview" -takefocus 0
	pack $w.l.scroll -side left -fill y
	pack $w.l.maplist -side right -fill both -expand 1
	pack $w.l -side top -fill both -expand 1 -padx 5
	
	frame $w.r.t
	listbox $w.r.t.on -background white -height 5 \
		-yscrollcommand "$w.r.t.scrollon set" -exportselection 0
	scrollbar $w.r.t.scrollon -command "$w.r.t.on yview" -takefocus 0
	pack $w.r.t.scrollon -side left -fill y -expand 1
	pack $w.r.t.on -side left -fill both -expand 1

	frame $w.r.t.m
	button $w.r.t.m.remove -text "--->" -font "fixed 12 bold" \
		-command "remove_mhandler $w"
	button $w.r.t.m.add -text "<---" -font "fixed 12 bold" \
		-command "add_mhandler $w"
	checkbutton $w.r.t.m.def -text "default" -variable mapdef \
		-command "set_mdef $w"
	pack $w.r.t.m.add -fill x -expand 1
	pack $w.r.t.m.remove -fill x -expand 1
	pack $w.r.t.m.def

	pack $w.r.t.m -expand 1 -fill y -side left

	listbox $w.r.t.off -background white -height 5 \
		-yscrollcommand "$w.r.t.scrolloff set" -exportselection 0
	scrollbar $w.r.t.scrolloff -command "$w.r.t.off yview"  -takefocus 0
	pack $w.r.t.scrolloff -side left -fill y -expand 1
	pack $w.r.t.off -side left -fill both -expand 1

	pack $w.r.t -side top -expand 1 -fill both

	frame $w.r.tf
	label $w.r.tf.label -text "MIME type: "
	entry $w.r.tf.entry -textvariable mimeentry
	pack $w.r.tf.label -side left
	pack $w.r.tf.entry -side right -expand 1 -fill x
	
	pack $w.r.tf -expand 1 -fill x

	frame $w.r.b
	button $w.r.b.add -text "Add" -takefocus 0 \
		-command "set_mapping $w add"
	button $w.r.b.del -text "Del" -takefocus 0 \
		-command "set_mapping $w del"

	pack $w.r.b.del -side right -anchor s -fill x -expand 1
	pack $w.r.b.add -side right -anchor s -fill x -expand 1
	pack $w.r.b -side bottom -fill both -expand 1
	
	pack $w.r
	bind $w.l.maplist <ButtonRelease-1> "fill_mfields $w"
	bind $w.r.t.on <ButtonRelease-1> "fill_mdefcheck $w"
	bind $w.r.t.on <Double-Button-1> "$w.r.t.m.remove invoke"
	bind $w.r.t.off <Double-Button-1> "$w.r.t.m.add invoke"

    }
}

##################################################
## Fill the widgets with type-specific mapping info
##################################################
proc fill_mfields {w} {
    global mappings mapdef handlers
    $w.r.t.on delete 0 end
    $w.r.t.off delete 0 end
    set cursel [$w.l.maplist curselection]
    if {![string compare $cursel ""]} {return}
    set picked [$w.l.maplist get $cursel]
    foreach macro $mappings($picked) {
	$w.r.t.on insert end $macro
    }
    foreach macro [lsort -dictionary [array names handlers "*.macro"]] {
	set macroname [lindex [split $macro .] 0]
	if {[lsearch $mappings($picked) $macroname] == -1} {
	    $w.r.t.off insert end $macroname
	}
    }
    $w.r.tf.entry delete 0 end
    $w.r.tf.entry insert 0 $picked
    set mapdef 0
}

##################################################
## show the default/non-default status of a macro
##################################################
proc fill_mdefcheck {w} {
    global mappings mapdef
    set cursel [$w.r.t.on curselection]
    if {![string compare $cursel ""]} {set mapdef 0; return}
    set pick [$w.r.t.on get $cursel]
    set type [$w.l.maplist get [$w.l.maplist curselection]]
    if {![string compare $pick [lindex $mappings($type) 0]]} {
	set mapdef 1
    } else {set mapdef 0}
}

##################################################
## add or remove a MIME to handler mapping
##################################################
proc set_mapping {w action} {
    global mappings
    set cursel [$w.l.maplist curselection]
    if {![string compare $cursel ""]} {return}
    set pick [$w.l.maplist get $cursel]

    if {![string compare $action "add"]} {
	set new [$w.r.tf.entry get]
	if {![string compare $new ""]} {return}
	set mappings($new) [list]
	fill_mlist $w
	set all [$w.l.maplist get 0 end]
	set new [lsearch $all $new]
	$w.l.maplist see $new
	$w.l.maplist activate $new
	$w.l.maplist selection set $new
	event generate $w.l.maplist <ButtonRelease-1>
    } else {
	unset mappings($pick)
	fill_mlist $w
    }
    changed
}

##################################################
## set the default handler for a mapping
##################################################
proc set_mdef {w} {
    global mapdef mappings
    set cursel [$w.r.t.on curselection]
    if {![string compare $cursel ""]} {set mapdef 0; return}
    set pick [$w.r.t.on get $cursel]
    set type [$w.l.maplist get [$w.l.maplist curselection]]

    ## can't set/unset the default for a single mapping
    if {[llength $mappings($type)] == 1} {set mapdef 1; return}

    if {![string compare $pick [lindex $mappings($type) 0]]} {
	## unset default
	set mappings($type) [lrange $mappings($type) 1 end]
	lappend mappings($type) $pick
	fill_mfields $w
    } else {
	## set default
	lappend newmappings $pick
	foreach macro $mappings($type) {
	    if {[string compare $pick $macro]} {
		lappend newmappings $macro
	    }
	}
	set mappings($type) $newmappings
	fill_mfields $w
    }
    changed
}

##################################################
## add handler from the list for a type
##################################################
proc add_mhandler {w} {
    global mappings
    set cursel [$w.r.t.off curselection]
    if {![string compare $cursel ""]} {set mapdef 0; return}
    set pick [$w.r.t.off get $cursel]
    set type [$w.l.maplist get [$w.l.maplist curselection]]
    
    lappend mappings($type) $pick
    fill_mfields $w
    changed
}
##################################################
## remove handler from the list for a type
##################################################
proc remove_mhandler {w} {
    global mappings
    set cursel [$w.r.t.on curselection]
    if {![string compare $cursel ""]} {set mapdef 0; return}
    set pick [$w.r.t.on get $cursel]
    set type [$w.l.maplist get [$w.l.maplist curselection]]
    
    foreach macro $mappings($type) {
	if {[string compare $pick $macro]} {
	    lappend newmappings $macro
	}
    }
    if {![info exists newmappings]} {set newmappings [list]}
    set mappings($type) $newmappings
    fill_mfields $w
    changed
}

##################################################
## fill a listbox with MIME type item names
##################################################
proc fill_mlist {w} {
    global mappings
    $w.r.t.off delete 0 end
    $w.l.maplist delete 0 end
    foreach item [lsort -dictionary [array names mappings]] {
	$w.l.maplist insert end $item
    }
}

##################################################
## save the current configuration to file
##################################################
proc save_config {} {
    global changeflag comments options handlers mappings configfile
    if {!$changeflag} {return}
    
    file rename -force $configfile "$configfile.bak"
    set fd [open $configfile "w+"]
    foreach line $comments {
	puts $fd $line
    }
    puts $fd ""
    
    ## launcher options
    puts $fd "###### LAUNCHER OPTIONS ######"
    foreach item [lsort -dictionary [array names options]] {
	puts $fd "launcher $item $options($item)"
    }
    puts $fd ""

    ## handlers
    puts $fd "###### HANDLER DEFINITIONS ######"
    foreach item [lsort -dictionary [array names handlers "*.macro"]] {
	set item [lindex [split $item .] 0]
	puts $fd "handler $handlers($item.macro)\t\
		$handlers($item.multiple)\
		\"$handlers($item.prettyname)\"\
		$handlers($item.cmd)"
    }
    puts $fd ""
    
    ## mappings
    puts $fd "###### TYPE/HANDLER MAPPINGS ######"
    foreach item [lsort -dictionary [array names mappings]] {
	puts $fd "map $item\t$mappings($item)"
    }
    puts $fd ""

    puts $fd "## modified by Launcherconfig \
	    [clock format [clock seconds]]"

    close $fd
}

##################################################
## startup sequence, file reading, etc
##################################################
proc startup {filename optframe} {
    global optstring handlestring mapstring
    readconfig $filename
    set w .mainframe.lframe.categories
    $w delete 0 end
    $w insert end "$optstring"
    $w insert end "$handlestring"
    $w insert end "$mapstring"
    $w selection set 0
    options_win $optframe
    handlers_win $optframe
    mappings_win $optframe
    pick_section $optstring
}

##################################################
## Main startup sequence
##################################################


## Main Execution Thread

catch {exec whoami} UID

if {![string compare $UID "root"]} {
    puts "Warning: running as root - we'll modify the global config"
    set configfile "$etcdir/launcher.map"
} else {
    if {![file exists $configfile]} {
	file copy $etcdir/launcher.map $env(HOME)/.launcher.map
    }
}

## build main widgets
label .filename -text "FILE: $configfile" -justify left
frame .mainframe
frame .mainframe.lframe
frame .mainframe.rframe -relief groove -borderwidth 2

listbox .mainframe.lframe.categories -background white \
	-yscrollcommand ".mainframe.lframe.catscroll set" \
	-exportselection 0 -takefocus 0
scrollbar .mainframe.lframe.catscroll -takefocus 0\
	-command ".mainframe.lframe.cagetories yview"


button .save -text "Save Config" -command {save_config} -takefocus 0
button .quit -text "Quit" -command {exit} -takefocus 0

pack .filename -side top -fill x -anchor w

pack .mainframe.lframe.categories -side right -fill both
pack .mainframe.lframe.catscroll -side left -fill y

pack .mainframe.lframe -side left -fill y
pack .mainframe.rframe -side right -fill both -expand 1
pack .mainframe -expand 1 -fill both

pack .save -side left -anchor s -fill x -padx 5 -pady 5 -expand 1
pack .quit -side right -anchor s -fill x -padx 5 -pady 5 -expand 1

## continue the startup sequence
set lbox .mainframe.lframe.categories

set optframe .mainframe.rframe
startup $configfile $optframe

## Main widget bindings
bind $lbox <ButtonRelease-1> {
    if {[llength [$lbox curselection]]} {
	set picked "[$lbox get [$lbox curselection]]"
	pick_section $picked
    }
}

bind . <Escape> {
    .quit invoke
}

