#! /bin/sh
#
# Uncomment this line if you know where your wish lives
#
# exec wish8.2 "$0" ${1+"$@"}
#
# Try to find a suitable tclsh8.x
# \
tcl="`which wish8.4`" ; if test -f "$tcl" ; then exec $tcl "$0" ${1+"$@"} ; fi
# \
tcl="`which wish8.3`" ; if test -f "$tcl" ; then exec $tcl "$0" ${1+"$@"} ; fi
# \
tcl="`which wish8.2`" ; if test -f "$tcl" ; then exec $tcl "$0" ${1+"$@"} ; fi
# \
tcl="`which wish8.1`" ; if test -f "$tcl" ; then exec $tcl "$0" ${1+"$@"} ; fi
# \
tcl="`which wish8.0`" ; if test -f "$tcl" ; then exec $tcl "$0" ${1+"$@"} ; fi
# \
tcl="`which wish`" ; if test -f "$tcl" ; then exec $tcl "$0" ${1+"$@"} ; fi
# \
echo "oops, could not find wish, please edit $0" ; exit 1

#
# ----------------------------------------------------------------------
# Player - play any files, only one at a time
# ----------------------------------------------------------------------
#

#
# ----------------------------------------------------------------------
# Handle data from .mime.types and .mailcap
#
# $MimeTypes(extension)
#	MIME Type for this kind of file
# $Mailcap(pattern)
#	What to do for files of these types
# $Mcflags(pattern)
#	Mailcap flags
# $MagicTypes(regexp)
#	Regexp to match the output of file
# ----------------------------------------------------------------------
#

proc LoadMimeTypes { {filename ""} } {
    global MimeTypes env

    if { $filename == "" } {
	set filename "$env(HOME)/.mime.types"
    }

    set file [open "$filename"]

    while {![eof $file]} {
	if [catch {set oneline [string trim [gets $file]]}] {
	    break
	}
	if {[string index $oneline 0] == "#"} {
	    continue
	}
	if {[llength $oneline] == 0} {
	    continue
	}
	set type [string tolower [lindex $oneline 0]]
	foreach ext [lrange $oneline 1 end] {
	    set MimeTypes([string tolower $ext]) $type
	}
    }
    close $file
}

proc LoadMailcap { {filename ""} } {
    global Mailcap Mcflags env

    if { $filename == "" } {
	set filename "$env(HOME)/.mailcap"
    }

    set file [open "$filename"]

    set fulline ""

    while {![eof $file]} {
	if [catch {set line [string trim [gets $file]]}] {
	    break
	}
	if {[string index $line 0] == "#"} {
	    continue
	}
	if {[llength $line] == 0} {
	    continue
	}
	if {[string index $line [expr [string length $line] - 1]] == "\\" } {
	    append fulline [string range $line 0 \
		    [expr [string length $line] - 1]] " "
	    continue
	} else {
	    append fulline $line " "
	}

	set thelist [split $fulline ";"]
	set fulline ""

	if {[set type [string tolower [string trim [lindex $thelist 0]]]] == ""} {
	    continue
	}
	set Mailcap($type) [string trim [lindex $thelist 1]]
	set Mcflags($type) [string trim [lindex $thelist 2]]
    }
    close $file
}

proc LoadMagicTypes { {filename ""} } {
    global MagicTypes env

    if { $filename == "" } {
	set filename "$env(HOME)/.magic.types"
    }

    set file [open "$filename"]

    while {![eof $file]} {
	if [catch {set oneline [string trim [gets $file]]}] {
	    break
	}
	if {[string index $oneline 0] == "#"} {
	    continue
	}
	if {[llength $oneline] == 0} {
	    continue
	}
	set type [string tolower [lindex $oneline 0]]
	foreach ext [lrange $oneline 1 end] {
	    set MagicTypes([string tolower $ext]) $type
	}
    }
    close $file
}


#
# Find the Mime type for a particular file
#

proc GetMagicType { file } {
    global MagicTypes

    if {[catch {
	set out [exec file "$file"]
	set type [string trim [string range $out \
		[expr [string first : $out] + 1] end]]
    }]} {
	return
    }

    foreach exp [array names MagicTypes] {
	if {[catch {
	    set res [regexp -nocase -- $exp $type]
	}]} {
	    set res 0
	}
	if {$res} {
	    return $MagicTypes($exp)
	}
    }

    return
}

proc GetMimeType { file } {
    global MimeTypes

    set type [GetMagicType $file]

    if {$type != ""} {
	return $type
    }

    set extension [string tolower [string range [file extension $file] 1 end]]

    if {$extension != ""} {
	if {![catch {set type $MimeTypes($extension)}]} {
	    return $type
	}
    }

    return
}

#
# find the Mailcap entry for a particular mime type
#

proc GetMailcapEntry { mtype } {
    global Mailcap Mcflags

    set foundgeneric ""

    if {![catch {array startsearch Mailcap} searchID]} {
	while {[set pattern [array nextelement Mailcap $searchID]] != ""} {
	    if {$pattern == ""} {
		continue
	    }
	    if [string match $pattern $mtype] {
		if {[string first "*" $pattern] != -1} {
		    # generic pattern, keep on looking for a better match
		    set foundgeneric $pattern
		} else {
		    array donesearch Mailcap $searchID
		    return $pattern
		}
	    }
	}
	array donesearch Mailcap $searchID
    }
    return $foundgeneric
}

#
# ----------------------------------------------------------------------
#

#
# We start a file by creating a pipe with the open command. We
# set ar_running($file) to its pid and add a fileevent on that pipe
# to the following function. If the pipe becomes readable, read
# the output and attach it to the ar_widget($file) text widget,
# creating it if it doesn't exist.
# If we get an eof on that pipe, the child has exited, and we can
# remove ar_running($file).
# the command that was executed is in ar_command($file)
#

proc HandleFileEvent { file } {
    global ar_running ar_widget ar_command

    if [catch {set pid $ar_running($file)}] {
	catch { fileevent $file readable }
	return
    }

    if {![eof $file]} {
	#
	# try to read something
	#
	gets $file data
	if [eof $file] {
	    return
	}
    }

    if [eof $file] {
	if {![catch {set w $ar_widget($file)}]} {
	    if [catch {set title "Output from $ar_command($file) (finished)"}] {
		set title "Output from Oops (finished)"
	    }
	    destroy  $w.bot.kill
	    wm title $w $title
	}
	catch { unset ar_running($file) }
	catch { unset ar_command($file) }
	catch { unset ar_killed($file) }
	catch { unset ar_widget($file) }
	fileevent $file readable
	catch { close $file }
	return
    }

    #
    # there is data
    #
    if [catch {set w $ar_widget($file)}] {
	#
	# ... but no text widget yet
	#
	set w ".msg$file[clock seconds]"
	toplevel $w

	frame $w.top
	frame $w.bot

	text $w.top.text -relief raised -bd 2 -wrap none \
		-xscrollcommand "$w.top.sbx set" \
		-yscrollcommand "$w.top.sby set"
	scrollbar $w.top.sbx -orient horizontal \
		-command "$w.top.text xview"
	scrollbar $w.top.sby -orient vertical \
		-command "$w.top.text yview"

	pack $w.top.sbx -side bottom -fill x
	pack $w.top.sby -side right -fill y
	pack $w.top.text -fill both -expand 1

	button $w.bot.kill -text "Kill" -command "KillProc $file"
	button $w.bot.done -text "Close" -command "destroy $w"
	pack $w.bot.kill -side left -padx 4 -pady 4
	pack $w.bot.done -side right -padx 4 -pady 4

	pack $w.top -side top -fill both -expand 1
	pack $w.bot -side bottom

	if [catch {set title "Output from $ar_command($file) (ar_running)"}] {
	    set title "Output from Oops (running)"
	}

	wm title $w $title

	set ar_widget($file) $w
    }

    #
    # Add the available text
    #

    $w.top.text insert end "$data\n"
    while {![fblocked $file] && ![eof $file]} {
	if [catch {gets $file data}] {
	    break
	}
	$w.top.text insert end "$data\n"
    }
}

#
# Execute a file according to its Mailcap entry. Update our structures
#

proc ExecuteFile { file } {
    global Mailcap Mcflags ar_running ar_command

    if {[set mtype [GetMimeType $file]] == ""} {
	error "Cannot find Mime type for $file"
    }

    if {[set mcap [GetMailcapEntry $mtype]] == ""} {
	error "Cannot find Mailcap entry for $mtype"
    }

    if {[set action $Mailcap($mcap)] == ""} {
	error "No action associated with $mcap"
    }

    if {[string first "%s" $action] == -1} {
	set pipestdin 1
    } else {
	set pipestdin 0
    }

    regsub -all -nocase "%t" $action $mtype action
    regsub -all -nocase "%s" $action \{$file\} action
    regsub -all -nocase "%{.*}" $action "" action
    regsub -all -nocase "\"\"" $action "%" action

    #
    # make up a nice command name
    #

    set thecom "[file tail [lindex $action 0]] $file"

    #
    # check "needsterminal"
    #

    catch {
	if {[string first "needsterminal" \
		[string tolower $Mcflags($mcap)]] != -1} {
	    set action "xterm -e $action"
	}
    }

    #
    # fire it up
    #

    if {$pipestdin} {
	set file [open "|$action < $file"]
    } else {
	set file [open "|$action < /dev/null"]
    }

    set ar_running($file) [lindex [pid $file] 0]
    set ar_command($file) $thecom
    fileevent $file readable "HandleFileEvent $file"

    return $file
}

#
# Execute a command
#

proc ExecuteCommand { com { needsterminal 0 } } {
    global ar_running ar_command

    if [file exists $com] {
	if [catch {ExecuteFile $com} fileID] {
	    if [file executable $com] {
		if {$needsterminal} {
		    set fileID [open "|xterm -e $com"]
		} else {
		    set fileID [open "|$com < /dev/null"]
		}
	    } else {
		error "no mailcap entry for $com and not executable"
	    }
	}
    } else {
	#
	# try to execute it anyway
	#
	if {$needsterminal} {
	    set fileID [open "|xterm -e $com"]
	} else {
	    set fileID [open "|$com < /dev/null"]
	}
	set ar_running($fileID) [lindex [pid $fileID] 0]
	set ar_command($fileID) [lindex $com 0]
	fileevent $fileID readable "HandleFileEvent $fileID"

	return $fileID
    }
}

#
# Kill the given process. On first call, set ar_killed($file) to 1, on
# second try, fire a SIGKILL
#

proc KillProc { file } {
    global ar_killed ar_running

    if [catch {set pid $ar_running($file)}] {
	return
    }
    if [catch {set ar_killed($file)}] {
	set ar_killed($file) 1
	eval exec kill [pid $file]
    } else {
	eval exec kill -9 [pid $file]
    }
}

# ----------------------------------------------------------------------

set initialdir [pwd]

proc ProcFinished { name1 name2 op } {
    destroy .top.$name2
}

proc Open {} {
    global initialdir ar_running ar_command

    set file [tk_getOpenFile -initialdir $initialdir]

    if {$file == ""} {
	return
    }

    set initialdir [file dirname $file]
    set fileno [ExecuteFile $file]

    button .top.$fileno -text $ar_command($fileno) -command "KillProc $fileno"
    pack .top.$fileno -side bottom -fill x
    trace variable ar_running($fileno) u ProcFinished
}

proc Sync {} {
    LoadMimeTypes
    LoadMagicTypes
    LoadMailcap
}

proc Quit {} {
    global ar_running

    foreach procs [array names ar_running] {
	KillProc $procs
    }
    destroy .
}

frame .top

frame .bot
button .bot.open -text "Open" -command "Open"
button .bot.sync -text "Sync" -command "Sync"
button .bot.quit -text "Quit" -command "Quit"
pack .bot.open -side left -fill x -expand true
pack .bot.sync -side left -fill x -expand true
pack .bot.quit -side right -fill x -expand true

frame .com -relief raised -bd 2
label .com.label -text "Command:" -bd 1
entry .com.entry -relief sunken -textvariable executeme
pack .com.label -side left -padx 4 -pady 4
pack .com.entry -side right -padx 4 -pady 4 -fill x -expand true

bind .com.entry <Return> {
    if {$executeme != ""} {
	ExecuteCommand $executeme
    }
}

pack .top -side top -fill x
pack .bot -side bottom -fill x
pack .com -side bottom -fill x

wm title . "Player"

LoadMimeTypes
LoadMagicTypes
LoadMailcap

#
# go into event loop
#