#!/usr/bin/wish -f
#
# CHANGE the line above if wish is in a different location on
# your system.
#
# This tcl/tk script provides a graphical interface to 
# the GNU tar program. 
#
# Written by Allin Cottrell (cottrell@wfu.edu), January 1997.

# SET the following to the directory where the helpfile, tktar.doc,
# is located.
set help_file /usr/doc/tktar.doc

wm title . "tkTar"

global active
set abort 0


proc tktar_help { } {
  global help_file
  set w .help
  catch {destroy $w} ; toplevel $w
  wm title $w "tkTar Help"
  wm iconname $w "tkTar Help"
  frame $w.t -relief groove -borderwidth 2
  pack [scrollbar $w.t.scroll -width 4m -command "$w.t.text yview" \
        -relief sunken -borderwidth 2] -side right -fill y
  pack [text $w.t.text -relief flat -width 66\
        -setgrid 1 -yscroll "$w.t.scroll set"] \
        -side top -fill both -expand 1 -padx 5 -pady 5
  pack $w.t -side top -padx 10 -pady 10 -expand 1 -fill both
  frame $w.c -relief flat -borderwidth 2
  pack [button $w.c.dismiss -text Dismiss -width 12 \
        -relief groove -command "destroy $w"] \
        -side left -anchor c -expand 1 -pady 5
  pack $w.c -side top -fill x -padx 10 
  if [file exists $help_file] then {
    set fid [open $help_file r]
    $w.t.text insert 0.0 [read $fid]
    close $fid
  } else {
    $w.t.text insert 0.0 "Sorry, couldn't find the help file, tktar.doc.\n\n\
    Please ensure that you have tktar.doc, and edit the top\n\
    of tktar itself so that the variable \"help_file\" points to\n\
    the right place."
  }
  $w.t.text configure -state disabled
  
}


if { $argc < 1 } {
    set abort 0
    pack [ label .b -bitmap error ]
    pack [ message .m -text "Please supply the name of an archive file\
         as a parameter to tktar." -aspect 500 ]     
    frame .f
    button .f.ok -text OK -command "set abort 1 ; destroy . ; exit" \
      -relief groove -width 6
    button .f.help -text Help -command "set abort 1 ; tktar_help" \
      -relief groove -width 6
    pack .f.ok -side left -padx 4
    pack .f.help -padx 4
    pack .f 
    tkwait variable abort
}

if { $abort == 0 } {
set archive [ lindex $argv 0 ]
wm title . "tkTar: $archive"

set zip 0 

if { [ string first gz $archive ] != -1 } {
   set opencmd "exec tar tvfz $archive >archive_listing"
   set tarcmd1 "tar xfzTO"
   set tarcmd2 "tar xfzT"
   set tarcmd3 "tar xfz"
} elseif { [ string first .zip $archive ] != -1 } {
   set opencmd "exec unzip -lqq $archive >archive_listing"
   set tarcmd1 ""
   set tarcmd2 ""
   set tarcmd3 "unzip"
   set zip 1
} else {
   set opencmd "exec tar tvf $archive >archive_listing"
   set tarcmd1 "tar xfTO"
   set tarcmd2 "tar xfT"
   set tarcmd3 "tar xf"
}
 
eval $opencmd

   frame .f1 -relief groove -borderwidth 2
   frame .f2 -relief flat -borderwidth 2
   
   message .msg -text "Mouse buttons: 1 to view,\
       2 to extract without path, 3 to extract with path" \
       -justify center -aspect 2000
   pack .msg -side top -fill x -pady 5

    frame .string
    label .string.label -text " Search string:" -width 13 -anchor w
    entry .string.entry -width 40 -relief sunken -bd 2 \
	    -textvariable searchString
    button .string.hi -text "Highlight" -width 10 -relief groove \
	    -command "TextSearch .f1.t \$searchString search"
    button .string.next -text "Go to next" -width 10 -relief groove \
            -command "\
            set pos \[ lindex \[ .f1.t yview \] 0 \]
            set pos \[ expr int(\$pos * \$numLines) + 20 \]
            set nextfind \[ .f1.t search \$searchString \$pos.0 \]
            .f1.t yview \$nextfind"
    pack .string.label .string.entry -side left
    pack .string.hi -side left -pady 5 -padx 10
    pack .string.next -side left -pady 5 
    bind .string.entry <Return> "TextSearch .f1.t \$searchString search"
    pack .string -side top -fill x -padx 5 -pady 5
    
   button .f2.unpack -text "Unpack entire archive" \
       -command "exec $tarcmd3 $archive" -relief groove 
   button .f2.dismiss -text "          Dismiss          " \
       -command "exec rm -f archive_listing \
        exec rm -f active_file ; destroy ." -relief groove
   button .f2.help -text "            Help             " \
       -command "tktar_help" -relief groove 
   text .f1.t  -yscrollcommand ".f1.s set" -relief flat \
      -setgrid true 
   scrollbar .f1.s -width 4m -relief sunken -command ".f1.t yview"

   pack .f1 -side top -padx 10 -expand 1 -fill both
   pack .f2 -side top -padx 10 -expand 1 -fill both   
   pack .f2.unpack -side left -expand yes -fill x
   pack .f2.dismiss -side left -pady 10 -padx 10  -expand yes -fill x
   pack .f2.help -side left -expand yes -fill x
   pack .f1.s -side right -fill y
   pack .f1.t -fill both -expand 1 -padx 5 -pady 5
    
   set blue "-foreground blue"
   set red "-foreground red"
   set cyan "-background cyan"
   set normal "-background {}"
   set k 0
   set numLines 0
   .f1.t tag configure search -background cyan
   
   set info [ open archive_listing r ]
   
   .f1.t insert insert "\n"
   
   while { [ gets $info line ] >= 0 } {
   	 if { $zip == 1 } {
   	    scan $line "%s %s %s %s" len j j name
   	 } else {
            scan $line "%s %s %s %s %s %s %s %s" j j len j j j j name
         }
         if { $len != "0" } {
            lappend filelist $name
            set lenstring [ format "%8d" $len ]
            lappend lenlist $lenstring
         }
   }

   set n [ llength $filelist ]

   for {set i 0} {$i < $n} {incr i} {
        .f1.t insert insert "[ lindex $lenlist $i ] "
        lappend taglist1 "$i"
        set start [ .f1.t index insert ]
        .f1.t insert insert "[ lindex $filelist $i ]"
        foreach tag [ .f1.t tag names $start ] {
	   .f1.t tag remove $tag $start insert
         }
        .f1.t tag add [ lindex $taglist1 $i ] $start insert 
         set start [ .f1.t index insert ]  
        .f1.t insert insert \t\t
        foreach tag [ .f1.t tag names $start ] {
	   .f1.t tag remove $tag $start insert
         }           
        .f1.t insert insert "\n"
        .f1.t tag bind [ lindex $taglist1 $i ] <Any-Enter> \
            ".f1.t tag configure [lindex $taglist1 $i] $cyan"  
        .f1.t tag bind [ lindex $taglist1 $i ] <Any-Leave> \
            ".f1.t tag configure [ lindex $taglist1 $i ] $normal" 
        .f1.t tag bind [ lindex $taglist1 $i ] <1> \
            ".f1.t tag configure [ lindex $taglist1 $i ] $blue
             incr k
             set active \[ open active_file w \]
             set dofile [ lindex $filelist $i ]
             if \{ \$zip == 1 \} \{
                exec unzip -cqq $archive \$dofile >display_file
             \} else \{
                puts \$active \$dofile
                close \$active
                exec $tarcmd1 $archive active_file >display_file
             \}
             display .display\$k display_file [ lindex $filelist $i ]"
        .f1.t tag bind [ lindex $taglist1 $i ] <2> \
            ".f1.t tag configure [ lindex $taglist1 $i ] $red
             set active \[ open active_file w \]
             set dofile [ lindex $filelist $i ]
             if \{ \$zip == 1 \} \{
                exec unzip -cqq $archive \$dofile >extract_file
             \} else \{             
                puts \$active \$dofile
                close \$active
                exec $tarcmd1 $archive active_file >extract_file
             \}
             exec mv extract_file [ file tail [ lindex $filelist $i ] ]"
        .f1.t tag bind [ lindex $taglist1 $i ] <3> \
            ".f1.t tag configure [ lindex $taglist1 $i ] $red
             set active \[ open active_file w \]
             set dofile [ lindex $filelist $i ]
             if \{ \$zip == 1 \} \{             
                exec unzip -qq $archive \$dofile 
             \} else \{             
                puts \$active \$dofile
                close \$active
                exec $tarcmd2 $archive active_file
             \}"
    } 
    .f1.t configure -state disabled
}   

proc display { w file name } {
    global contents numLines
    toplevel $w
    wm title $w $name

    frame $w.string
    label $w.string.label -text " Search string:" -width 13 -anchor w
    entry $w.string.entry -width 40 -relief sunken -bd 2 \
	    -textvariable searchString
    button $w.string.hi -text "Highlight" -width 10 -relief groove \
	    -command "TextSearch $w.t.text \$searchString search"
    button $w.string.next -text "Go to next" -width 10 -relief groove \
            -command "\
            set pos \[ lindex \[ $w.t.text yview \] 0 \]
            set pos \[ expr int(\$pos * \$numLines) + 20 \]
            set nextfind \[ $w.t.text search \$searchString \$pos.0 \]
            $w.t.text yview \$nextfind"
    pack $w.string.label $w.string.entry -side left
    pack $w.string.hi -side left -pady 5 -padx 10
    pack $w.string.next -side left -pady 5 
    bind $w.string.entry <Return> "TextSearch $w.t.text \$searchString search"
    pack $w.string -side top -fill x -padx 5 -pady 5

    frame $w.t -relief groove -borderwidth 2
    pack [scrollbar $w.t.scroll -width 4m -command "$w.t.text yview" \
        -relief sunken -borderwidth 2] -side right -fill y
    pack [text $w.t.text -relief flat \
        -setgrid 1 -yscroll "$w.t.scroll set"] \
        -side top -fill both -expand 1 -padx 5 -pady 5
    pack $w.t -side top -padx 10  -expand 1 -fill both
    frame $w.c -relief flat -borderwidth 2
    pack [button $w.c.dismiss -text Dismiss -width 12 -relief groove \
        -command "exec rm -f $file ; destroy $w"] \
        -side left -anchor c -expand 1 -pady 5
    pack $w.c -side top -fill x -padx 10 -pady 5
    set contents [ open $file r ]
    $w.t.text insert 0.0 [ read $contents ]
    close $contents
#    $w.t.text configure -state disabled    
    $w.t.text tag configure search -background cyan

}


proc TextSearch {w string tag} {
    global numLines
    $w tag remove search 0.0 end
    scan [$w index end] %d numLines
    set l [string length $string]
    for {set i 1} {$i <= $numLines} {incr i} {
        if {[string first $string [$w get $i.0 $i.1000]] == -1} {
            continue
        }
        set line [$w get $i.0 $i.1000]
        set offset 0
        while 1 {
            set index [string first $string $line]
            if {$index < 0} {
                break
            }
            incr offset $index
            $w tag add $tag $i.[expr $offset] $i.[expr $offset+$l]
            incr offset $l
            set line [string range $line [expr $index+$l] 1000]
        }
    }
    $w yview search.first
}





