#!/usr/bin/tclsh
##
## Ethan Gold <etgold@cs.columbia.edu> 7/2/98
## rewritten almost entirely 1/14/99 for a far
## better architecture and to support MIME when
## available, and file type handling grouping
##
## latest revision 5/31/99
##
## this program attempts to match a
## file extension or type to a program
## designed to open it.
## right now it uses it's own configuration
## file, but ideally it would match the file
## against a mime.types file and use that
## globally. Unfortunatly the Unix "file" command
## does not return MIME types.
##

## this will work for everything except the file command
## since tcl handles ~/ properly internally.
if {![info exists env(HOME)]} {set env(HOME) "~/"}

###########
## globals
###########
set version "0.86"
set launcherurl "http://www.cs.columbia.edu/~etgold/software/launcher/"

set etcdir "/etc"
set globalextfile "$etcdir/mime.types"
set globalmapfile "$etcdir/launcher.map"
#set globalmagicmimefile "$etcdir/magic.mime"
#set globalmagicmimefile "$etcdir/mime-magic"
## watch out - netscape's .mime.types is a mess
set userextfile "$env(HOME)/.mime.types"
set usermapfile "$env(HOME)/.launcher.map"
set usermagicmimefile "$env(HOME)/.mime-magic"
set launchchoice "launcherchoice"
set fileprog "file -b"
set zfileprog "file -z -b"
## hold the type/handler mappings
##    $type.handler $type.desc, $type.many
##    command      , GUI desc  , boolean - handles multiple files
set maparray(dummy) dum
unset maparray(dummy)
set genericmap(dummy) dum
unset genericmap(dummy)
set defaulthandler "emacs"
set deftype "*/*"

## flag indicating that the user should
## not be queried and the first defined handler
## for each type should be used
set usedefault 0

## handler names and related information
set handlers(dummy) dum
unset handlers(dummy)
## hold the extension/type mappings
set extarray(dummy) dum
unset extarray(dummy)

## hold the type/file mappings
set havetypes(dummy) dum
unset havetypes(dummy)
## hold the file/type mappings
set files(dummy) dum
unset files(dummy)

set debug 0
set all 0
set wait 1
set showtypes 0
set runexe 1
set usefilecmd 1
set typepattern {(\^([a-z]|[A-Z]|[0-9]|_|-)+/([a-z]|[A-Z]|[0-9]|_|-)+\$)}
set URLtype "text/URL"
set dirtype "filesystem/directory"
set exetype "application/executable"
set usage "launcher \
	\[\[\[--all\] \[--nowait\] \[--type\]\]\
	| \[--showtypes\] \[--compressed\]\
	| \[--help\] | \[--version\]\]\
	filename | URL ..."
## hack
if {[file writable /dev/console]} {
    set reportfd [open /dev/console w]
} else { set reportfd stdout }

########################################
## return debugging flag
########################################
proc debug {} {
    global debug
    return $debug
}

########################################
## query user via launcherchoice program
########################################
proc queryUser {hlist prompt} {
    global maparray launchchoice
    
    if [debug] {puts "in queryUser"}
    set sorted [sortHandlers $hlist]
    set sortpretty [lindex $sorted 1]
    set sorted [lindex $sorted 0]
    #puts "sorted: $sorted"
    #puts "pretty: $sortpretty"

    set handler_index -1
    catch {eval exec $launchchoice \"$prompt\" $sortpretty} handler_index
    if {[string length $handler_index] > 2} {
	puts "Probable GUI error:\n\t$handler_index"
	puts "Attempting to continue."
	return -1
    }
    if {$handler_index >=0} {
	return [lindex $sorted $handler_index]
    } else {
	return -1
    }
}

########################################
## match filetype by extension
########################################
proc matchTestOne {filename} {
    global extarray deftype
    
    if [debug] {puts "in matchTestOne"}
    foreach pattern [array names extarray] {
	if {[string match $pattern $filename]} {
	    return $extarray($pattern)
	}
    }
    return $deftype
}

########################################
## match filetype by parsing file cmd
########################################
proc matchTestTwo {filename} {
    global typepattern fileprog usefilecmd deftype

    if [debug] {puts "in matchTestTwo"}
    if {!$usefilecmd} {return}
    catch {eval exec $fileprog {$filename}} result
    set result [lindex [split $result] 0]
    if {[regexp $typepattern $result all type]} {
	return $type
    }
    return $deftype
}

########################################
## sort and return the given handlers
## returns two lists, one of names, one
## of descriptions
########################################
proc sortHandlers {hlist} {
    global handlers
    
    foreach h $hlist {
	if {[info exists handlers($h.pretty)]} {
	    lappend newhlist "\"$handlers($h.pretty)\" $h"
	}
    }
    if {[info exists newhlist]} {
	set newhlist [lsort -dictionary $newhlist]
    } else {return [list "" ""]}

    foreach pair $newhlist {
	lappend names [lindex $pair 1]
	lappend prettynames [lindex $pair 0]
    }
    return [list $names $prettynames]
}

########################################
## simple proc to return the parent
## directory of a file or simply the
## file if it's a directory
########################################
proc getDir {filename} {
    set filename [string trim $filename \"\{\} ]
    if {[file exists $filename]} {
	return [file dirname $filename]
    } else {return [pwd]}
}

########################################
## launch actual file handlers
########################################
proc handle {thehandler filenames} {
    global wait handlers URLtype files maparray
    
    if [debug] {puts "in handler"}
    ## make sure that filenames with embedded
    ## spaces and other nastines are quoted
    set oldfnames $filenames
    unset filenames
    foreach name $oldfnames {
	## warning!! non-general case! for both URLs
	## and a trap for anything calling itself netscape
	if {![string compare $files($name) $URLtype] \
		|| [regexp -nocase {.*netscape.*} $handlers($thehandler.cmd)]} {
	    lappend filenames "$name"
	} else {
	    lappend filenames \"$name\"
	}
    }
    unset oldfnames
    
    set cmdline $handlers($thehandler.cmd)
    if {!$wait} {set cmdline "$cmdline &"}
    if {$handlers($thehandler.many)} {
	set dir [getDir [lindex $filenames 0]]
	regsub -all {%s} $cmdline $filenames cmdline
	regsub -all {%d} $cmdline $dir cmdline
	#puts "cmdline-all: $cmdline"
	catch {eval eval exec $cmdline} errors
	#puts "manyerrors: $errors"
    } else {
	#puts "cmdline-one filenames: [llength $filenames]"
	foreach filename $filenames {
	    #puts "cmdline-one filename: $filename"
	    set dir [getDir $filename]
	    regsub -all {%s} $cmdline $filename newcmdline
	    regsub -all {%d} $newcmdline $dir newcmdline
	    #puts "cmdline-one: $newcmdline"
	    catch {eval exec $newcmdline} errors
	    #puts "singleerrors: $errors"
	}
    }
    #catch {eval exec $cmdline } errors
    
}
########################################
## convert to absolute pathnames
########################################
proc abspath {filename} {
    if {![regexp "^/.*" $filename]} {
	return "[pwd]/$filename"
    } else {
	return $filename
    }
}

################ BEGIN MAIN EXECUTION ################

########################################
## pull out any command line switches
########################################
set argcount 0
foreach arg $argv {
    if [debug] {puts "$argcount: $arg"}
    if {[regexp -- {--nowait} $arg]} {
	set wait 0
    } elseif {[regexp -- {--all} $arg]} {
	set all 1
    } elseif {[regexp -- {--type} $arg]} {
	set forcetype [lindex $argv [expr $argcount+1]]
	if [debug] {puts "found typeswitch with $forcetype"}
	if {![regexp $typepattern $forcetype]} {
	    puts "invalid type syntax: \"$forcetype\""
	    exit
	}
    } elseif {[regexp -- {--default} $arg]} {
	set usedefault 1
    } elseif {[regexp -- {--showtypes} $arg]} {
	set showtypes 1
    } elseif {[regexp -- {--compressed} $arg]} {
	set fileprog $zfileprog
    } elseif {[regexp -- {--help} $arg]} {
	puts "$usage"
	exit
    } elseif {[regexp -- {--version} $arg]} {
	puts "\tLauncher $version"
	puts "\t$launcherurl\n"
	exit
    } else {
	lappend filenames $arg
    }
    incr argcount
}

if {![info exists filenames]} {puts "no files specified"; puts $usage; exit}
if [debug] {puts "all: $all, wait: $wait"}

########################################
## make sure we can read the
## definitions file
########################################
if {[file readable $globalmapfile]} {
    lappend mapfds [open $globalmapfile r]
}
if {[file readable $usermapfile]} {
    lappend mapfds [open $usermapfile r]
}

if {![info exists mapfds]} {
    puts "can't read any $globalmapfile or $usermapfile"
    exit
}

########################################
## open and parse the definitions file
########################################
foreach fd $mapfds {
    while {[gets $fd line] >= 0} {
	## skip comments, newlines by ommision
	if {[regexp {^handler.+} $line]} {
	    set name [lindex $line 1]
	    set handlers($name.many) [lindex $line 2]
	    set handlers($name.pretty) [lindex $line 3]
	    set handlers($name.cmd) [lrange $line 4 end]
	} elseif {[regexp {^launcher.+} $line]} {
	    ## launcher-specific preferences
	    set directive [lindex $line 1]
	    set value [lindex $line 2]
	    if {![string compare "nowait" $directive]} {
		if {$value == 1} {set wait 0}
	    } elseif {![string compare "all" $directive]} {
		if {$value == 1} {set all 1}
	    } elseif {![string compare "default" $directive]} {
		if {$value == 1} {set usedefault 1}
	    }
	} elseif {[regexp {^map.+} $line]} {
	    ## type/handler mapping
	    set type [lindex $line 1]
	    set name [lrange $line 2 end]
	    if {![string compare $deftype $type]} {
		set defaulthandler $name
		#puts "found the default handler: $name"
	    } elseif {[regexp {[^/]+/\*} $type]} {
		lappend genericmap($type) $name
		#puts "found a generic: $type"
	    }
	    foreach item $name {
		lappend maparray($type) $item
	    }
	}
    }
    unset name
    unset type
}


########################################
## open and parse the mime.types files
########################################
if {[file readable $globalextfile]} {
    lappend extfds [open $globalextfile r]
}
if {[file readable $userextfile]} {
    lappend extfds [open $userextfile r]
}

if {[info exists extfds]} {
    foreach fd $extfds {
	while {[gets $fd line] >= 0} {
	    ## if we get a useful entry
	    if {[regexp {^\#.*} $line]} {continue}
	    if {[llength $line] > 1} {
		set exts [lrange $line 1 end]
		set type [lindex $line 0]
		## assign the type to each extension
		foreach ext $exts {
		    set extarray(*.$ext) $type
		    #puts "*.$ext, $type"
		}
	    }
	}
	close $fd
    }
}

########################################
## typecheck all the filenames
########################################
foreach filename $filenames {
    ## match directories, URLs, executables, filetypes
    ## URL's first because they don't exist in the filesystem
    ## directories second because they're executable, but
    ## aren't programs, binary programs next, then the rest
    ## The rule for binary programs is that they must be
    ## executable and have no extension - then they may be launched
    ## Convert to absolute pathnames while at it - messy inside if's.
    set type $deftype
    ## save the short filenames before we abspath 'em
    lappend origfilenames $filename
    if {[info exists forcetype]} {
	set type $forcetype
    }	elseif {[regexp {[a-z]+://.+} $filename]} {
	set type $URLtype
    } elseif {[file isdirectory $filename]} {
	set type $dirtype
	set filename [abspath $filename]
    } elseif {[file executable $filename] \
	    && ![string compare [file extension $filename] ""]} {
	set type $exetype
	set filename [abspath $filename]
    } else {
	## match using technique 1, 2, etc
	set type [matchTestTwo $filename]
	if {[string compare $type $deftype] == 0} {
	    set type [matchTestOne $filename]
	}
	set filename [abspath $filename]
    }
    if {![string compare $URLtype $type] || [file executable $filename] || [file readable $filename]} {
	lappend newfilenames $filename
	set files($filename) $type
	lappend havetypes($type) $filename
    }
}
if {[info exists newfilenames]} {
    set filenames $newfilenames
} else {
    puts "no valid files specified"
    exit
}

########################################
## If the showtypes option is set
## just return the filenames and their
## types in newline delimited records
## with colon&space separated fields
########################################
if {$showtypes} {
    foreach item $filenames shortone $origfilenames {
	puts "$shortone: $files($item)"
    }
    exit
}

########################################
## Now everything is mapped.
## If -all is set, launch by type,
## otherwise by file. The only exception
## is the executables - wait, no, they
## can be handled by an empty launcher
## If no handlers are defined then
## offer all of them.
## This could be streamlined even more.
########################################
if {$all} {
    foreach type [lsort -dictionary [array names havetypes]] {

	if [debug] {puts "trying to handle [array names files] together"}
	if {[info exists maparray($type)]} {
	    set thehandler $maparray($type)
	} else {
	    set longnamelist [array names handlers *.cmd]
	    foreach item $longnamelist {
		lappend thehandler [lindex [split $item .] 0]
	    }
	}
	if {![llength $thehandler]} {set thehandler [array names handlers]}
	## chop off the first (default) and then fall through
	if {$usedefault} {set thehandler [lindex $thehandler 0]}
	## query the user if necessary
	if {[llength $thehandler] > 1} {
	    ##puts "handlers: $thehandler"
	    if {[llength $havetypes($type)] > 1} {
		set prompt "$type files"
	    } else { set prompt [file tail $havetypes($type)] }
	    
	    set thehandler [queryUser $thehandler "$prompt"]
	}
	## do launch
	if {$thehandler != -1} {
	    #handle $thehandler [list $havetypes($type)]
	    #puts "all: $havetypes($type)"
	    handle $thehandler $havetypes($type)
	}
    }
} else {
    if [debug] {puts "trying to handle [array names files] individually"}
    foreach filename [lsort -dictionary [array names files]] {
	set type $files($filename)

	if {[info exists maparray($type)] && [llength $maparray($type)] > 0} {
	    set thehandler $maparray($type)
	} else {
	    set longnamelist [array names handlers *.cmd]
	    foreach item $longnamelist {
		lappend thehandler [lindex [split $item .] 0]
	    }
	    #puts "$thehandler"
	}
	## chop off the first (default) and then fall through
	if {$usedefault} {set thehandler [lindex $thehandler 0]}
	## query the user if necessary
	if {[llength $thehandler] > 1} {
	    set thehandler [queryUser $thehandler "[file tail $filename]"]
	}
	## set the handler or cancel
	if {$thehandler != -1} {
	    lappend tmpfilename $filename
	    #handle $thehandler [list $tmpfilename]
	    handle $thehandler $tmpfilename
	    unset tmpfilename
	}
    }
}

exit
