#!/usr/local/bin/wish
##
## First attempt at fully-functional archiving GUI
## for unix/gzip/tar/bzip2/unzip
##
## Ethan Gold <etgold@cs.columbia.edu>
## October 1998
##

####################################################################
## Global configuration variables
####################################################################
set name "tkArchive"
set version 0.1
set author "Ethan Gold <etgold@cs.columbia.edu>"
set project "A real file archiving interface for Un*x"
set releaseDate "when the cows come home"

set X 500
set Y 300

## window flags
set aboutWinFlag 0
set debug 1

## some large text variables (static)
set aboutText "$name version $version, \
	written by $author. $project.\
	Released $releaseDate."
set status1 "status bar..."

## default configuration file
set userconfig $env(HOME)/.tkArchiverc

## default library directory
#set libdir /usr/local/lib/tkArchive
set libdir $env(HOME)/code/tcl-scripts/tkArchive

## default extraction directory
set extractdir $env(PWD)

## main data arrays, for reference.
set archives(dummy) dum
unset archives(dummy)
set archnums(dummy) dum
unset archnums(dummy)

set archtypes(dummy) dum
unset archtypes(dummy)

set archivecount 0

set errnum 0
####################################################################
## Function definitions here
####################################################################

##############################
## return the debug variable
##############################
proc debug {} {
    global debug
    return $debug
}

##############################
## declaration of existance
## function for modules
##############################
proc register {name} {
    global archtypes
    set archtypes($name) 1
}


##############################
## error message handler
##############################
proc doError {message} {
    global errnum
    set w .errorWin_$errnum
    toplevel $w -class Dialog
    message $w.msg -text $message -width 300
    button $w.done -text "Close" -command "destroy $w"
    pack $w.msg
    pack $w.done
    incr errnum
}

##############################
## parse commandline
##############################
proc cmdline {argv} {
    foreach file $argv {
	if {[regexp "/.*" $file]} {
	    addnewoldfile $file
	} else {
	    addnewoldfile [pwd]/$file
	}
    }
}

##############################
## choose an archive from the filesystem
##############################
proc getoldfile {selected} {
    addnewoldfile "[pwd]/$selected"
}

##############################
## add a file to the current list
##############################
proc addnewoldfile {newoldfile} {
    global archtypes archnums archivecount archives

    set filetype [file type $newoldfile]
    if {[string compare $filetype "file"] \
	&& [string compare $filetype "link"]} {
	doError "$newoldfile is not a regular file. \
		It can't be an archive."
	return
    }
    set type [matchtype_desc $newoldfile]
    
    if {$type == 0} {
	doError "$newoldfile is not of a recognized archive type"
	return	
    }
    set name [file tail $newoldfile]
    set archives($newoldfile.name) $name
    set archives($newoldfile.type) $type
    set size "[expr [file size $newoldfile]/1000]k"
    set archives($newoldfile.size) $size
    set archnums($archivecount) $newoldfile
    incr archivecount
    redisplay
    #.listframe.archives insert end "$name"
    #.listframe.archivetypes insert end "$type"
    #.listframe.archivesizes insert end "$size"
}

##############################
## match typenames from plugins
##############################    
proc matchtype_desc {filename} {
    global archtypes
    ## check against plugins
    ## otherwise
    foreach typename [array names archtypes] {
	if {[$typename.matchtype $filename]} {
	    set type [$typename.typedesc]
	    return $type
	    break
	}
    }
    return 0
}

proc matchtype {filename} {
    global archtypes
    ## check against plugins, return typename
    ## otherwise, 0
    foreach typename [array names archtypes] {
	if {[$typename.matchtype $filename]} {
	    return $typename
	    break
	}
    }
    return 0
}


##############################
## viewContents
##############################
proc viewContents {} {
    global archnums archives status1

    set index [.listframe.archives curselection]
    if {![string compare $index ""]} {return}
    set filename $archnums([.listframe.archives curselection])
    if {[info exists archives($filename.name)]} {

	## don't bother if it's already up
	global contentsflag$index
	if {[info exists contentsflag$index]} {return}
	set contentsflag$index 1
	set w ".contents$index"	
	set status1 "listing contents of $filename..."
	update
	
	set type [matchtype $filename]
	set contents [$type.listcmd $filename]

	## create the widgets
	toplevel $w
	wm title $w "View Archive"
	label $w.label -text "Contents of [file tail $filename]" \
		-relief groove
	frame $w.listframe
	listbox $w.listframe.contents -exportselection 0  -background white \
		-selectmode extended -width 35 -height 15 \
		-yscrollcommand "$w.listframe.scrolly set" \
		-xscrollcommand "$w.scrollx set"
	scrollbar $w.listframe.scrolly -width 12 \
		-command "$w.listframe.contents yview"
	scrollbar $w.scrollx -width 12 -orient horizontal \
		-command "$w.listframe.contents xview" \

	button $w.extract -text "Extract" -default active \
		-command "extractSubset $filename $type $w.listframe.contents"
	button $w.close -text "Close" \
		-command "destroy $w; unset contentsflag$index"
	
	## fill the listbox
	foreach item $contents {$w.listframe.contents insert end $item}

	## pack the window
	pack $w.label -side top -fill x
	pack $w.listframe.contents -side left -anchor n -fill both -expand 1
	pack $w.listframe.scrolly -side right -anchor n -fill y
	pack $w.listframe -side top -fill both -expand 1
	pack $w.scrollx -side top -anchor w -fill x -padx 4
	pack $w.extract -side top -expand 0
	pack $w.close -side top -expand 0

	## bind doubleclick and others in listbox
	bind $w.listframe.contents <Double-1> "$w.extract invoke"
	bind $w.listframe.contents <Return> "$w.extract invoke"
	bind $w.listframe.contents <Control-c> "$w.close invoke"

	set status1 "ready."
	update
    }
}

##############################
## extract an entire archive
##############################
proc extract {} {
    global extractdir archnums status1
    set extractdir ""
    set index [.listframe.archives curselection]
    if {[llength $index] == 0} {return}
    set filename $archnums($index)
    set type [matchtype $filename]
    fileselect setExtractDir "Select Destination Directory:"
    vwait extractdir
    set retval [$type.extractcmd $filename $extractdir ""]
    if {$retval == 0} {
	set status1 "Extracted $filename."
    } else {
	set status1 "Error extracting $filename."
    }
    update
}

##############################
## extract a subset of files
## from a listbox selection
##############################
proc extractSubset {filename type w} {
    global extractdir
    set extractdir ""
    set indices [$w curselection]
    if {[llength $indices] == 0} {return}
    foreach index $indices { lappend files [$w get $index] }
    fileselect setExtractDir "Select Destination Directory:"
    ## wait until we've selected something. if we
    vwait extractdir
    if {[debug]} {puts "finished vwait"}
    ## this doesn't work right
    if {[string compare $extractdir ""] == 0} {return}
    $type.extractcmd $filename $extractdir $files
}

##############################
## compress a new archive
##############################
proc compress {} {
    global extractdir archnums status1
    set extractdir ""
    set index [.listframe.archives curselection]
    if {[llength $index] == 0} {return}
    set filename $archnums($index)
    set type [matchtype $filename]

    set status1 "compression not yet supported"
}

##############################
## append files to an archive
##############################
proc append {} {
    global extractdir archnums status1
    set extractdir ""
    set index [.listframe.archives curselection]
    if {[llength $index] == 0} {return}
    set filename $archnums($index)
    set type [matchtype $filename]

    set status1 "appending not yet supported"
}

##############################
## create a new archive
##############################
proc newArchive {} {
    set status1 "archive creation not yet supported"
}

##############################
## close an archive
##############################
proc closeArchive {} {
    global archives archnums archivecount
    ## we don't support appending or creating yet
    ## so we don't have to worry about saving changes
    set extractdir ""
    set index [.listframe.archives curselection]
    if {[llength $index] == 0} {return}
    set filename $archnums($index)
    
    ## clear out references to the archive
    ## in the main data structures
    foreach entry [array names archives] {
	if {[regexp "^$filename.*" $entry]} {
	    if {[debug]} {puts "clearing archives($entry)"}
	    unset archives($entry)
	}
    }
    unset archnums($index)
    foreach otherindex [lsort -integer [array names archnums]] {
	if {[expr $otherindex > $index]} {
	    if {[debug]} {puts "sliding $otherindex down a slot"}
	    set archnums([expr $otherindex-1]) $archnums($otherindex)
	    unset archnums($otherindex)
	}
    }
    set archivecount [expr $archivecount - 1]
    ## remove the entry from the main window
    redisplay
}

##############################
## set display changes to the
## main archive listing window
##############################
proc redisplay {} {
    global archives archnums
    ## we could also alphabetize this, but we'll stick
    ## with added order for now.
    .listframe.archives delete 0 end
    .listframe.archivetypes delete 0 end
    .listframe.archivesizes delete 0 end
    foreach index [lsort -integer [array names archnums]] {
	set filename $archnums($index)
	.listframe.archives insert end "$archives($filename.name)"
	.listframe.archivetypes insert end "$archives($filename.type)"
	.listframe.archivesizes insert end "$archives($filename.size)"
    }
}

##############################
## callback from fileselect to
## set extraction directory
##############################
proc setExtractDir {selected} {
    global extractdir
    if {[debug]} {puts "[pwd], $selected"}
    ## if it's not a dir, take its parent
    if {[string compare [file type [pwd]/$selected] "directory"]} {
	set extractdir [pwd]
    } else {
	set extractdir [pwd]/$selected
    }
}

##############################
## saveAs
##############################
proc saveAs {} {
    global archnums extractdir
    if {[debug]} {
	puts "saveAs: $archnums([.listframe.archives curselection])"
    }
    set newname ""
    set index [.listframe.archives curselection]
    set filename $archnums($index)
    fileselect setExtractDir "Save Archive To:"
    ## wait until we've selected something. if we
    vwait extractdir
    if {[debug]} {puts "finished vwait"}
    ## this doesn't work right
    if {[string compare $extractdir "-1"] == 0} {return}
    file copy $filename $extractdir
}


##############################
## pop up about window
##############################
proc doAbout {} {
    global aboutWinFlag aboutText
    if {!$aboutWinFlag} {
	set aboutWinFlag 1
	toplevel .aboutWin -class Dialog
	message .aboutWin.msg -text $aboutText -width 300
	button .aboutWin.done -text "Close" -command {set aboutWinFlag 0; destroy .aboutWin}
	pack .aboutWin.msg
	pack .aboutWin.done
    }
}


####################################################################
## Begin execution here (main)
####################################################################

#### build widgets and window
wm title . "$name $version"


## pull out hotkeys here
set newkey N
set openkey O
set closekey W
set savekey S
set printkey P
set quitkey Q
set extractkey E
set compresskey K
set contentskey L
set appendkey A

## read in plugins and other code before we build anything
#set status1 "reading in support files..."
#update
set modules [glob -nocomplain $libdir/plugins/*.tcl]
foreach module $modules {source $module}
source $libdir/tkArchive.config
#set status1 "ready."
#update


## create the menu in a frame
## this might be better done as a menubar
frame .menuframe -relief groove -borderwidth 2
## File menu
menubutton .menuframe.filebut -text "File"
menu .menuframe.filebut.file -type normal
.menuframe.filebut configure -menu .menuframe.filebut.file
.menuframe.filebut.file add command -label "New..." \
	-accelerator "^$newkey" -command {newArchive}
.menuframe.filebut.file add command -label "Open..." \
	-accelerator "^$openkey" \
	-command {fileselect getoldfile "Select Archive File:"}
.menuframe.filebut.file add command -label "Close" \
	-accelerator "^$closekey" -command {closeArchive}
.menuframe.filebut.file add command -label "Save" \
	-accelerator "^$savekey" -command {saveAs}
.menuframe.filebut.file add command -label "Save As..." -command {saveAs}
.menuframe.filebut.file add separator
.menuframe.filebut.file add command -label "Print..." \
	-command {set status1 "printing not yet supported."}
.menuframe.filebut.file add separator
.menuframe.filebut.file add command -label "Quit" \
	-accelerator "^$quitkey" -command {exit}

## Edit menu
menubutton .menuframe.editbut -text "Edit"
menu .menuframe.editbut.edit -type normal
.menuframe.editbut configure -menu .menuframe.editbut.edit
.menuframe.editbut.edit add command -label "Undo" \
	-command {set status1 "what did you think this would this do?"}

## Archive menu
menubutton .menuframe.archivebut -text "Archive"
menu .menuframe.archivebut.archive -type normal
.menuframe.archivebut configure -menu .menuframe.archivebut.archive
.menuframe.archivebut.archive add command -label "Contents..." \
	-accelerator "^$contentskey" -command {viewContents}
.menuframe.archivebut.archive add command -label "Extract..." \
	-accelerator "^$extractkey" -command {extract}
.menuframe.archivebut.archive add command -label "Compress..." \
	-accelerator "^$compresskey" -command {compress}
.menuframe.archivebut.archive add command -label "Append..." \
	-accelerator "^$appendkey" -command {append}

## Options menu
menubutton .menuframe.optionsbut -text "Options"
menu .menuframe.optionsbut.options -type normal
.menuframe.optionsbut configure -menu .menuframe.optionsbut.options
.menuframe.optionsbut.options add command -label "Nothing" -command {}

## Help menu
menubutton .menuframe.helpbut -text "Help"
menu .menuframe.helpbut.help -type normal
.menuframe.helpbut configure -menu .menuframe.helpbut.help
.menuframe.helpbut.help add command -label "About" -command {doAbout}

## pack the menu buttons into the frame
pack .menuframe.filebut -side left
pack .menuframe.editbut -side left
pack .menuframe.archivebut -side left
pack .menuframe.helpbut -side right

## create the main listbox frame and contents
frame .listframe
listbox .listframe.archives -width 25 -height 8 \
	-borderwidth 1 -relief sunken \
	-exportselection 0 -background white \
	-yscrollcommand ".listframe.scroll set"
listbox .listframe.archivetypes -width 15 -height 8 \
	-borderwidth 1 -relief sunken  -takefocus 0 \
	-exportselection 0 -background white \
	-yscrollcommand ".listframe.scroll set"
listbox .listframe.archivesizes -width 5 -height 8  -takefocus 0 \
	-borderwidth 1 -relief sunken -background white \
	-exportselection 0 \
	-yscrollcommand ".listframe.scroll set"
scrollbar .listframe.scroll -command ".listframe.archives yview" \
	-takefocus 0

## create the status widgets at the bottom
entry .status1 -state disabled -textvariable status1 -relief groove \
	-borderwidth 2

#### pack all the widgets
pack .menuframe -side top -fill x
pack .listframe.archives -side left -anchor n -fill x -fill y -expand 1
pack .listframe.archivetypes -side left -anchor n -fill x -fill y -expand 1
pack .listframe.archivesizes -side left -anchor n -fill x -fill y -expand 1
pack .listframe.scroll -side right -anchor n -fill y -expand 1
pack .listframe -side top -fill x -fill y
pack .status1 -side top -anchor w -fill x

## define key and mouse bindings for main window
set status1 "setting bindings..."
bind .listframe.archives <Double-1> {
    viewContents
}

## finally, read in the commandline if there's anything there
set status1 "adding archives to list..."
update
cmdline $argv
set status1 "ready"
update


