#!/usr/local/bin/wish -f
#
# tess - tar extraction simplification script
#
# Copyright 1994, Paul E Coad
# The author disclaims all warranties with regard to this software, including
# all implied warranties of merchantability and fitness.  In no event
# shall the authorbe liable for any special, indirect or consequential
# damages or any damages whatsoever resulting from loss of use, data or
# profits, whether in an action of contract, negligence or other
# tortuous action, arising out of or in connection with the use or
# performance of this software.
# 
# This package is being released under the terms of Larry Wall's
# "Artistic licence".

# tess - 1.4 94/01/26 00:12:11

#
# This script provides a frontend to the tar command.  Right now
# it provides a method for extracting files from an archive.

set auto_path "$tk_library $auto_path"
wm title . "tess"

#---------------------------------------------------------------
# default device name (floppy drive 0 on my machine)
# Set default_device for the preferred device if tess is
# called with an argument, it will over-ride the default
# more than one argument and the args will be ignored.
#
set default_device "/dev/fd0"
if {$argc == 1} { set default_device $argv }
#---------------------------------------------------------------

#---------------------------------------------------------------
# defaults for Options menu
# Set each option default as follows: set the default value
# to 1 for on and 0 for off.
set default_owner_perms 1
set default_update_mod_time 0
#---------------------------------------------------------------

#---------------------------------------------------------------
# default temporary file name
# Set the tarlist for the preferred file name
set tarlist "/usr/tmp/tarlist"
#---------------------------------------------------------------

#---------------------------------------------------------------
# set the following to 1 if you have a non-standard installation 
# of gzip.
set have_gzcat 0
#---------------------------------------------------------------

#----------------------------------------------------------------
# Create the main window, consisting of a menu bar a scrolling 
# list and an entry for the device or file from which to extract.
#----------------------------------------------------------------
# create a frame for the menu buttons
frame .menu -relief raised -borderwidth 1

# create a frame for the device entry and label
frame .i

# create the device entry and label
entry .i.device -relief sunken -width 40 
label .i.label -text Device:
.i.device insert 0 $default_device

# create the scrolling list
scrollbar .sbar -relief sunken -command ".slist yview"
listbox .slist -yscroll ".sbar set" -relief sunken -setgrid 1

# pack the components of the window puting the menubar at the top,
# the device entry and label below that and the scrolling list 
# below those.
pack .menu -side top -fill x
pack .i -side top -fill x
pack .i.label -side left -anchor nw -fill none
pack .i.device -side left -anchor ne -fill x -expand yes
pack .sbar -side right -fill y 
pack .slist -side left -expand yes -fill both 

# set the font for the list to a fixed spacing font
.slist configure -font -adobe-courier-bold-r-normal--*-120-*-*-*-*-*-*

# set the entry to read the archive on Return in the entry
bind .i.device <Return> "tess_read_arc .i.device"

#--------------------------------------------------------------
# The code below creates all the menus, which invoke procedures
# to list and extract files from a tar file or device
#--------------------------------------------------------------
menubutton .menu.button -text "List/Extract" -menu .menu.button.m \
    -underline 0
menu .menu.button.m
.menu.button.m add command -label "List Archive" \
			   -command "tess_read_arc .i.device" -underline 0
.menu.button.m add command -label "Extract All" \
			   -command "tess_extract_all .i.device" -underline 8
.menu.button.m add command -label "Extract Selected" \
			   -command "tess_ext_some .i.device" -underline 0
.menu.button.m add separator
.menu.button.m add command -label "About" -underline 1 -command "tess_about .a"
.menu.button.m add command -label "Quit" -command "destroy ." -underline 0

menubutton .menu.butops -text "Options" -menu .menu.butops.o -underline 0
menu .menu.butops.o

set own $default_owner_perms 
set modtime $default_update_mod_time 

.menu.butops.o add check -label "Owner Perms" -variable own
.menu.butops.o add check -label "Update Mod Time" -variable modtime

pack .menu.button .menu.butops -side left

# Set up for keyboard-based menu traversal

bind . <Any-FocusIn> {
    if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
	focus .menu
    }
}
tk_menuBar .menu .menu.button .menu.butops

#-------------------------------------------------------
# procedures for listing and extracting the contents of
# archives
#-------------------------------------------------------

#-----------------------------------------------------------
# tess_read_arc - get listing of the contents of the archive
#
# Args: w	the name of the device entry
#-----------------------------------------------------------
proc tess_read_arc {w} {
global tarlist have_gzcat
set dev [$w get]
if {[file exists $dev]} {
	# extract a list of the contents into a file
	set compcode 0
	set retcode 0
	set dotZ [is_dotZ $dev]
	set dotgz [is_dotgz $dev]
	if {!$dotZ && !$dotgz} {
		# the device is not compressed
		set retcode [eval {
			catch {exec tar tvf $dev > $tarlist } compcode}]
	} else {
		if {$dotgz && $have_gzcat} {
			set ccat gzcat} else {set ccat zcat}
		# the device is a compressed tar file
		set retcode [catch {exec $ccat $dev | tar tvf - > \
			$tarlist} compcode]
	}
	if {$retcode != 0} {
		# open an error dialog with error message
		tessdlg $w.d "tess error" \
			[concat -text [format {{%s}} $compcode] \
			-aspect 250] [format {{%s}} [concat OK {}]] 
	} 

	# clear the list and open the output file
	.slist delete 0 end
	set listfile 0
	set listfile [open $tarlist]

	if {$listfile != 0} {
		# fill the list with the contents of the file
		set i 0
		while {[gets $listfile line] >= 0} {
			.slist insert $i $line
			incr i
		}
		close $listfile
		exec rm $tarlist
	} else {
		tessdlg $w.d "tess error" \
			{-text {The temporary file could not be found.} \
			-aspect 250} {OK {}}
	}
} else {
# the device was not found
tessdlg $w.d "tess error" \
	{-text {The requested Device was not found.} -aspect 250} {OK {}}
}}

#-----------------------------------------------------------------------
# tess_get_format - gets the format of the tar options
#
# Args:	baseOps		the base options to be added to the menu options
#-----------------------------------------------------------------------
proc tess_get_format baseOps {
global own modtime
if {$own == 1} { set ow o } else { set ow "" }
if {$modtime == 1} { set mt m } else { set mt "" }
set opts [format "%s%s%s" $ow $mt $baseOps]
return $opts
}

#-------------------------------------------------------
# tess_extract_all - extract all files from the archive
#
# Args: w	the name of the device entry
#-------------------------------------------------------
proc tess_extract_all w {
global own modtime have_gzcat tarlist
set dev [$w get]
if {[file exists $dev]} {
	# set the extraction options
	set opts [tess_get_format xvf]
	set compcode 0
	set dotZ [is_dotZ $dev]
	set dotgz [is_dotgz $dev]
	if {!$dotZ && !$dotgz} {
		set retcode [eval {
			catch {exec tar $opts $dev > $tarlist} compcode}]
	} else {	
		if {$dotgz && $have_gzcat} {
			set ccat gzcat} else {set ccat zcat}
		# the device is a compressed tar file
		set retcode [eval {catch {exec $ccat $dev | tar $opts - > \
				$tarlist} compcode}]
	}
	if {$retcode != 0} {
		# open an error dialog with error message
		tessdlg $w.f "tess error" \
			[concat -text [format {{%s}} $compcode] \
			-aspect 250] [format {{%s}} [concat OK {}]] 
		set fsize [file size $tarlist]
		if {$fsize > 0} {
			# open a dialog indicating that atleast some of
			# the files were read
			tess_list_files $w
		}
	} else { 
		# open dialog indicating that the files were read
		tess_list_files $w
	}
} else {
# the device was not found
tessdlg $w.d "tess error" \
	{-text {The requested Device was not found.} -aspect 250} {OK {}}
}
}

#-------------------------------------------------------
# tess_ext_some - extract the selected files from the archive
#
# Args: w	the name of the device entry
#-------------------------------------------------------
proc tess_ext_some w {
global own modtime tarlist have_gzcat
set dev [$w get]
if {[file exists $dev]} {
	# find the selected items in the list
	set selected [.slist curselection]
	if {[llength $selected] != 0} {
		set flist ""
		foreach i $selected {
			set tlist [.slist get $i]
			#set flist [concat $flist [lindex $tlist 6]]
			set tlistl [expr [llength $tlist] -1]
			set flist [concat $flist [lindex $tlist $tlistl]]
		}
		# set the extraction options and prepare for the read
		set opts [tess_get_format xvf]
		set compcode 0
		set dotZ [is_dotZ $dev]
		set dotgz [is_dotgz $dev]
		if {!$dotZ && !$dotgz} {
			set retcode [catch {eval exec tar $opts $dev $flist > \
					$tarlist} compcode]
		} else {
			if {$dotgz && $have_gzcat} {
				set ccat gzcat} else {set ccat zcat}
			# the device is a compressed tar file
			set retcode [catch {
				eval exec $ccat $dev | tar $opts - $flist > \
					$tarlist} compcode]
		}
		if {$retcode != 0} {
			# open an error dialog with error message
			tessdlg $w.e "tess error" \
				[concat -text [format {{%s}} $compcode] \
				-aspect 250] [format {{%s}} [concat OK {}]] 
			set fsize [file size $tarlist]
			if {$fsize > 0} {
				# open a dialog indicating that atleast some of
				# the files were read
				tess_list_files $w
			}
		} else { 
			# open dialog indicating that the files were read
			tess_list_files $w
		}
	} else {
		# open error dialog box - no files were selected
		tessdlg $w.d "tess error" \
			{-text {No files were selected.} -aspect 250} {OK {}}
	}
} else {
# the device was not found
tessdlg $w.d "tess error" \
	{-text {The requested Device  ar not found.} -aspect 250} {OK {}}
}
}

#---------------------------------------------------------------------
# tess_list_files lists the extracted files in a scrolling list in a 
#                 window.
#
# Args: w	Name to use for new top-level window.
#---------------------------------------------------------------------
proc tess_list_files {w} {
global tarlist
catch {destroy $w.d}
toplevel $w.d
wm title $w.d "tess - extracted files"
wm geometry $w.d +300+300

frame $w.d.frm
scrollbar $w.d.frm.sbar -relief sunken -command "$w.d.frm.slist yview"
listbox $w.d.frm.slist -yscroll "$w.d.frm.sbar set" -relief sunken -setgrid 1 
button $w.d.frm.butt -text "Done" -command "destroy $w.d" 

# clear out any crap that might be in the list
$w.d.frm.slist delete 0 end

# open the temporary file to read the files extracted
set fp [open $tarlist]

set j 0
# get each line from the file, strip the leading x and place in the list
while {[gets $fp line] >= 0} {
	$w.d.frm.slist insert $j [string trimleft $line x]
	incr j
}
pack $w.d.frm -fill both -expand yes
pack $w.d.frm.butt -side bottom -fill x 
pack $w.d.frm.slist -side left -fill both -expand yes 
pack $w.d.frm.sbar -side right -fill y 

# set the font for the list to a fixed spacing font
$w.d.frm.slist configure -font -adobe-courier-bold-r-normal--*-120-*-*-*-*-*-*
close $fp
exec rm $tarlist
}

#---------------------------------------------------------------------
# tess_about shows the legal stuff in a window
#
# Args: w	Name to use for new top-level window.
#---------------------------------------------------------------------
proc tess_about w {
catch {destroy $w}
toplevel $w -class Dialog

# set up window
wm title $w "tess - about"
wm iconname $w "tess - about"
wm geometry $w +300+300

# create frames for messages and done button
frame $w.frame_top -relief raised -border 1
frame $w.frame_bot -relief raised -border 1
pack $w.frame_top -side top -fill both
pack $w.frame_bot -side bottom -fill both

# create messages in top frame
message $w.frame_top.title -justify center -width 300 \
  -text "tess - tar extraction simplification script"
message $w.frame_top.copyright -justify center -width 300 -text \
	"Copyright 1994, Paul E Coad"
message $w.frame_top.disclaim -justify center -width 320 -text "The author disclaims all warranties with regard to this software, including all implied warranties of merchantability and fitness.  In no event shall the authorbe liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortuous action, arising out of or in connection with the use or performance of this software."
message $w.frame_top.release -justify center -width 300 -text "This package is being released under the terms of Larry Wall's Artistic licence."

# create button in bottom frame 
button $w.frame_bot.done -text "Done" -command "destroy $w" 

# pack them up and put them out
pack $w.frame_top.title -side top -fill both -pady 8
pack $w.frame_top.copyright -side top 
pack $w.frame_top.disclaim -side top 
pack $w.frame_top.release -side top -pady 3
pack $w.frame_bot.done -side bottom -fill both

}

#---------------------------------------------------------------------
# tessdlg Create a dialog box with a message and any number of 
#	  buttons at the bottom.
#
# Arguments:
#    w -        Name to use for new top-level window.
#    wTitle	Title of the window
#    msgArgs -  List of arguments to use when creating the message of the
#               dialog box (e.g. text, justifcation, etc.)
#    list -     A two-element list that describes one of the buttons that
#               will appear at the bottom of the dialog.  The first element
#               gives the text to be displayed in the button and the second
#               gives the command to be invoked when the button is invoked.
#
# Note: borrowed and modified mkDialog.tcl from tk distribution demos
#       due credit should be given to Mr. John Ousterhout.
#---------------------------------------------------------------------
proc tessdlg {w wTitle msgArgs args} {
    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $wTitle
    wm iconname $w $wTitle
    wm geometry $w +300+300
    # Create two frames in the main window. The top frame will hold the
    # message and the bottom one will hold the buttons.  Arrange them
    # one above the other, with any extra vertical space split between
    # them.

    frame $w.top -relief raised -border 1
    frame $w.bot -relief raised -border 1
    pack $w.top $w.bot -side top -fill both -expand yes
    # Create the message widget and arrange for it to be centered in the
    # top frame.

    eval message $w.top.msg -justify center \
            -font -Adobe-times-medium-r-normal--*-180* $msgArgs
    pack $w.top.msg -side top -expand yes -padx 3 -pady 3

    # Create as many buttons as needed and arrange them from left to right
    # in the bottom frame.  Embed the left button in an additional sunken
    # frame to indicate that it is the default button, and arrange for that
    # button to be invoked as the default action for clicks and returns in
    # the dialog.

    if {[llength $args] > 0} {
        set arg [lindex $args 0]
        frame $w.bot.0 -relief sunken -border 1
        pack $w.bot.0 -side left -expand yes -padx 10 -pady 10
        button $w.bot.0.button -text [lindex $arg 0] \
                -command "[lindex $arg 1]; destroy $w"
        pack $w.bot.0.button -expand yes -padx 6 -pady 6
        bind $w <Return> "[lindex $arg 1]; destroy $w"
        focus $w
        set i 1
        foreach arg [lrange $args 1 end] {
            button $w.bot.$i -text [lindex $arg 0] \
                    -command "[lindex $arg 1]; destroy $w"
            pack $w.bot.$i -side left -expand yes -padx 10
            set i [expr $i+1]
        }
    }
    bind $w <Any-Enter> [list focus $w]
    focus $w
}

#---------------------------------------------------------------------
# is_dotZ determines if a string ends in ".Z" and is therefore 
#	  assumed to be compressed.
#
# Args: str	The string to examine
#---------------------------------------------------------------------
proc is_dotZ str {
set last_dot_index [string last . $str]
set Z_index [string last Z $str]
set str_len [string length $str]
if { $Z_index == -1 || \
     [expr ($last_dot_index + 1) != $Z_index] || \
     [expr ($Z_index + 1) != $str_len] } { 
	set compressed 0
} else {
	set compressed 1
}
return $compressed
}

#---------------------------------------------------------------------
# is_dotgz determines if a string ends in ".gz" and is therefore 
#	  assumed to be zipped with the GNU zip program.
#
# Args: str	The string to examine
#---------------------------------------------------------------------
proc is_dotgz str {
set last_dot_index [string last . $str]
set gz_index [string last gz $str]
set str_len [string length $str]
if { $gz_index == -1 || \
     [expr ($last_dot_index + 1) != $gz_index] || \
     [expr ($gz_index + 2) != $str_len] } { 
	set gzipped 0
} else {
	set gzipped 1
}
return $gzipped
}
